;;---------------------=={ 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 / _furthestapart ang bbx brk cmd crv di1 di2 ent enx idx ins int lst ply sel tmp )

    (defun _furthestapart ( lst / dis mxd out pt1 pt2 )
        (setq mxd 0.0)
        (while (setq pt1 (car lst))
            (foreach pt2 (setq lst (cdr lst))
                (if (< mxd (setq dis (distance pt1 pt2)))
                    (setq mxd dis
                          out (list pt1 pt2)
                    )
                )
            )
        )
        out
    )
  
    (if (and (= 'ename (type ent))
             (setq enx (entget ent))
             (= "INSERT" (cdr (assoc 0 enx)))
        )
        (progn
            (if (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 (cdr (assoc 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)
                    )
                    (if (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)
)
