用o填充输入和输出块
你好寻找在块内外创建轮廓的lisp
或者有人可以为我创建一个lisp。
功能：
-具有轮廓的即时所有图案填充（pline全局宽度2mm）
-创建轮廓图层名称轮廓 (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)
) Roy_043关于_的报道很好。hatchgenerateboundary一直在学习新的东西。
Cad为什么再次发布有时答案对代码来说非常深刻，你应该在其他帖子中再次寻求更多帮助。有些帖子需要一段时间。
大约3行值得感谢Roy_043
bedit pick block
hatchgenerateboundary pick hatch
Properties pick pline global width
save block
HATCHGENERATEBOUNDARY对我来说也是一个新的——很好，罗伊。 Roy_043，
你很快，非常感谢你的Lisp程序！！！！，这几天我搜索了整个网络超级！ 比加尔，
谢谢你在上一篇文章中的努力，我已经从solid改为hatch，所以我想，这让文章不是很清楚
页:
[1]