[求助]：请高手看一下这个消重实体的问题是什么，

tc405003 · 发表于 2006-7-30 22:48:50

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

可否改成带误差消重，

(defun c:Xcst (/ ss smx e el el0 n
n1 n2 i i1 stl st1 st2
name la p ln ln2 le le1
lp 3dface attdef arc circle dimension
insert line lwpolyline point polyline
solid text trace tt
)
(vl-load-com)
(setq tt 0)
(if (and (= tt 0)
(princ "\n选择要进行重叠处理的实体<全部>: ")
(if (null (setq ss (ssget)))
(setq ss (ssget "x"))
ss
)
)
(progn (setq st1 (strcat "\r已搜索到实体 ")
st2 (strcat "\r已处理实体 ")
n 0
n1 0
n2 0
i 0
smx (sslength ss)
ln '(3dface attdef arc circle
dimension insert line lwpolyline
point solid text ;trace
)
)
(while (< n smx)
(setq e (ssname ss n)
n (1+ n)
la (tc-dxf e 8);取得图层
name (tc-dxf e 0);取得类型
p (cond ((= "POLYLINE" name) (tc-dxf (entnext e) 10));如果是多义线则取得顶点
((= "LWPOLYLINE" name) (car (tc-dxf e 10)));如果是轻装多义线则取得顶点
(t (tc-dxf e 10))
)
name (read name)
la (strcat la (rtos (car p) 2 0) (rtos (cadr p) 2 0))
le (assoc la (eval name))
)
(set name
(if le
(subst (append le (list e)) le (eval name))
(cons (list la e) (eval name))
)
)
(if (= 127 (logand 127 n))
(princ (strcat st1 (itoa n)))
)
)
(princ (strcat st1 (itoa n) "\n"))
(foreach ln1 ln
(setq ln2 (eval ln1))
(foreach le ln2
(setq le (cdr le))
(while (setq e (car le))
(if (setq n1 (1+ n1)
le (cdr le)
)
(progn (setq el0 (entget e)
el0 (member (assoc 10 el0) el0)
le1 nil
)
(foreach e le
(setq el (entget e)
el (member (assoc 10 el) el)
)
(if (equal el el0)
(progn (entdel e)
(setq n1 (1+ n1)
n2 (1+ n2)
)
)
(setq le1 (cons e le1))
)
)
(setq le le1)
)
)
)
(if (> i 100)
(progn (princ (strcat st2 (itoa n1))) (setq i 0))
(setq i (1+ i))
)
)
)
(foreach le polyline
(setq le (cdr le))
(while (setq e (car le))
(if (setq n1 (1+ n1)
le (cdr le)
)
(progn (setq lp nil
le1 nil
)
(while (setq e (entnext e)
p (tc-dxf e 10)
)
(setq lp (cons p lp))
)
(setq lp (reverse lp))
(foreach e le
(setq i1 0)
(while (and (setq e (entnext e)
p (tc-dxf e 10)
)
(equal p (nth i1 lp))
)
(setq i1 (1+ i1))
)
(if p
(setq le1 (cons e le1))
(progn (entdel e)
(setq n1 (1+ n1)
n2 (1+ n2)
)
)
)
)
(setq le le1)
)
)
)
(if (> i 100)
(progn (princ (strcat st2 (itoa n1))) (setq i 0))
(setq i (1+ i))
)
)
(princ (strcat st2 (itoa n1)))
(princ
(strcat "\n已消去实体 " (itoa n2) ", 还剩 " (itoa (- n n2)))
)
(redraw)
)
)
)
(DEFUN TC-DXF (ELIST CODE)
(CDR (ASSOC CODE (ENTGET ELIST)))
) ;_ 结束defun
;;;

(defun c:Xcst        (/        ss     smx    e             el            el0           n 
                 n1        n2     i      i1     stl    st1           st2 
                 name        la     p      ln     ln2    le           le1 
                 lp        3dface attdef arc    circle dimension 
                 insert        line   lwpolyline    point  polyline 
                 solid        text   trace tt 
                ) 
  (vl-load-com) 
  (setq tt 0) 
  (if (and (= tt 0) 
           (princ "\n选择要进行重叠处理的实体<全部>: ") 
           (if (null (setq ss (ssget))) 
             (setq ss (ssget "x")) 
             ss 
           ) 
      ) 
    (progn (setq st1 (strcat "\r已搜索到实体 ") 
                 st2 (strcat "\r已处理实体 ") 
                 n   0 
                 n1  0 
                 n2  0 
                 i   0 
                 smx (sslength ss) 
                 ln  '(3dface         attdef           arc             circle 
                       dimension insert           line             lwpolyline 
                       point         solid           text             ;trace 
                      ) 
           ) 
           (while (< n smx) 
             (setq e        (ssname ss n) 
                   n        (1+ n) 
                   la        (tc-dxf e 8);取得图层 
                   name        (tc-dxf e 0);取得类型 
                   p        (cond ((= "POLYLINE" name) (tc-dxf (entnext e) 10));如果是多义线则取得顶点 
                              ((= "LWPOLYLINE" name) (car (tc-dxf e 10)));如果是轻装多义线则取得顶点 
                              (t (tc-dxf e 10)) 
                        ) 
                   name        (read name) 
                   la        (strcat la (rtos (car p) 2 0) (rtos (cadr p) 2 0)) 
                   le        (assoc la (eval name)) 
             ) 
             (set name 
                  (if le 
                    (subst (append le (list e)) le (eval name)) 
                    (cons (list la e) (eval name)) 
                  ) 
             ) 
             (if (= 127 (logand 127 n)) 
               (princ (strcat st1 (itoa n))) 
             ) 
           ) 
           (princ (strcat st1 (itoa n) "\n")) 
           (foreach ln1        ln 
             (setq ln2 (eval ln1)) 
             (foreach le ln2 
               (setq le (cdr le)) 
               (while (setq e (car le)) 
                 (if (setq n1 (1+ n1) 
                           le (cdr le) 
                     ) 
                   (progn (setq        el0 (entget e) 
                                el0 (member (assoc 10 el0) el0) 
                                le1 nil 
                          ) 
                          (foreach e le 
                            (setq el (entget e) 
                                  el (member (assoc 10 el) el) 
                            ) 
                            (if        (equal el el0) 
                              (progn (entdel e) 
                                     (setq n1 (1+ n1) 
                                           n2 (1+ n2) 
                                     ) 
                              ) 
                              (setq le1 (cons e le1)) 
                            ) 
                          ) 
                          (setq le le1) 
                   ) 
                 ) 
               ) 
               (if (> i 100) 
                 (progn (princ (strcat st2 (itoa n1))) (setq i 0)) 
                 (setq i (1+ i)) 
               ) 
             ) 
           ) 
           (foreach le polyline 
             (setq le (cdr le)) 
             (while (setq e (car le)) 
               (if (setq n1 (1+ n1) 
                         le (cdr le) 
                   ) 
                 (progn        (setq lp  nil 
                              le1 nil 
                        ) 
                        (while (setq e (entnext e) 
                                     p (tc-dxf e 10) 
                               ) 
                          (setq lp (cons p lp)) 
                        ) 
                        (setq lp (reverse lp)) 
                        (foreach e le 
                          (setq i1 0) 
                          (while (and (setq e (entnext e) 
                                            p (tc-dxf e 10) 
                                      ) 
                                      (equal p (nth i1 lp)) 
                                 ) 
                            (setq i1 (1+ i1)) 
                          ) 
                          (if p 
                            (setq le1 (cons e le1)) 
                            (progn (entdel e) 
                                   (setq n1 (1+ n1) 
                                         n2 (1+ n2) 
                                   ) 
                            ) 
                          ) 
                        ) 
                        (setq le le1) 
                 ) 
               ) 
             ) 
             (if (> i 100) 
               (progn (princ (strcat st2 (itoa n1))) (setq i 0)) 
               (setq i (1+ i)) 
             ) 
           ) 
           (princ (strcat st2 (itoa n1))) 
           (princ 
             (strcat "\n已消去实体 " (itoa n2) ", 还剩 " (itoa (- n n2))) 
           ) 
           (redraw) 
    ) 
  ) 
) 
(DEFUN TC-DXF (ELIST CODE) 
  (CDR (ASSOC CODE (ENTGET ELIST))) 
) ;_ 结束defun 
;;;

fsxm · 发表于 2006-8-6 13:05:29

老兄真是高人啊！程序真的很不错
程序太长我功力不够啦！看的晕啊
可不可以多分子程序多写点注释啊？多谢多谢！

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：请高手看一下这个消重实体的问题是什么，

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子