[编程交流] 将动态块拆分为s

;; Split Dynamic Block by Visibility State  -  Lee Mac
(defun c:dynsplit ( / *error* blk dis llp obj prp tmp urp )
   (defun *error* ( msg )
       (LM:endundo (LM:acdoc))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   (while
       (progn (setvar 'errno 0) (setq obj (car (entsel "\nSelect dynamic block to split: ")))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null obj) nil)
               (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 (entget obj))))))))
                   (princ "\nSelected object is on a locked layer.")
               )
               (   (/= "AcDbBlockReference" (vla-get-objectname (setq obj (vlax-ename->vla-object obj))))
                   (princ "\nSelected object is not a block.")
               )
               (   (= :vlax-false (vla-get-isdynamicblock obj))
                   (princ "\nSelected block is not dynamic.")
               )
               (   (null (setq prp (LM:getvisibilityparametername obj)))
                   (princ "\nSelected dynamic block does not have a visibility parameter.")
               )
           )
       )
   )
   (if obj
       (progn
           (LM:startundo (LM:acdoc))
           (setq blk (vla-get-effectivename obj)
                 dis 0.0
                 prp
               (vl-some
                  '(lambda ( x )
                       (if (= (strcase prp) (strcase (vla-get-propertyname x))) x)
                   )
                   (vlax-invoke obj 'getdynamicblockproperties)
               )
           )
           (foreach x (vlax-get prp 'allowedvalues)
               (vla-put-value prp (vlax-make-variant x vlax-vbstring))
               (vla-move
                   (setq tmp (vla-copy obj))
                   (vlax-3D-point 0 0)
                   (vlax-3D-point dis 0)
               )
               (vla-converttostaticblock tmp (uniqueblockname (strcat blk "_" x)))
               (vla-getboundingbox tmp 'llp 'urp)
               (setq dis (+ dis (* 1.1 (apply '- (mapcar '(lambda ( x ) (car (vlax-safearray->list x))) (list urp llp))))))
           )
           (vla-delete obj)
           (LM:endundo (LM:acdoc))
       )
   )
   (princ)
)
(defun uniqueblockname ( key / cnt rtn )
   (if (tblsearch "block" key)
       (progn
           (setq cnt 1)
           (while
               (tblsearch "block"
                   (setq rtn (strcat key "(" (itoa (setq cnt (1+ cnt))) ")"))
               )
           )
           rtn
       )
       key
   )
)
;; Get Visibility Parameter Name  -  Lee Mac
;; Returns the name of the Visibility Parameter of a Dynamic Block (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; Returns: [str] Name of Visibility Parameter, else nil
(defun LM:getvisibilityparametername ( blk / vis )  
   (if
       (and
           (vlax-property-available-p blk 'effectivename)
           (setq blk
               (vla-item
                   (vla-get-blocks (vla-get-document blk))
                   (vla-get-effectivename blk)
               )
           )
           (= :vlax-true (vla-get-isdynamicblock blk))
           (= :vlax-true (vla-get-hasextensiondictionary blk))
           (setq vis
               (vl-some
                  '(lambda ( pair )
                       (if
                           (and
                               (= 360 (car pair))
                               (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair)))))
                           )
                           (cdr pair)
                       )
                   )
                   (dictsearch
                       (vlax-vla-object->ename (vla-getextensiondictionary blk))
                       "ACAD_ENHANCEDBLOCK"
                   )
               )
           )
       )
       (cdr (assoc 301 (entget vis)))
   )
)
;; Start Undo  -  Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
   (LM:endundo doc)
   (vla-startundomark doc)
)
;; End Undo  -  Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
   (while (= 8 (logand 8 (getvar 'undoctl)))
       (vla-endundomark doc)
   )
)
;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)
(vl-load-com) (princ)