;;---------------------=={ Automatic Block Break }==--------------------;;
;;                                                                      ;;
;;  This program enables the user to insert a block at a specified      ;;
;;  point, with surrounding geometry trimmed to the rectangular outline ;;
;;  of the block. Optionally, the program will automatically rotate     ;;
;;  the block to align with a curve object passing through the block    ;;
;;  insertion point.                                                    ;;
;;                                                                      ;;
;;  The program first prompts the user to select a block to insert. At  ;;
;;  this prompt the user may select a block from the drawing, or type   ;;
;;  'Browse' to browse for a drawing file to insert. The user may also  ;;
;;  alter the program rotation setting by typing 'Rotation' at the      ;;
;;  prompt.                                                             ;;
;;                                                                      ;;
;;  Following a valid response, the program prompts the user to specify ;;
;;  an insertion point for the block.                                   ;;
;;                                                                      ;;
;;  If a curve object (Arc, Elliptical Arc, Ellipse, Circle, Line,      ;;
;;  XLine, Spline, LWPolyline or Polyline) is detected at the block     ;;
;;  insertion point and the program rotation setting is enabled, the    ;;
;;  inserted block is automatically rotated to align with the curve.    ;;
;;                                                                      ;;
;;  All surrounding compatible objects found to intersect with the      ;;
;;  inserted block are then trimmed to the rectangular block outline.   ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright ?2010  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2010-11-22                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2011-02-07                                      ;;
;;                                                                      ;;
;;  - Entire program rewritten to allow subfunction to be called with   ;;
;;    block object argument.                                            ;;
;;  - Multiple intersecting objects are now trimmed.                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2011-02-08                                      ;;
;;                                                                      ;;
;;  - Changed block insertion to Visual LISP InsertBlock method.        ;;
;;  - Added calling functions to trim blocks in-situ (ABBE / ABBS).     ;;
;;----------------------------------------------------------------------;;
;;  Version 1.3    -    2011-08-03                                      ;;
;;                                                                      ;;
;;  - Altered method used to create bounding polyline to exclude        ;;
;;    attributes when trimming objects surrounding block.               ;;
;;  - Objects surrounding blocks whose insertion point does not lie on  ;;
;;    a curve are now also trimmed.                                     ;;
;;----------------------------------------------------------------------;;
;;  Version 1.4    -    2011-09-30                                      ;;
;;                                                                      ;;
;;  - Added option to enable/disable automatic block rotation.          ;;
;;  - Updated code formatting.                                          ;;
;;----------------------------------------------------------------------;;
;;  Version 1.5    -    2013-03-04                                      ;;
;;                                                                      ;;
;;  - Fixed bug causing program to attempt to break MLines.             ;;
;;  - Added new LM:blockboundingbox function to correctly calculate     ;;
;;    the bounding box of Dynamic Block references.                     ;;
;;  - Entire program rewritten.                                         ;;
;;----------------------------------------------------------------------;;
;;  Version 1.6    -    2013-10-01                                      ;;
;;                                                                      ;;
;;  - Fixed a bug causing the program to return an error if an object   ;;
;;    intersects the block bounding box at only one point.              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.7    -    2014-11-22                                      ;;
;;                                                                      ;;
;;  - Changed the method used to detect objects located at the block    ;;
;;    insertion point when determining the angle for automatic          ;;
;;    block rotation.                                                   ;;
;;----------------------------------------------------------------------;;

; (setq lm_blk_rotate T) ;缺省块自动旋转关
(defun c:LM_abb ( / old_cmd blk obj oobj ins sel LM:AutoBlockBreak )


;;---------------=={ Automatic Block Break SubFunction }==--------------;;
;;                                                                      ;;
;;  Upon calling the function with a VLA Block Reference Object         ;;
;;  argument, the function will trim all surrounding compatible         ;;
;;  geometry found to intersect with the rectangular outline of the     ;;
;;  supplied block reference.                                           ;;
;;                                                                      ;;
;;  Furthermore, if a curve object is detected to pass through (or in   ;;
;;  the vicinity of) the block insertion point and the rotation flag    ;;
;;  argument holds a non-nil value, the supplied block reference is     ;;
;;  rotated to align with the curve.                                    ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com                 ;;
;;----------------------------------------------------------------------;;
;;  Arguments:                                                          ;;
;;  ent - Block Reference Entity                                        ;;
;;  rot - Rotation flag (if T, block is aligned to curve)               ;;
;;----------------------------------------------------------------------;;
;(setq ent (car(entsel)) rot T)
;(LM:AutoBlockBreak (car(entsel)) T)
(defun LM:AutoBlockBreak ( ent rot / ang bbx brk cmd crv di1 di2 ent enx idx ins int lst ply sel tmp )
	(if (and
			(= 'ename (type ent))
			(setq enx (entget ent))
			(= "INSERT" (mai_dxf 0 enx))
		)
		(progn
			(and
				(not rot)
				(setq bbx (mai_get_blkbox ent lm_blk_chktext lm_blk_chktext))
				(setq sel (ssget "cp" bbx '((0 . "ARC,ELLIPSE,CIRCLE,LINE,SPLINE,*POLYLINE"))))
				(progn
					(setq
						ins (trans (mai_dxf 10 enx) ent 0)
						crv (ssname sel (1- (sslength sel)))
						di1 (distance ins (vlax-curve-getclosestpointto crv ins))
						ang (* 0.5 (max (distance (car bbx) (caddr bbx)) (distance (cadr bbx) (caddr bbx))))
					)
					(repeat (setq idx (1- (sslength sel)))
						(setq
							idx (1- idx)
							tmp (ssname sel idx)
						)
						(if (< (setq di2 (distance ins (vlax-curve-getclosestpointto tmp ins))) di1)
							(setq di1 di2 crv tmp)
						)
					)
					(< di1 ang)
				)
				(progn
					(setq
						bbx (vlax-curve-getclosestpointto crv ins)
						ang (angle
								'(0.0 0.0 0.0)
								(trans
									(vlax-curve-getfirstderiv crv (vlax-curve-getparamatpoint crv bbx))
									0
									(mai_dxf 210 crv)
								)
							)
						tmp (vlax-ename->vla-object ent)
					)
					(and
						(< (/ pi 2.0) ang)
						(<= ang (/ (* 3.0 pi) 2.0))
						(setq ang (+ ang pi))
					)
					(vlax-put tmp 'rotation ang) ;; VL used to account for attributes
					;(vlax-put-property tmp 'InsertionPoint (vlax-3D-point bbx)) ;; VL used to account for attributes
					(vlax-put tmp 'InsertionPoint bbx) ;; VL used to account for attributes
				)
			)
			(and
				(not lm_blk_autotrim)
				(setq bbx (mai_get_blkbox ent T T))
				(progn
					(setq ply (mai_entmake "LWPOLYLINE" (cons (last bbx) bbx)))
					(mai_pline_extrim ply nil (list (cons 0 "ARC,ELLIPSE,CIRCLE,LINE,SPLINE,*POLYLINE")) 0 nil)
					(entdel ply)
				)
			)
		)
	)
	(princ)
)



	(mini_start nil)
	(mai_last_com "LM_abb")
	(cond
		(	(= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
			(princ "\n当前层被锁定.")
		)
		(	(progn
				(while
					(progn
						(setvar 'errno 0)
						(initget "B R T A M")
						(princ (strcat
									"\n块自动旋转: "
									(if lm_blk_rotate "关" "开")
									"，是否计算块内文字: "
									(if lm_blk_chktext "开" "关")
									"，是否修剪块范围内线: "
									(if lm_blk_autotrim "关" "开")
									"。"
								)
						)
						(setq sel
							(entsel
								(strcat "\n选择块[浏览(B)/旋转(R)/文字(T)/修剪线(A)/批量选块随线(M)]"
									(if (= "" (setq blk (getvar 'insname)))
										" :"
										(strcat " <" blk "> :")
									)
								)
							)
						)
						(cond
							(	(= 7 (getvar 'errno))
								(princ "\n空选, 再选一次.")
							)
							(	(null sel)
								(if (= "" blk)
									(setq blk nil)
								)
							)
							(	(= "R" sel)
								(initget "ON OFF")
								(if (setq ins (getkword (strcat "\n是否计算块内文字 [开(ON)/开(OFF)] <" (if lm_blk_rotate "关" "开") ">:")))
									(setq lm_blk_rotate (= ins "OFF"))
								)
								T
							)
							(	(= "T" sel)
								(initget "ON OFF")
								(if (setq ins (getkword (strcat "\n块自动旋转 [开(ON)/开(OFF)] <" (if lm_blk_chktext "ON" "OFF") ">:")))
									(setq lm_blk_chktext (= ins "ON"))
								)
								T
							)
							(	(= "B" sel)
								(setq blk (getfiled "选择块文件" "" "dwg" 16))
								nil
							)
							(	(= "M" sel)
								(setq sel (mai_select_first '((0 . "INSERT")) "选择要对齐到线并打断线的块:" "没有找到块."))
								(foreach sel (mai_ssget_2_list sel) (LM:AutoBlockBreak sel lm_blk_rotate))
								(exit)
								nil
							)
							(	(= "A" sel)
								(initget "ON OFF")
								(if (setq ins (getkword (strcat "\n自动修剪块范围内线 [开(ON)/开(OFF)] <" (if lm_blk_autotrim "OFF" "ON") ">:")))
									(setq lm_blk_autotrim (= ins "OFF"))
								)
								T
							)
							(	(listp sel)
								(if (= "INSERT" (mai_dxf 0 (car sel)))
									(setq oobj (vlax-ename->vla-object (car sel))
										  blk nil
									)
									(princ "\n选择的实体必须是块.")
								)
							)
						)
					)
				)
				(not (or blk oobj))
			)
		)

		(	(princ "\n")
			(while (setq ins (getpoint "\r块的插入点:<退出>"))
				(or (and oobj (setq obj (vla-copy oobj)))
					(setq obj
							(vla-insertblock
								(vlax-get-property
									(vlax-get (vlax-get-acad-object) 'activedocument)
									(if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)
								)
								(vlax-3D-point (trans ins 1 0))
								blk
								1.0
								1.0
								1.0
								(angle '(0.0 0.0 0.0) (trans (getvar 'ucsxdir) 0 (trans '(0.0 0.0 1.0) 1 0 t) t))
							)
					)
				)
				(if blk (setvar 'insname (vl-filename-base blk)))
				;(vlax-put-property obj 'insertionpoint (vlax-3D-point (trans ins 1 0)))
				(vlax-put obj 'insertionpoint (trans ins 1 0))
				(LM:AutoBlockBreak (vlax-vla-object->ename obj) lm_blk_rotate)
			)
		)
	)
	(mai_end)
)
