[编程交流] 用o填充输入和输出块

(defun c:Test ( / doc enm lyrNm spc tmpBoundaryLst tmpHatch wid)
 (setq lyrNm "Outlines") ; Layer name.
 (setq wid 2.0)          ; Global width.
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (setvar 'cmdecho 0)
 (vla-add (vla-get-layers doc) lyrNm)
 (setq spc ((if (= 1 (getvar 'cvport)) vla-get-paperspace vla-get-modelspace) doc))
 (vlax-for blk (vla-get-blocks doc)
   (if (= :vlax-false (vla-get-isxref blk))
     (vlax-for obj blk
       (if
         (and
           (= "AcDbHatch" (vla-get-objectname obj))
           (setq tmpHatch (car (vlax-invoke doc 'copyobjects (list obj) spc)))
         )
         (progn
           (setq enm (entlast))
           (setq tmpBoundaryLst nil)
           (command "_.hatchgenerateboundary" (vlax-vla-object->ename tmpHatch) "")
           (while (setq enm (entnext enm))
             (setq tmpBoundaryLst (cons (vlax-ename->vla-object enm) tmpBoundaryLst))
           )
           (if tmpBoundaryLst
             (progn
               (foreach tmpBoundary tmpBoundaryLst
                 (vla-put-layer tmpBoundary lyrNm)
                 (if (vlax-property-available-p tmpBoundary 'constantwidth)
                   (vla-put-constantwidth tmpBoundary wid)
                 )
               )
               (vlax-invoke doc 'copyobjects tmpBoundaryLst blk)
               (mapcar 'vla-delete tmpBoundaryLst)
             )
           )
           (vla-delete tmpHatch)
         )
       )
     )
   )
 )
 (setvar 'cmdecho 1)
 (vla-endundomark doc)
 (princ)
)

bedit [color="red"]pick block[/color]
hatchgenerateboundary [color="red"]pick hatch[/color]
Properties [color="red"]pick pline global width[/color]
save block