关于CAD图纸筛选问题 ，求高手指导

沙漠孤影

我是做钢结构的，在一张CAD零件图中，有异形件、有矩形件，我想快速把这两种零件筛选过滤出来，通过lisp编程可以解决吗？求高手解答下。附件为一张CAD零件图。

ZZXXQQ

找规律，分面积

2. ;零件分组 明经 ZZXXQQ 2014.11.20
   
3. (defun c:tt ()
   
4. (setvar "CMDECHO" 0)
   
5. (vl-load-com)
   
6. (if (setq ss (ssget "X" '((0 . "ARC,LINE")(62 . 2)))) (progn
   
7. (setq s1 (entlast) sslst (list))
   
8. (command "_.PEDIT" "M" ss "" "Y" "J" "0.02" "")
   
9. (if (setq ss (ssget "X" '((0 . "LWPOLYLINE") (90 . 4)))) (progn
   
10. (repeat (setq i (sslength ss))
    
11.   (setq en (ssname ss (setq i (1- i))))
    
12.   (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
    
13.   (setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))
    
14.   (setq p1 (mapcar '- p1 '(15 25)) p2 (mapcar '+ p2 '(10 25)))
    
15.   (command "_.ERASE" "C" p1 p2 "")
    
16. )
    
17. ))
    
18. (while (setq s1 (entnext s1)) (setq sslst (cons s1 sslst)))
    
19. (setq arealst (mapcar '(lambda (x) (vlax-curve-getArea(vlax-ename->vla-object x))) sslst))
    
20. (setq alst (mapcar 'list arealst sslst))
    
21. (setq alst (vl-sort alst '(lambda (a b) (< (car a) (car b)))))
    
22. (setq tmplst (list))
    
23. (setq aren (car alst))
    
24. (setq ar (car aren))
    
25. (setq enlst (cdr aren))
    
26. (setq i 1)
    
27. (foreach x (cdr alst)
    
28. (setq ttlst (list i (cdr x)))
    
29. (if (equal ar (car x) 1e-5)
    
30.   (setq i (1+ i) enlst (append enlst (cdr x)))
    
31.   (setq tmplst (append tmplst (list(list i enlst))) i 1 enlst (cdr x) ar (car x) ttlst (list))
    
32. )
    
33. )
    
34. (setq tmplst (append tmplst (list(list i enlst))))
    
35. (setq j 0)
    
36. (foreach x tmplst
    
37. (setq n (car x) j (1+ j))
    
38. (foreach y (cadr x)
    
39. (vla-getboundingbox (vlax-ename->vla-object y) 'pt1 'pt2)
    
40. (setq pt1 (vlax-safearray->list pt1))
    
41. (setq pt2 (vlax-safearray->list pt2))
    
42. (setq pt (mapcar '-
    
43. (mapcar '(lambda (a b) (/ (+ a b) 2)) pt1 (list (car pt2) (cadr pt1))) '(0 20)))
    
44. (command "_.TEXT" "S" "Arial" "M" pt "2.5" "0"
    
45.            (strcat "%%U共" (itoa n) "件,编号" (itoa j) "%%U"))
    
46. )
    
47. )
    
48. ))
    
49. (setvar "CMDECHO" 1)
    
50. (princ)
    
51. )
    

;零件分组 明经 ZZXXQQ 2014.11.20<br /> (defun c:tt ()<br /> (setvar "CMDECHO" 0)<br /> (vl-load-com)<br /> (if (setq ss (ssget "X" '((0 . "ARC,LINE")(62 . 2)))) (progn<br /> (setq s1 (entlast) sslst (list))<br /> (command "_.PEDIT" "M" ss "" "Y" "J" "0.02" "")<br /> (if (setq ss (ssget "X" '((0 . "LWPOLYLINE") (90 . 4)))) (progn<br /> (repeat (setq i (sslength ss))<br />   (setq en (ssname ss (setq i (1- i))))<br />   (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)<br />   (setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))<br />   (setq p1 (mapcar '- p1 '(15 25)) p2 (mapcar '+ p2 '(10 25)))<br />   (command "_.ERASE" "C" p1 p2 "")<br /> )<br /> ))<br /> (while (setq s1 (entnext s1)) (setq sslst (cons s1 sslst)))<br /> (setq arealst (mapcar '(lambda (x) (vlax-curve-getArea(vlax-ename->vla-object x))) sslst))<br /> (setq alst (mapcar 'list arealst sslst))<br /> (setq alst (vl-sort alst '(lambda (a b) (< (car a) (car b)))))<br /> (setq tmplst (list))<br /> (setq aren (car alst))<br /> (setq ar (car aren))<br /> (setq enlst (cdr aren))<br /> (setq i 1)<br /> (foreach x (cdr alst)<br /> (setq ttlst (list i (cdr x)))<br /> (if (equal ar (car x) 1e-5)<br />   (setq i (1+ i) enlst (append enlst (cdr x)))<br />   (setq tmplst (append tmplst (list(list i enlst))) i 1 enlst (cdr x) ar (car x) ttlst (list))<br /> )<br /> )<br /> (setq tmplst (append tmplst (list(list i enlst))))<br /> (setq j 0)<br /> (foreach x tmplst<br /> (setq n (car x) j (1+ j))<br /> (foreach y (cadr x)<br /> (vla-getboundingbox (vlax-ename->vla-object y) 'pt1 'pt2)<br /> (setq pt1 (vlax-safearray->list pt1))<br /> (setq pt2 (vlax-safearray->list pt2))<br /> (setq pt (mapcar '-<br /> (mapcar '(lambda (a b) (/ (+ a b) 2)) pt1 (list (car pt2) (cadr pt1))) '(0 20)))<br /> (command "_.TEXT" "S" "Arial" "M" pt "2.5" "0"<br />            (strcat "%%U共" (itoa n) "件,编号" (itoa j) "%%U"))<br /> )<br /> )<br /> ))<br /> (setvar "CMDECHO" 1)<br /> (princ)<br /> )<br />

沙漠孤影

谢谢你的答复，但是我运行了下，怎么出现错误，运行不出来啊。

沙漠孤影

沙漠孤影 发表于 2014-11-26 16:16
谢谢你的答复，但是我运行了下，怎么出现错误，运行不出来啊。

我CAD2004一运行，怎么出现这样“错误: no function definition: VLAX-ENAME->VLA-OBJECT”的问题呀？求指点

沙漠孤影

您好！这次可以运行了，谢谢你给与的帮助。运行的结果如图片所示，每个零件下面出现了新的一个编号。再麻烦你一下，请问是否可以实现经过lisp运行，CAD图中异形件异形件不动，把矩形件给删除了呢？期待你的回复，谢谢！！

ZZXXQQ

沙漠孤影 发表于 2014-11-27 23:54
您好！这次可以运行了，谢谢你给与的帮助。运行的结果如图片所示，每个零件下面出现了新的一个编号。再麻烦 ...

可以。
在(command "PEDIT" ...
之后加上
(if (setq ss (ssget "X" '((0 . "LWPOLYLINE") (90 . 4))))
(command "_.ERASE" ss "")
)

沙漠孤影

ZZXXQQ 发表于 2014-11-28 07:53
可以。
在(command "PEDIT" ...
之后加上

谢谢你的答复，图片是删除矩形框运行出来的结果，对于我这初学者来说，真有点崇拜你这高手啊 ！另外再问一下，通过lisp是否可以把矩形零件的标注线给删呢（即矩形件外轮廓没了，它自身的尺寸线是否也可以消除呢），还有异形件下重新编号的白色字体是否可以不显示呢，谢谢高手！求解答

ZZXXQQ

还有什么要求一次说完。
新写的字体可以放在一个图层中，将该图层关闭或冻结即可。

沙漠孤影

ZZXXQQ 发表于 2014-11-28 20:02
还有什么要求一次说完。
新写的字体可以放在一个图层中，将该图层关闭或冻结即可。

不好意思，老麻烦您了！经过lisp运行后，要求删除矩形件的轮廓线及其标注，只保留原图纸中异形件的信息。如所传附件为期望得到的结果。再次麻烦了，求解答。

沙漠孤影

沙漠孤影 发表于 2014-11-28 22:21
不好意思，老麻烦您了！经过lisp运行后，要求删除矩形件的轮廓线及其标注，只保留原图纸中异形件的信息。 ...

问题给解决了，真是太感谢了。在lisp方面，你真是专家啊，特佩服你真得好好的向你学习下。