[求助]：XD工具箱里的消重图元的程序的问题。

matichen

我在用那个消图元的程序时碰到了问题。有些pl线几乎一样，点坐标只差一点（反正眼看不出），程序也不会把它消掉，而用cad自带的expresstool里的那个overkill 确能消掉。但我不喜欢用OVERKILL（它会把两个pl线相邻的边删掉）  请问晓得工具箱里的那个能不能设个模糊值（或容差值），将那些近似的“重”图元消掉。？

另，我在XDSOFT\LISP\..下找不到消重图元是哪个lisp，能告诉我是哪个吗?我想学习学习。不会是ARX吧。

附图，就是那些消不掉重线的图形，请帮我看看。

夜语

应该是ARX程序，LISP程序太慢。

XDSoft

最初由 夜语 发布
[B]应该是ARX程序，LISP程序太慢。 [/B]

是LISP程序，里面用了XDRX_API

“晓东工具箱”所有LISP程序都是明码，你看到命令名后，用WIN的搜索功能，把命令名放到“内容”里面，搜索LISP文件就能查到相关的LISP程序。

2. 
   
3. [FONT=courier new]
   
4. ;|
   
5.   命令:rdupent
   
6.   功能:消除重复的图元,支持的图元包括
   
7.        3dface attdef arc circle dimension insert line lwpolyline
   
8.        point solid text trace
   
9. 
   
10.   配合XDRX_API使用
    
11. |;
    
12. 
    
13. (defun rdupent (ss / e el el0 n        n1 n2 i        i1 stl st1 st2 name la p ln ln2
    
14.                 le le1 lp 3dface attdef        arc circle dimension insert line
    
15.                 lwpolyline point polyline solid        text trace
    
16.                )
    
17.   (if (and
    
18.         ss
    
19.         (if (= 'str (type ss))
    
20.           (setq ss (ssget "X" (list (cons 8 (xdrx_getlyrname ss)))))
    
21.           ss
    
22.         )
    
23.       )
    
24.     (progn
    
25.       (setq st1        (strcat "\r已搜索到图元 ")
    
26.             st2        (strcat "\r已处理图元 ")
    
27.             n        0
    
28.             n1        0
    
29.             n2        0
    
30.             i        0
    
31.             ln        '(3dface attdef        arc circle dimension insert line
    
32.                   lwpolyline point solid text trace
    
33.                  )
    
34.       )
    
35.       (print)
    
36.       (xdrx_pbarbegin "正在搜索：" (sslength ss))
    
37.       (xdrx_setsstodb ss 0)
    
38.       (while (setq e (xdrx_getentdata 0))
    
39.         (xdrx_pbarsetpos n)
    
40.         (setq n           (1+ n)
    
41.               la   (xdrx_getentdxf 8)
    
42.               name (xdrx_getentdxf 0)
    
43.               p           (if (= "POLYLINE" name)
    
44.                      (xdrx_nextent)
    
45.                      (xdrx_getentdxf 10)
    
46.                    )
    
47.               name (read name)
    
48.               la   (strcat la (rtos (car p) 2 0) (rtos (cadr p) 2 0))
    
49.               le   (assoc la (eval name))
    
50.         )
    
51.         (set name
    
52.              (if le
    
53.                (subst
    
54.                  (append
    
55.                    le
    
56.                    (list e)
    
57.                  )
    
58.                  le
    
59.                  (eval name)
    
60.                )
    
61.                (cons (list la e) (eval name))
    
62.              )
    
63.         )
    
64.         (if (= 127 (logand 127 n))
    
65.           (princ (strcat st1 (itoa n)))
    
66.         )
    
67.       )
    
68.       (xdrx_pbarend)
    
69.       (princ (strcat st1 (itoa n)))
    
70.       (print)
    
71.       (foreach ln1 ln
    
72.         (setq ln2 (eval ln1))
    
73.         (foreach le ln2
    
74.           (setq le (cdr le))
    
75.           (while (setq e (car le))
    
76.             (if        (setq n1 (1+ n1)
    
77.                       le (cdr le)
    
78.                 )
    
79.               (progn
    
80.                 (setq el0 (entget e)
    
81.                       el0 (member (assoc 10 el0) el0)
    
82.                       le1 nil
    
83.                 )
    
84.                 (foreach e le
    
85.                   (setq        el (entget e)
    
86.                         el (member (assoc 10 el) el)
    
87.                   )
    
88.                   (if (equal el el0)
    
89.                     (progn
    
90.                       (entdel e)
    
91.                       (setq n1 (1+ n1)
    
92.                             n2 (1+ n2)
    
93.                       )
    
94.                     )
    
95.                     (setq le1 (cons e le1))
    
96.                   )
    
97.                 )
    
98.                 (setq le le1)
    
99.               )
    
100.             )
     
101.           )
     
102.           (if (> i 100)
     
103.             (progn
     
104.               (princ (strcat st2 (itoa n1)))
     
105.               (setq i 0)
     
106.             )
     
107.             (setq i (1+ i))
     
108.           )
     
109.         )
     
110.       )
     
111.       (foreach le polyline
     
112.         (setq le (cdr le))
     
113.         (while (setq e (car le))
     
114.           (if (setq n1 (1+ n1)
     
115.                     le (cdr le)
     
116.               )
     
117.             (progn
     
118.               (setq lp        nil
     
119.                     le1        nil
     
120.               )
     
121.               (xdrx_setenttodb e)
     
122.               (while (setq p (xdrx_nextent))
     
123.                 (setq lp (cons p lp))
     
124.               )
     
125.               (setq lp (reverse lp))
     
126.               (foreach e le
     
127.                 (setq i1 0)
     
128.                 (xdrx_setenttodb e)
     
129.                 (while (and
     
130.                          (setq p (xdrx_nextent))
     
131.                          (equal p (nth i1 lp))
     
132.                        )
     
133.                   (setq i1 (1+ i1))
     
134.                 )
     
135.                 (if p
     
136.                   (setq le1 (cons e le1))
     
137.                   (progn
     
138.                     (entdel e)
     
139.                     (setq n1 (1+ n1)
     
140.                           n2 (1+ n2)
     
141.                     )
     
142.                   )
     
143.                 )
     
144.               )
     
145.               (setq le le1)
     
146.             )
     
147.           )
     
148.         )
     
149.         (if (> i 100)
     
150.           (progn
     
151.             (princ (strcat st2 (itoa n1)))
     
152.             (setq i 0)
     
153.           )
     
154.           (setq i (1+ i))
     
155.         )
     
156.       )
     
157.       (princ (strcat st2 (itoa n1)))
     
158.       (princ
     
159.         (strcat "\n已消去图元 " (itoa n2) ", 还剩 " (itoa (- n n2)))
     
160.       )
     
161.       (redraw)
     
162.     )
     
163.   )
     
164.   (princ)
     
165. )
     
166. (defun c:rdupent ()
     
167.   (prompt "\n请选取要消重的图元<退出>:")
     
168.   (if (setq ss (ssget))
     
169.     (rdupent ss)
     
170.   )
     
171.   (princ)
     
172. )[/FONT]

<br /> [FONT=courier new]<br /> ;|<br />   命令:rdupent<br />   功能:消除重复的图元,支持的图元包括<br />        3dface attdef arc circle dimension insert line lwpolyline<br />        point solid text trace<br /> <br />   配合XDRX_API使用<br /> |;<br /> <br /> (defun rdupent (ss / e el el0 n        n1 n2 i        i1 stl st1 st2 name la p ln ln2<br />                 le le1 lp 3dface attdef        arc circle dimension insert line<br />                 lwpolyline point polyline solid        text trace<br />                )<br />   (if (and<br />         ss<br />         (if (= 'str (type ss))<br />           (setq ss (ssget "X" (list (cons 8 (xdrx_getlyrname ss)))))<br />           ss<br />         )<br />       )<br />     (progn<br />       (setq st1        (strcat "\r已搜索到图元 ")<br />             st2        (strcat "\r已处理图元 ")<br />             n        0<br />             n1        0<br />             n2        0<br />             i        0<br />             ln        '(3dface attdef        arc circle dimension insert line<br />                   lwpolyline point solid text trace<br />                  )<br />       )<br />       (print)<br />       (xdrx_pbarbegin "正在搜索：" (sslength ss))<br />       (xdrx_setsstodb ss 0)<br />       (while (setq e (xdrx_getentdata 0))<br />         (xdrx_pbarsetpos n)<br />         (setq n           (1+ n)<br />               la   (xdrx_getentdxf 8)<br />               name (xdrx_getentdxf 0)<br />               p           (if (= "POLYLINE" name)<br />                      (xdrx_nextent)<br />                      (xdrx_getentdxf 10)<br />                    )<br />               name (read name)<br />               la   (strcat la (rtos (car p) 2 0) (rtos (cadr p) 2 0))<br />               le   (assoc la (eval name))<br />         )<br />         (set name<br />              (if le<br />                (subst<br />                  (append<br />                    le<br />                    (list e)<br />                  )<br />                  le<br />                  (eval name)<br />                )<br />                (cons (list la e) (eval name))<br />              )<br />         )<br />         (if (= 127 (logand 127 n))<br />           (princ (strcat st1 (itoa n)))<br />         )<br />       )<br />       (xdrx_pbarend)<br />       (princ (strcat st1 (itoa n)))<br />       (print)<br />       (foreach ln1 ln<br />         (setq ln2 (eval ln1))<br />         (foreach le ln2<br />           (setq le (cdr le))<br />           (while (setq e (car le))<br />             (if        (setq n1 (1+ n1)<br />                       le (cdr le)<br />                 )<br />               (progn<br />                 (setq el0 (entget e)<br />                       el0 (member (assoc 10 el0) el0)<br />                       le1 nil<br />                 )<br />                 (foreach e le<br />                   (setq        el (entget e)<br />                         el (member (assoc 10 el) el)<br />                   )<br />                   (if (equal el el0)<br />                     (progn<br />                       (entdel e)<br />                       (setq n1 (1+ n1)<br />                             n2 (1+ n2)<br />                       )<br />                     )<br />                     (setq le1 (cons e le1))<br />                   )<br />                 )<br />                 (setq le le1)<br />               )<br />             )<br />           )<br />           (if (> i 100)<br />             (progn<br />               (princ (strcat st2 (itoa n1)))<br />               (setq i 0)<br />             )<br />             (setq i (1+ i))<br />           )<br />         )<br />       )<br />       (foreach le polyline<br />         (setq le (cdr le))<br />         (while (setq e (car le))<br />           (if (setq n1 (1+ n1)<br />                     le (cdr le)<br />               )<br />             (progn<br />               (setq lp        nil<br />                     le1        nil<br />               )<br />               (xdrx_setenttodb e)<br />               (while (setq p (xdrx_nextent))<br />                 (setq lp (cons p lp))<br />               )<br />               (setq lp (reverse lp))<br />               (foreach e le<br />                 (setq i1 0)<br />                 (xdrx_setenttodb e)<br />                 (while (and<br />                          (setq p (xdrx_nextent))<br />                          (equal p (nth i1 lp))<br />                        )<br />                   (setq i1 (1+ i1))<br />                 )<br />                 (if p<br />                   (setq le1 (cons e le1))<br />                   (progn<br />                     (entdel e)<br />                     (setq n1 (1+ n1)<br />                           n2 (1+ n2)<br />                     )<br />                   )<br />                 )<br />               )<br />               (setq le le1)<br />             )<br />           )<br />         )<br />         (if (> i 100)<br />           (progn<br />             (princ (strcat st2 (itoa n1)))<br />             (setq i 0)<br />           )<br />           (setq i (1+ i))<br />         )<br />       )<br />       (princ (strcat st2 (itoa n1)))<br />       (princ<br />         (strcat "\n已消去图元 " (itoa n2) ", 还剩 " (itoa (- n n2)))<br />       )<br />       (redraw)<br />     )<br />   )<br />   (princ)<br /> )<br /> (defun c:rdupent ()<br />   (prompt "\n请选取要消重的图元<退出>:")<br />   (if (setq ss (ssget))<br />     (rdupent ss)<br />   )<br />   (princ)<br /> )[/FONT]

XDSoft

最初由 matichen 发布
[B]我在用那个消图元的程序时碰到了问题。有些pl线几乎一样，点坐标只差一点（反正眼看不出），程序也不会把它消掉，而用cad自带的expresstool里的那个overkill 确能消掉。但我不喜欢用OVERKILL（它会把两个pl线相邻的?.. [/B]

你先看看是否有能力修改，如果修改好了，给大家贴到论坛来，谢谢！

matichen

早搜索过了 。 没有搜索到 我也觉得奇怪。明明命令有，但是真的找不到。是不是做成菜单的时候给编译了。

不过贴出来的看到了。我想我可能搞不定。初学者，不过看看先，

XDSoft

最初由 matichen 发布
[B]早搜索过了 。 没有搜索到 我也觉得奇怪。明明命令有，但是真的找不到。是不是做成菜单的时候给编译了。

不过贴出来的看到了。我想我可能搞不定。初学者，不过看看先， [/B]

搜索时候，命令名前面的下划线别用，我就是搜索出来的。

matichen

请问为何这样用？
(if (= 127 (logand 127 n))
          (princ (strcat st1 (itoa n)))
        )
岂不是n要为127 255 ....才能princ了？ 没搞懂，请指点。

matichen

我水平太低。搞不定，请晓东帮忙。这个容差删重图元的问题。

matichen

拜托，帮帮忙。

XDSoft

最初由 matichen 发布
[B]拜托，帮帮忙。 [/B]

说说你具体的“过虑”条件吧，“重合实体”是指完全重合（类型相同）的实体。

你要误差，那其他条件呢？比如两个实体完全一样吗？怎么个一样法，等等。

条件不确定，可能会误删除其他有用的实体的。

matichen

不知道该怎么说，我放了个图的。图上的“重合”的线并不完全重合，但是不易看出来。坐标只差一点。用CAD 的EXPRESS TOOLS里的那个 overkill 能删除掉。（不知它是用的什么方法容差的？）但是那个命令有问题。那个程序太长了。看晕了。。还请帮帮忙