謝謝您的分享！
這個程序不錯
能加个填充选项吗？比如烟道井就要用到填充。
我自己有两个，不过喜欢自己写的那个，简单好用
G〆h 发表于 2020-9-3 19:09
能加个填充选项吗？比如烟道井就要用到填充。
这个是可以实现的。。。等有空了我试试
OooCcc 发表于 2020-9-3 20:51
这个是可以实现的。。。等有空了我试试
建议改进以下几点：
①命令提示时，点选对象和画框操作应该交给CAD自动判断，提高效率。
②完成后，实现鼠标左键直接填充，右键为不填充
辛苦了！
本帖最后由 G〆h 于 2020-9-15 17:01 编辑
(setq _opt (entsel "\n点选对象或右键框绘挑空线："))
(cond
((= (type _opt) 'LIST) ;选择实体
实体操作
)
((= _opt nil)
(setq _minp (getpoint "\n第一个点:")
_maxp (getcorner _minp "\n第二个点:")
)
）
(setq loop t)
(while (and (setq code (grread T 8)) loop)
(cond
((= (car code) 25)
(princ "右键");右键
)
((= (cadr code) 32)
(princ "空格")
(setq loop nil)
);空格
((= (car code) 3)
(princ "左建")
);左键
)
)
(setq _acad (vlax-get-acad-object)
_doc (vla-get-activedocument _acad)
_mspace (vla-get-modelspace _doc)
_tkLayerName "_tk_Layer"
_tkLayer nil
)
(setq xobj (Vlax-Ename->Vla-Object (car (entsel))))
(setq HatchObj (vla-AddHatch _mspace acHatchPatternTypePredefined "SOLID" :vlax-true))
(vla-appendouterloop HatchObj
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length (list xobj))))
)
(list xobj)
)
)
感谢楼主的代码，结合上述代码及主要思路，经过几天的努力，终于实现了上述思想。后期问题主要是点选对象时，对非矩形外的对象作用不大。
支持支持，，，楼主威武
G〆h 发表于 2020-9-3 19:09
能加个填充选项吗？比如烟道井就要用到填充。
已添加填充功能，使用的是solide实体填充。并将实体放入相应图层。