;;---------------------=={ 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.                                                   ;;
;;----------------------------------------------------------------------;;

(defun c:LM_abb ( / old_cmd blk obj ins sel )
    (mini_start T)
    (cond
        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
            (princ "\nµ±Ç°²ã±»Ëø¶¨.")
        )
        (   (progn
                (while
                    (progn
                        (setvar 'errno 0)
                        (initget "Browse Rotation Text")
                        (princ (strcat "\n¿é×Ô¶¯Ðý×ª: "
                                      (if lm_blk_rotate "¹Ø" "¿ª")
                                      "£¬ÊÇ·ñ¼ÆËã¿éÄÚÎÄ×Ö: "
                                      (if lm_blk_chktext "¿ª" "¹Ø")
                                      "¡£"
                               )
                        )
                        (setq sel
                            (entsel
                                (strcat "\nÑ¡Ôñ¿é [ä¯ÀÀ(Browse)/Ðý×ª(Rotation)/ÎÄ×Ö(Text)]"
                                    (if (= "" (setq blk (getvar 'insname)))
                                        " :"
                                        (strcat " <" blk "> :")
                                    )
                                )
                            )
                        )
                        (cond
                            (   (= 7 (getvar 'errno))
                                (princ "\n¿ÕÑ¡, ÔÙÑ¡Ò»´Î.")
                            )
                            (   (null sel)
                                (if (= "" blk)
                                    (setq blk nil)
                                )
                            )
                            (   (= "Rotation" sel)
                                (initget "ON OFF")
                                (if (setq ins (getkword (strcat "\nÊÇ·ñ¼ÆËã¿éÄÚÎÄ×Ö [¿ª(ON)/¿ª(OFF)] <" (if lm_blk_rotate "¹Ø" "¿ª") ">:")))
                                    (setq lm_blk_rotate (= ins "OFF"))
                                )
                            )
                            (   (= "Text" sel)
                                (initget "ON OFF")
                                (if (setq ins (getkword (strcat "\n¿é×Ô¶¯Ðý×ª [¿ª(ON)/¿ª(OFF)] <" (if lm_blk_chktext "ON" "OFF") ">:")))
                                    (setq lm_blk_chktext (= ins "ON"))
                                )
                            )
                            (   (= "Browse" sel)
                                (setq blk (getfiled "Ñ¡Ôñ¿éÎÄ¼þ" "" "dwg" 16))
                                nil
                            )
                            (   (listp sel)
                                (if (/= "INSERT" (cdr (assoc 0 (entget (car sel)))))
                                    (princ "\nÑ¡ÔñµÄÊµÌå±ØÐëÊÇ¿é.")
                                    (setq obj (vla-copy (vlax-ename->vla-object (car sel)))
                                          blk nil
                                    )
                                )
                            )
                        )
                    )
                )
                (not (or blk obj))
            )
        )
        (   (setq ins (getpoint "\n¿éµÄ²åÈëµã :"))
            (or obj
                (setq obj
                    (vla-insertblock
                        (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (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)))
            (vla-put-insertionpoint obj (vlax-3D-point (trans ins 1 0)))
            (LM:AutoBlockBreak (vlax-vla-object->ename obj) lm_blk_rotate)
        )
    )
    (mai_end)
)


;;---------------=={ Automatic Block Break Selection }==----------------;;
;;                                                                      ;;
;;  This program enables the user to select multiple existing blocks    ;;
;;  and automatically trim all surrounding geometry to the rectangular  ;;
;;  outline of each block. Optionally, the program will automatically   ;;
;;  rotate each block in the selection to align with curve objects      ;;
;;  detected to pass through the block insertion point.                 ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2010  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;

(defun c:LM_abbs ( / old_cmd sel )
    (mini_start T)
    (setq sel (mai_select_first '((0 . "INSERT")) "Ñ¡ÔñÒª¶ÔÆëµ½Ïß²¢´ò¶ÏÏßµÄ¿é:" "Ã»ÓÐÕÒµ½¿é."))
    (foreach sel (mai_ssget_2_list sel) (LM:AutoBlockBreak sel lm_blk_rotate))
    (mai_end)
)



;;---------------=={ 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,XLINE,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))
                    )
                    (vla-put-rotation tmp ang) ;; VL used to account for attributes
                    (vla-put-InsertionPoint tmp (vlax-3D-point bbx)) ;; VL used to account for attributes
                )
            )
            (if (setq bbx (mai_get_blkbox ent T T))
                (progn
                    (setq ply (mai_entmake "LWPOLYLINE" (cons (last bbx) bbx)))
                    (mai_pline_extrim ply nil '((0 . "ARC,ELLIPSE,CIRCLE,LINE,XLINE,SPLINE,*POLYLINE")) 0)
                    (entdel ply)
                )
            )
        )
    )
    (princ)
)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;