本帖最后由 q3_2006 于 2013-12-30 07:14 编辑
275437962 发表于 2013-12-29 21:45 http://bbs.mjtd.com/static/image/common/back.gif
我看了，你是先选一组，然后再选所有要处理的，可是我执行程序不是这样的提示，没有要求我选全部的，只是 ...;;;第二版,只能处理各组图元数量相同的情况
(defun c:tt ( / a b bnm box dxf5 el en i l la lst lst_en lst_hand n pt ss ss0 ssx x y)
(defun lst2ss (lst_en / ss en)
(setq ss (ssadd))
(foreach en lst_en
(if (= (type en) 'ename)
(ssadd en ss)
)
)
(if (= (sslength ss) 0)
nil
ss
)
)
(defun fd ( l n / a b )
(while l
(repeat n
(setq a (cons (car l) a)
l (cdr l)
)
)
(setq b (cons (reverse a) b)
a nil
)
)
(reverse b)
)
(vl-load-com)
(vl-cmdf "undo" "be")
(print "\n选择任意一组处理对象:")
(setq ss0 (ssget '((0 . "LINE")))
n (sslength ss0)
la (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss0 0)) 'Layer )
)
(print "\n选择全部处理对象:")
(setq ss (ssget (list '(0 . "LINE")))
bnm (getstring "\输入块名:")
i 0
lst_hand '()
)
(repeat (sslength ss)
(setq en (ssname ss i)
dxf5 (cdr (assoc 5 (entget en)))
)
(setq lst_hand (cons dxf5 lst_hand))
(setq i (1+ i))
)
(setq lst_hand (vl-sort lst_hand (function (lambda (x y) (< x y)))))
(setq lst (fd (mapcar 'handent lst_hand) n))
(mapcar '(lambda(x)
(setq ssx (lst2ss x)
box (acet-geom-ss-extents ssx t)
pt (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))
)
(command "erase" ssx "")
(command "-insert" bnm pt "" "" "")
(Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)
(vlax-for X
(vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
bnm
)
(setq el (cons (vlax-vla-object->ename X) el))
)
(mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)
) lst)
(vl-cmdf "undo" "e")
)
下线...有问题.明天再说..
q3_2006 发表于 2013-12-29 21:56 static/image/common/back.gif
下线...有问题.明天再说..
好的，早点休息！！谢谢了！！
本帖最后由 275437962 于 2013-12-29 22:23 编辑
q3_2006 发表于 2013-12-29 21:55 static/image/common/back.gif
兄弟，我试了，这个程序第一次执行可以，后退再试就会叠加的，而且我发现一个问题，如果这一个层里面有两类符号，就麻烦，框选会把两类符号一起选上，这样这两类符号就不能区别，我觉得不区别直线的长度和角度还是不行啊，我觉得你前面开发的思路是对的，只是再改一下，应该就好了！！！
我实际情况，是这一层里，有几类要处理的符号。
275437962 发表于 2013-12-29 22:22 static/image/common/back.gif
兄弟，我试了，这个程序第一次执行可以，后退再试就会叠加的，而且我发现一个问题，如果这一个层里面有两 ...
不是几类符号的问题,图示两图一个是4个图元组成,一个是3个,当然不能块处理.你自己可以变通一下,这种情况用第一版的程序来处理不就得了......另外,我的代码用了ET函数...你的CAD也需要安装ET工具才能正常运行...
第一版和第二版已经注明(中间版全部删除),你可以选择处理方式,我只能做到这个程度了...
好热闹.................
q3_2006 发表于 2013-12-30 07:19 static/image/common/back.gif
第一版和第二版已经注明(中间版全部删除),你可以选择处理方式,我只能做到这个程度了...
兄弟，就是的，我安装了ET扩展工具后，不管执行几次，也不会叠加了，不过我在想，后面的程度能不能改一下，就是在选择全部处理对象时，可以采用任意多边的方式选择，这样就好用了，呵呵，我是不是意想天开哦！！！
275437962 发表于 2013-12-30 10:28 static/image/common/back.gif
兄弟，就是的，我安装了ET扩展工具后，不管执行几次，也不会叠加了，不过我在想，后面的程度能不能改一下 ...
;;选择闭合多线形内及与多边形相交的对象处理
(defun c:tt ( / a b c bnm box dxf5 el en i l la lst lst_en lst_hand n pt pts ss ss0 ssx x y)
(defun lst2ss (lst_en / ss en)
(setq ss (ssadd))
(foreach en lst_en
(if (= (type en) 'ename)
(ssadd en ss)
)
)
(if (= (sslength ss) 0)
nil
ss
)
)
(defun fd ( l n / a b )
(while l
(repeat n
(setq a (cons (car l) a)
l (cdr l)
)
)
(setq b (cons (reverse a) b)
a nil
)
)
(reverse b)
)
(vl-load-com)
(vl-cmdf "undo" "be")
(print "\n选择任意一组处理对象:")
(setq ss0 (ssget '((0 . "LINE")))
n (sslength ss0)
la (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss0 0)) 'Layer )
)
(setq c (car (entsel "\n选择闭合多边形:"))
pts (mapcar 'cdr(vl-remove-if-not '(lambda (x) (= (car x) 10))(entget c)))
ss (ssget "cp" pts '((0 . "LINE")))
bnm (getstring "\输入块名:")
i 0
lst_hand '()
)
(repeat (sslength ss)
(setq en (ssname ss i)
dxf5 (cdr (assoc 5 (entget en)))
)
(setq lst_hand (cons dxf5 lst_hand))
(setq i (1+ i))
)
(setq lst_hand (vl-sort lst_hand (function (lambda (x y) (< x y)))))
(setq lst (fd (mapcar 'handent lst_hand) n))
(mapcar '(lambda(x)
(setq ssx (lst2ss x)
box (acet-geom-ss-extents ssx t)
pt (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))
)
(command "erase" ssx "")
(command "-insert" bnm pt "" "" "")
(Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)
(vlax-for X
(vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
bnm
)
(setq el (cons (vlax-vla-object->ename X) el))
)
(mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)
) lst)
(vl-cmdf "undo" "e")
)
本帖最后由 275437962 于 2013-12-30 10:54 编辑
q3_2006 发表于 2013-12-30 10:41 static/image/common/back.gif
兄弟，再不弄了，我都快不好意思，这个多边形的很好，其实前面的我刚试了，在进行选择全部处理对象进，可以多次选择，其实已经满足要求了，只是有时不太稳定，偶尔会出现叠加的现象，我把CAD关闭重新启动就行了，还有就是原来两个符号距离近的，那么插入块的时候，这两个块的位置有些变化，不过已经很了不起了！！！从一开始，没有人理会，到后来，你不厌其烦的给解决，谢谢了，虽然中间出了点小插曲儿，呵呵，现在我觉得这不重要了！！！