[编程交流] 非动态lisp修改

(defun c:UnDynamic
   (   /
       _get_item
       _right
       _make_key
       _dynamic->static_block
       _get_locked
       _get_dynamic_inserts
       _main
   )
   (defun _get_item ( collection key / item )
       (vl-catch-all-apply
          '(lambda ( ) (setq item (vla-item collection key)))
       )
       item
   )
   (defun _right ( str n / len )
       (if (< n (setq len (strlen str)))
           (substr str (1+ (- len n)))
           str
       )
   )
   (defun _make_key ( collection prefix len / key )
       (   (lambda ( i pad )
               (while
                   (_get_item collection
                       (setq key
                           (strcat prefix
                               (_right
                                   (strcat pad (itoa (setq i (1+ i))))
                                   len
                               )
                           )
                       )
                   )
               )
               key
           )
           0
           (   (lambda ( pad )
                   (while (< (strlen pad) len)
                       (setq pad (strcat "0" pad))
                   )
                   pad
               )
               ""
           )
       )
   )
   (defun _dynamic->static_block ( blocks insert len )
       (vla-ConvertToStaticBlock
           insert
           (_make_key blocks "STATIC_" len)
       )
   )
   (defun _get_locked ( layers / locked )
       (vlax-for layer layers
           (if (eq :vlax-true (vla-get-lock layer))
               (setq locked (cons layer locked))
           )
       )
       locked
   )
   (defun _get_dynamic_inserts ( blocks / inserts )
       (vlax-for block blocks
           (vlax-for object block
               (if (eq "AcDbBlockReference" (vla-get-objectname object))
                   (if (eq :vlax-true (vla-get-isdynamicblock object))
                       (setq inserts (cons object inserts))
                   )
               )
           )
       )
       inserts
   )
   (defun _main ( document / blocks inserts locked len )
       (if
           (setq inserts
               (_get_dynamic_inserts
                   (setq blocks (vla-get-blocks document))
               )
           )
           (progn
               (foreach layer (setq locked (_get_locked (vla-get-layers document)))
                   (vla-put-lock layer :vlax-false)
               )
               (setq len (strlen (itoa (length inserts))))
               (foreach insert inserts
                   (_dynamic->static_block blocks insert len)
               )
               (foreach layer locked
                   (vla-put-lock layer :vlax-true)
               )
           )
       )
       (princ)
   )
   (_main (vla-get-activedocument (vlax-get-acad-object)))
)

([color=BLUE]defun[/color] c:undyn [color=BLUE]nil[/color]
   (undyn ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
   ([color=BLUE]princ[/color])
)
([color=BLUE]defun[/color] undyn ( doc [color=BLUE]/[/color] blk lst )
   ([color=BLUE]vlax-for[/color] def ([color=BLUE]setq[/color] blk ([color=BLUE]vla-get-blocks[/color] doc))
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=BLUE]:vlax-false[/color]  ([color=BLUE]vla-get-isxref[/color] def))
           ([color=BLUE]vlax-for[/color] obj def
               ([color=BLUE]and[/color] ([color=BLUE]=[/color] [color=MAROON]"AcDbBlockReference"[/color] ([color=BLUE]vla-get-objectname[/color] obj))
                    ([color=BLUE]=[/color] [color=BLUE]:vlax-true[/color] ([color=BLUE]vla-get-isdynamicblock[/color] obj))
                    ([color=BLUE]vlax-write-enabled-p[/color] obj)
                    ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] obj lst))
               )
           )
       )
   )
   ([color=BLUE]foreach[/color] obj lst
       ([color=BLUE]vla-converttostaticblock[/color] obj
           (uniqueblock blk ([color=BLUE]strcat[/color] ([color=BLUE]vla-get-effectivename[/color] obj) [color=MAROON]"_DYNlocked"[/color]))
       )
   )
)
([color=BLUE]defun[/color] uniqueblock ( col key [color=BLUE]/[/color] tmp )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]not[/color] (item-p col key)) key)
       (   ([color=BLUE]setq[/color] tmp 1)
           ([color=BLUE]while[/color] (item-p col ([color=BLUE]strcat[/color] key ([color=BLUE]itoa[/color] ([color=BLUE]setq[/color] tmp ([color=BLUE]1+[/color] tmp))))))
           ([color=BLUE]strcat[/color] key ([color=BLUE]itoa[/color] tmp))
       )
   )
)
([color=BLUE]defun[/color] item-p ( col key )
   ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-item[/color] ([color=BLUE]list[/color] col key))))
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])