[原创]：合并图元又有新招

lijiao · 发表于 2004-7-27 13:54:57

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

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

×

在http://www.p4.xdcad.net/forum/showthread.php?s=&postid=1054733#post1054733 中的代码有一个BUG，就是当图形缩小到一定程度，会将不应该合并的线合并在一起。
现在，通过改变程序的处理方法，不仅解决了这一BUG，而且增加了对圆和弧的处理，有兴趣的朋友可以看看。
为了加快处理速度，建议选择的实体不要太多。

[FONT=courier new]
(defun c:hbzhx (/ ARC_LIST ENT I LINE_LIST SS)
(while (and
(setq ss (ssget (list (cons -4 "<or")
(cons 0 "arc")
(cons 0 "CIRCLE")
(cons 0 "line")
(cons -4 "or>")
)
)
)
(> (sslength ss) 0)
)
(hbzhx ss)
)
(princ)
)
(defun cs_pross (to i / CS_TEXT MYI)
(setq cs_text ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>")
(setq myi (fix (/ (* (strlen cs_text) i) to))
cs_text (substr cs_text 1 myi)
)
(grtext -2 cs_text)
)
((defun hbzhx ( ss / ARC_LIST ENT I LINE_LIST SS jd)
;;; 转为数据表
(grtext -2 "正在整理数据")
(setq i 0 jd 1e-5
line_list ' ()
arc_list '()
)
(repeat (sslength ss)
(setq ent (ssname ss i)
i (1+ i)
)
(if (= "LINE" (cdr (assoc 0 (entget ent))))
(setq line_list (cons (line_data ent) line_list))
(setq arc_list (cons (arc_data ent) arc_list))
)
)
(setq line_list (vl-sort line_list
'(lambda (e1 e2)
(if (equal (car e1) (car e2) jd)
(if (equal (cadr e1) (cadr e2) jd)
(if (equal (car (caddr e1)) (car (caddr e2)) jd)
(< (cadr (caddr e1)) (cadr (caddr e2)))
(< (car (caddr e1)) (car (caddr e2)))
)
(< (cadr e1) (cadr e2))
)
(< (car e1) (car e2))
)
)
)
)
(setq arc_list (vl-sort arc_list
'(lambda (e1 e2)
(if (equal (car e1) (car e2) jd)
(if (equal (cadr e1) (cadr e2) jd)
(if (equal (caddr e1) (caddr e2) jd)
(< (cadddr e1) (cadddr e2))
(< (caddr e1) (caddr e2))
)
(< (cadr e1) (cadr e2))
)
(< (car e1) (car e2))
)
)
)
)
(if line_list (hb_line line_list jd))
(if arc_list (hb_arc arc_list jd))
(grtext)
(princ)
)
(defun hb_line (line_list jd / B BIAOJI DATA ENT K LINE_A LINE_B P1 P2 P3 P4 P5 JD XUHAO ZONGSHU i lay)
(setq zongshu (length line_list)
i 0
xuhao 0)
(princ (strcat "\n共处理" (rtos zongshu) "个实体"))
(grtext -1 "合并直线")
(while (> (length line_list) 0)
(setq xuhao (1+ xuhao))
(cs_pross zongshu xuhao)
(setq line_a (car line_list)
line_list (cdr line_list)
biaoji t
k (car line_a)
b (cadr line_a)
p1 (caddr line_a)
p2 (cadddr line_a)
ent (last line_a)
lay (cdr (assoc 8 (entget ent)))
)
(while (and biaoji
(> (length line_list) 0)
)
(setq line_b (car line_list)
)
(cond
((and (equal k (car line_b) jd)
(equal b (cadr line_b) jd)
(= lay (cdr (assoc 8 (entget (last line_b)))))
)
(setq p3 (caddr line_b)
p4 (cadddr line_b)
p5 (vl-sort (list p1 p2 p3 p4)
'(lambda (e1 e2)
(if (equal (car e1) (car e2) jd)
(< (cadr e1) (cadr e2))
(< (car e1) (car e2))
)
)
)
p4 (cadr p5)
)
(if (or (equal p1 p4 jd)
(equal p3 p4 jd)
)
(progn
(setq p1 (car p5)
p2 (last p5)
line_list (cdr line_list)
)
(entdel (last line_b))
(setq xuhao (1+ xuhao))
(cs_pross zongshu xuhao)
(setq i (1+ i))
)
(setq biaoji nil)
)
)
(t (setq biaoji nil))
)
)
(setq data (entget ent)
data (subst (cons 10 p1) (assoc 10 data) data)
data (subst (cons 11 p2) (assoc 11 data) data)
)
(entmod data)
)
(princ (strcat "，删除了" (rtos i) "个实体"))
(princ)
)
(defun hb_arc (arc_list jd / i ARC_A ARC_B BIAOJI BJ DATA EANGL EANGL1 ENT JD LINE_LIST P5 PC SANGL SANGL1 XUHAO ZONGSHU lay)
(setq zongshu (length arc_list)
xuhao 0
i 0)
(princ (strcat "\n共处理" (rtos zongshu) "个实体"))
(grtext -1 "合并圆弧")
(while (> (length arc_list) 0)
(setq xuhao (1+ xuhao))
(cs_pross zongshu xuhao)
(setq arc_a (car arc_list)
arc_list (cdr arc_list)
biaoji t
bj (car arc_a)
pc (list (cadr arc_a) (caddr arc_a))
sangl (cadddr arc_a)
eangl (nth 4 arc_a)
ent (last arc_a)
lay (cdr (assoc 8 (entget ent)))
)
(while (and biaoji
(> (length arc_list) 0)
)
(setq arc_b (car arc_list)
)
(cond
((and (equal bj (car arc_b) jd)
(equal pc (list (cadr arc_b) (caddr arc_b)) jd)
(= lay (cdr (assoc 8 (entget (last arc_b)))))
)
(setq sangl1 (cadddr arc_b)
eangl1 (nth 4 arc_b)
p5 (vl-sort (list sangl eangl sangl1 eangl1)
'(lambda (e1 e2)
(< e1 e2)
)
)
sangl1 (nth (- (length p5) 2) p5)
)
(if (or (equal eangl sangl1 jd)
(equal eangl1 sangl1 jd)
)
(progn
(setq sangl (car p5)
eangl (last p5)
arc_list (cdr arc_list)
)
(entdel (last arc_b))
(setq xuhao (1+ xuhao))
(cs_pross zongshu xuhao)
(setq i (1+ i))
)
(setq biaoji nil)
)
)
(t (setq biaoji nil))
)
)
(setq data (entget ent)
data (subst (cons 50 sangl) (assoc 50 data) data)
data (subst (cons 51 eangl) (assoc 51 data) data)
)
(entmod data)
)
(princ (strcat "，删除了" (rtos i) "个实体"))
(princ)
)
(defun arc_data (ent / BJ DATA EANGL PC SANGL)
(setq data (entget ent))
(setq bj (cdr (assoc 40 data)))
(setq pc (cdr (assoc 10 data)))
(setq sangl (cdr (assoc 50 data)))
(setq eangl (cdr (assoc 51 data)))
(if (not sangl)
(setq sangl 0.0
eangl (+ pi pi)
)
)
(if (< eangl sangl)
(setq eangl (+ eangl (+ pi pi)))
)
(list bj (car pc) (cadr pc) sangl eangl ent)
)
(defun line_data (ent / B K P1 P2 jd)
(setq p1 (vlax-curve-getstartpoint ent)
p2 (vlax-curve-getendpoint ent)
jd 1e-5
)
(if (equal (car p1) (car p2) jd)
(setq k nil
b (car p1)
)
(setq k (/ (- (cadr p2) (cadr p1))
(- (car p2) (car p1))
)
b (- (cadr p1) (* (car p1) k))
)
)
(setq p2 (vl-sort (list p1 p2)
'(lambda (e1 e2)
(if (equal (car e1) (car e2) jd)
(< (cadr e1) (cadr e2))
(< (car e1) (car e2))
)
)
)
p1 (car p2)
p2 (cadr p2)
)
(list k
b
(list (car p1) (cadr p1))
(list (car p2) (cadr p2))
ent
)
) [/FONT]

[FONT=courier new] 
(defun c:hbzhx (/ ARC_LIST ENT I LINE_LIST SS) 
  (while (and 
           (setq ss (ssget (list (cons -4 "<or") 
                                 (cons 0 "arc") 
                                 (cons 0 "CIRCLE") 
                                 (cons 0 "line") 
                                 (cons -4 "or>") 
                           ) 
                    ) 
           ) 
           (> (sslength ss) 0) 
         ) 
    (hbzhx ss) 
    ) 
  (princ) 
  ) 
(defun cs_pross (to i / CS_TEXT MYI) 
  (setq cs_text ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>") 
  (setq myi (fix (/ (* (strlen cs_text) i) to)) 
        cs_text (substr cs_text 1 myi) 
        ) 
  (grtext -2 cs_text) 
  ) 
((defun hbzhx ( ss / ARC_LIST ENT I LINE_LIST SS jd) 
;;;     转为数据表 
     (grtext -2 "正在整理数据") 
     (setq i 0 jd 1e-5 
           line_list ' () 
           arc_list '() 
           ) 
     (repeat (sslength ss) 
       (setq ent (ssname ss i) 
             i (1+ i) 
             ) 
       (if (= "LINE" (cdr (assoc 0 (entget ent)))) 
         (setq line_list (cons (line_data ent) line_list)) 
         (setq arc_list (cons (arc_data ent) arc_list)) 
         ) 
       ) 
     (setq line_list (vl-sort line_list 
                      '(lambda (e1 e2) 
                         (if (equal (car e1) (car e2) jd) 
                           (if (equal (cadr e1) (cadr e2) jd) 
                             (if (equal (car (caddr e1)) (car (caddr e2)) jd) 
                               (< (cadr (caddr e1)) (cadr (caddr e2))) 
                               (< (car (caddr e1)) (car (caddr e2))) 
                               ) 
                             (< (cadr e1) (cadr e2)) 
                             ) 
                           (< (car e1) (car e2)) 
                         ) 
                       ) 
             ) 
    ) 
     (setq arc_list (vl-sort arc_list 
                      '(lambda (e1 e2) 
                         (if (equal (car e1) (car e2) jd) 
                           (if (equal (cadr e1) (cadr e2) jd) 
                             (if (equal (caddr e1) (caddr e2) jd) 
                               (< (cadddr e1) (cadddr e2)) 
                               (< (caddr e1) (caddr e2)) 
                               ) 
                             (< (cadr e1) (cadr e2)) 
                             ) 
                           (< (car e1) (car e2)) 
                         ) 
                       ) 
             ) 
    ) 
     (if line_list (hb_line line_list jd)) 
     (if arc_list (hb_arc arc_list jd)) 
     (grtext) 
  (princ) 
  ) 
(defun hb_line (line_list jd / B BIAOJI DATA ENT K LINE_A LINE_B P1 P2 P3 P4 P5 JD XUHAO ZONGSHU i lay) 
  (setq zongshu (length line_list) 
        i 0 
        xuhao 0) 
  (princ (strcat "\n共处理" (rtos zongshu) "个实体")) 
  (grtext -1 "合并直线") 
  (while (> (length line_list) 0)    
       (setq xuhao (1+ xuhao)) 
       (cs_pross zongshu xuhao) 
    (setq line_a (car line_list) 
          line_list (cdr line_list) 
          biaoji t 
          k (car line_a) 
          b (cadr line_a) 
          p1 (caddr line_a) 
          p2 (cadddr line_a) 
          ent (last line_a) 
          lay (cdr (assoc 8 (entget ent))) 
          ) 
    (while (and biaoji 
                (> (length line_list) 0) 
                ) 
      (setq line_b (car line_list) 
            ) 
      (cond 
        ((and (equal k (car line_b) jd) 
              (equal b (cadr line_b) jd) 
              (= lay (cdr (assoc 8 (entget (last line_b))))) 
              ) 
         (setq p3 (caddr line_b) 
               p4 (cadddr line_b) 
               p5 (vl-sort (list p1 p2 p3 p4) 
                           '(lambda (e1 e2) 
                              (if (equal (car e1) (car e2) jd) 
                                (< (cadr e1) (cadr e2)) 
                                (< (car e1) (car e2)) 
                              ) 
                            ) 
                  ) 
               p4 (cadr p5) 
         ) 
         (if (or (equal p1 p4 jd) 
                 (equal p3 p4 jd) 
             ) 
           (progn 
             (setq p1             (car p5) 
                   p2             (last p5) 
                   line_list (cdr line_list) 
             ) 
             (entdel (last line_b)) 
             (setq xuhao (1+ xuhao)) 
             (cs_pross zongshu xuhao) 
             (setq i (1+ i)) 
           ) 
           (setq biaoji nil) 
         ) 
         ) 
        (t (setq biaoji nil)) 
        ) 
      ) 
    (setq data (entget ent) 
          data (subst (cons 10 p1) (assoc 10 data) data) 
          data (subst (cons 11 p2) (assoc 11 data) data) 
          ) 
    (entmod data) 
    ) 
  (princ (strcat "，删除了" (rtos i) "个实体")) 
  (princ) 
  ) 
(defun hb_arc (arc_list jd / i ARC_A ARC_B BIAOJI BJ DATA EANGL EANGL1 ENT JD LINE_LIST P5 PC SANGL SANGL1 XUHAO ZONGSHU lay) 
  (setq zongshu (length arc_list) 
        xuhao 0 
        i 0) 
  (princ (strcat "\n共处理" (rtos zongshu) "个实体")) 
  (grtext -1 "合并圆弧") 
  (while (> (length arc_list) 0) 
       (setq xuhao (1+ xuhao)) 
       (cs_pross zongshu xuhao) 
    (setq arc_a (car arc_list) 
          arc_list (cdr arc_list) 
          biaoji t 
          bj (car arc_a) 
          pc (list (cadr arc_a) (caddr arc_a)) 
          sangl (cadddr arc_a) 
          eangl (nth 4 arc_a) 
          ent (last arc_a) 
          lay (cdr (assoc 8 (entget ent))) 
          ) 
    (while (and        biaoji 
                (> (length arc_list) 0) 
           ) 
      (setq arc_b (car arc_list) 
      ) 
      (cond 
        ((and (equal bj (car arc_b) jd) 
              (equal pc (list (cadr arc_b) (caddr arc_b)) jd) 
              (= lay (cdr (assoc 8 (entget (last arc_b))))) 
         ) 
         (setq sangl1 (cadddr arc_b) 
               eangl1 (nth 4 arc_b) 
               p5     (vl-sort (list sangl eangl sangl1 eangl1) 
                               '(lambda        (e1 e2) 
                                  (< e1 e2) 
                                ) 
                      ) 
               sangl1 (nth (- (length p5) 2) p5) 
         ) 
         (if (or (equal eangl sangl1 jd) 
                 (equal eangl1 sangl1 jd) 
             ) 
           (progn 
             (setq sangl    (car p5) 
                   eangl    (last p5) 
                   arc_list (cdr arc_list) 
             ) 
             (entdel (last arc_b)) 
             (setq xuhao (1+ xuhao)) 
             (cs_pross zongshu xuhao) 
             (setq i (1+ i)) 
           ) 
           (setq biaoji nil) 
         ) 
        ) 
        (t (setq biaoji nil)) 
      ) 
    ) 
    (setq data (entget ent) 
          data (subst (cons 50 sangl) (assoc 50 data) data) 
          data (subst (cons 51 eangl) (assoc 51 data) data) 
          ) 
    (entmod data) 
    ) 
  (princ (strcat "，删除了" (rtos i) "个实体")) 
  (princ) 
  ) 
(defun arc_data        (ent / BJ DATA EANGL PC SANGL) 
  (setq data (entget ent)) 
  (setq bj (cdr (assoc 40 data))) 
  (setq pc (cdr (assoc 10 data))) 
  (setq sangl (cdr (assoc 50 data))) 
  (setq eangl (cdr (assoc 51 data))) 
  (if (not sangl) 
    (setq sangl        0.0 
          eangl        (+ pi pi) 
    ) 
  ) 
  (if (< eangl sangl) 
    (setq eangl (+ eangl (+ pi pi))) 
  ) 
  (list bj (car pc) (cadr pc) sangl eangl ent) 
) 
 
  (defun line_data (ent / B K P1 P2 jd) 
    (setq p1 (vlax-curve-getstartpoint ent) 
          p2 (vlax-curve-getendpoint ent) 
          jd 1e-5 
    ) 
    (if        (equal (car p1) (car p2) jd) 
      (setq k nil 
            b (car p1) 
      ) 
      (setq k (/ (- (cadr p2) (cadr p1)) 
                 (- (car p2) (car p1)) 
              ) 
            b (- (cadr p1) (* (car p1) k)) 
      ) 
    ) 
    (setq p2 (vl-sort (list p1 p2) 
                      '(lambda (e1 e2) 
                         (if (equal (car e1) (car e2) jd) 
                           (< (cadr e1) (cadr e2)) 
                           (< (car e1) (car e2)) 
                         ) 
                       ) 
             ) 
          p1 (car p2) 
          p2 (cadr p2) 
          ) 
    (list k 
          b 
          (list (car p1) (cadr p1)) 
          (list (car p2) (cadr p2)) 
          ent 
    ) 
  )  [/FONT]

liuyj · 发表于 2004-7-27 15:33:30

好贴！速度确实快！问一个很弱的问题，长老的东东在哪里改一下可以对中间断开的线段和圆弧连接呢？大家都说这种情况更简单，可我搞不出来，先谢谢了！

lijiao · 发表于 2004-7-27 17:02:50

修改HBZHX中对JD的赋值

liuyj · 发表于 2004-7-28 12:25:20

试过了，对多组平行的断开线段会出点小毛病，而且要事先给定jd的值，而我希望对任意间隙长度都能用。麻烦长老再看看。

xiaping · 发表于 2004-7-28 12:55:26

请问为什么有的打断后的圆弧可以合并，有的却没有合并直接删除了？我画了4个圆用一根直线通过进行打断，然后用你的程序进行合并。结果合并了一个圆，删除了两个打断的圆。

aeo · 发表于 2004-7-29 00:47:32

和我思路一样，不过我是按k 和b把大表分成小表的.

上次说的20000多实体,二十几秒,和你差不多.

可惜不考虑z方向.

其实思路都是et工具里的:)

aeo · 发表于 2004-7-29 01:14:33

再次看了一下，层处理上有错误。
比如，排序后，第一和第三个是0层，二四个是1层，一三会合并，二四不合并.

lijiao · 发表于 2004-7-29 07:38:49

最初由 aeo 发布
[B]再次看了一下，层处理上有错误。
比如，排序后，第一和第三个是0层，二四个是1层，一三会合并，二四不合并. [/B]

多谢指出，的确有这个毛病，在我这里都是首尾相接的，所以没有发现这个毛病。
最近我比较忙，等有空再修改（里面还有几个小毛病）。

liuyj · 发表于 2004-7-29 09:36:57

aeo斑竹可以把你的代码贴上来参考参考吗？

lhj743 · 发表于 2004-7-29 10:44:50

楼主，我加载到2004时出现以下错误提示：
命令: (LOAD "C:/Documents and Settings/lihj/桌面/合并图元.lsp") Error:
输入的字符串有缺陷

请指正一下！

lijiao · 发表于 2004-7-29 12:39:31

你从桌面直接拖入ACAD中试一试
多谢AEO的指点，现修改了其中的几处BUG。

aeo · 发表于 2004-7-29 22:45:04

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

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

×

最初由 liuyj 发布
[B]aeo斑竹可以把你的代码贴上来参考参考吗？ [/B]

et里写的那么好，不看，倒要看我的.

可以先看一些你写的吗！其他程序也行.

aeo · 发表于 2004-7-29 22:55:15

最初由 lijiao 发布
[B]
多谢指出，的确有这个毛病，在我这里都是首尾相接的，... [/B]

都是首尾相连，就好办多了.

我arc那一段老写不好.
经过研究发现ET里的arc段有bug。（不是首尾相连时)
首尾相连就简单一些.

已经是圆，就应该画圆，不然arc怎么能画的出来.

liuyj · 发表于 2004-7-30 09:07:34

我哪里有这么高的水平，看别人的程序还要一点一点的分析半天。您实在要看，就把我的连接直线的程序贴上，估计您一看就知道从哪里来的，我费了好几天功夫才改好，可是速度就不行，烦劳您指点指点。其中判断直线是否共线的那一段前一阵子讨论过，最后我借用了陌生人长老的思路，在此感谢。
另：lijiao长老的程序，对中间断开的多个平行线段仍不能用。

[FONT=courier new]
;;;连接线段,适用于中间断开和有重合点的各种情况.
(defun l_lay1 (uua uub / la1 la2)
(xdrx_setenttodb uua)
(setq la1 (xdrx_getentdxf 8))
(xdrx_setenttodb uub)
(setq la2 (xdrx_getentdxf 8))
(= la1 la2)
)
(defun l_line1 (e1 e2 / p2s p2e)
(setq p2s (vlax-curve-getstartpoint e2)
p2e (vlax-curve-getendpoint e2))
(and (equal p2s (vlax-curve-getclosestpointto e1 p2s T) 1e-4)
(equal p2e (vlax-curve-getclosestpointto e1 p2e T) 1e-4)
)
)
(defun l_join1 (ua ub / p1 p2 p3 p4 pn1 pn2 x1 x2 ll1 ll2 n nlast eel)
(xdrx_setenttodb ua)
(setq p1 (xdrx_getentdxf 10)
p2 (xdrx_getentdxf 11)
)
(xdrx_setenttodb ub)
(setq p3 (xdrx_getentdxf 10)
p4 (xdrx_getentdxf 11)
ll1 (list p1 p2 p3 p4)
)
(foreach x1 ll1
(foreach x2 ll1
(setq ll2 (cons (list (distance x1 x2) x1 x2) ll2))
)
)
(setq ll2 (apply 'xdrx_rlistsort1 ll2)
n (length ll2)
nlast (nth (- n 1) ll2)
pn1 (cadr nlast)
pn2 (caddr nlast)
)
(xdrx_modent 10 pn1)
(xdrx_modent 11 pn2)
(command "erase" ua "")
ub
)
(defun c:lj (/ a1 s1 m1 e1 e2 cm p0 p1 p2 p3 p4)
(setvar "blipmode" 0)
(setq a1 1)
(while (= a1 1)
(prompt "\n选取要连接的线段:"
)
(if (setq s1 (ssget '((0 . "LINE"))))
(progn
(setq m1 0)
(while (and s1 (setq e1 (ssname s1 m1)))
(xdrx_setenttodb e1)
(if (= (xdrx_getentdxf 0) "LINE")
(progn
(if (= (car (xdrx_object_get_xrecord e1 "lxz")) 1)
(xdrx_object_set_xrecord e1 "lxz" 0)
)
(setq m1 (1+ m1))
)
)
)
(while (and s1 (setq e1 (ssname s1 0)))
(ssdel e1 s1)
(setq m1 0)
(while (and s1 (setq e2 (ssname s1 m1)))
(if (l_lay1 e1 e2)
(progn
(if (l_line1 e1 e2)
(progn
(ssdel e2 s1)
(xdrx_setenttodb e1)
(setq cm (xdrx_getentdxf 8))
(setq e1 (l_join1 e1 e2))
(xdrx_setenttodb e1)
(xdrx_modent 8 cm)
(setq m1 (- 1 m1))
)
(progn
(xdrx_setenttodb e1)
(setq p1 (xdrx_getentdxf 10)
p2 (xdrx_getentdxf 11)
)
(xdrx_setenttodb e2)
(setq p3 (xdrx_getentdxf 10)
p4 (xdrx_getentdxf 11)
)
(if (and (not (inters p1 p2 p3 p4 T))
(setq p0 (inters p1 p2 p3 p4 nil))
)
(progn
(if (> (max (distance p0 p1) (distance p0 p2))
(distance p1 p2)
)
(progn
(xdrx_setenttodb e1)
(if (< (distance p0 p1) (distance p0 p2))
(xdrx_modent 10 p0)
(xdrx_modent 11 p0)
)
)
)
(if (> (max (distance p0 p3) (distance p0 p4))
(distance p3 p4)
)
(progn
(xdrx_setenttodb e2)
(if (< (distance p0 p3) (distance p0 p4))
(xdrx_modent 10 p0)
(xdrx_modent 11 p0)
)
)
)
)
)
)
)
)
)
(setq m1 (1+ m1))
)
)
)
(setq a1 0)
)
)
(princ)
)
[/FONT]

[FONT=courier new] 
;;;连接线段,适用于中间断开和有重合点的各种情况. 
(defun l_lay1 (uua uub / la1 la2) 
  (xdrx_setenttodb uua) 
  (setq la1 (xdrx_getentdxf 8)) 
  (xdrx_setenttodb uub) 
  (setq la2 (xdrx_getentdxf 8)) 
  (= la1 la2) 
) 
 
(defun l_line1 (e1 e2 / p2s p2e) 
  (setq p2s (vlax-curve-getstartpoint e2) 
        p2e (vlax-curve-getendpoint e2)) 
  (and (equal p2s (vlax-curve-getclosestpointto e1 p2s T) 1e-4) 
       (equal p2e (vlax-curve-getclosestpointto e1 p2e T) 1e-4) 
  ) 
) 
 
(defun l_join1 (ua ub / p1 p2 p3 p4 pn1 pn2 x1 x2 ll1 ll2 n nlast eel) 
  (xdrx_setenttodb ua) 
  (setq        p1 (xdrx_getentdxf 10) 
        p2 (xdrx_getentdxf 11) 
  ) 
  (xdrx_setenttodb ub) 
  (setq        p3  (xdrx_getentdxf 10) 
        p4  (xdrx_getentdxf 11) 
        ll1 (list p1 p2 p3 p4) 
  ) 
  (foreach x1 ll1 
    (foreach x2        ll1 
      (setq ll2 (cons (list (distance x1 x2) x1 x2) ll2)) 
    ) 
  ) 
  (setq        ll2   (apply 'xdrx_rlistsort1 ll2) 
        n     (length ll2) 
        nlast (nth (- n 1) ll2) 
        pn1   (cadr nlast) 
        pn2   (caddr nlast) 
  ) 
  (xdrx_modent 10 pn1) 
  (xdrx_modent 11 pn2) 
  (command "erase" ua "") 
  ub 
) 
 
(defun c:lj (/ a1 s1 m1 e1 e2 cm p0 p1 p2 p3 p4) 
  (setvar "blipmode" 0) 
  (setq a1 1) 
  (while (= a1 1) 
    (prompt "\n选取要连接的线段:" 
    ) 
    (if        (setq s1 (ssget '((0 . "LINE")))) 
      (progn 
        (setq m1 0) 
        (while (and s1 (setq e1 (ssname s1 m1))) 
          (xdrx_setenttodb e1) 
          (if (= (xdrx_getentdxf 0) "LINE") 
            (progn 
              (if (= (car (xdrx_object_get_xrecord e1 "lxz")) 1) 
                (xdrx_object_set_xrecord e1 "lxz" 0) 
              ) 
              (setq m1 (1+ m1)) 
            ) 
          ) 
        ) 
        (while (and s1 (setq e1 (ssname s1 0))) 
          (ssdel e1 s1) 
          (setq m1 0) 
          (while (and s1 (setq e2 (ssname s1 m1))) 
            (if        (l_lay1 e1 e2) 
              (progn 
                (if (l_line1 e1 e2) 
                  (progn 
                    (ssdel e2 s1) 
                    (xdrx_setenttodb e1) 
                    (setq cm (xdrx_getentdxf 8)) 
                    (setq e1 (l_join1 e1 e2)) 
                    (xdrx_setenttodb e1) 
                    (xdrx_modent 8 cm) 
                    (setq m1 (- 1 m1)) 
                  ) 
                  (progn 
                    (xdrx_setenttodb e1) 
                    (setq p1 (xdrx_getentdxf 10) 
                          p2 (xdrx_getentdxf 11) 
                    ) 
                    (xdrx_setenttodb e2) 
                    (setq p3 (xdrx_getentdxf 10) 
                          p4 (xdrx_getentdxf 11) 
                    ) 
                    (if        (and (not (inters p1 p2 p3 p4 T)) 
                             (setq p0 (inters p1 p2 p3 p4 nil)) 
                        ) 
                      (progn 
                        (if (> (max (distance p0 p1) (distance p0 p2)) 
                               (distance p1 p2) 
                            ) 
                          (progn 
                            (xdrx_setenttodb e1) 
                            (if        (< (distance p0 p1) (distance p0 p2)) 
                              (xdrx_modent 10 p0) 
                              (xdrx_modent 11 p0) 
                            ) 
                          ) 
                        ) 
                        (if (> (max (distance p0 p3) (distance p0 p4)) 
                               (distance p3 p4) 
                            ) 
                          (progn 
                            (xdrx_setenttodb e2) 
                            (if        (< (distance p0 p3) (distance p0 p4)) 
                              (xdrx_modent 10 p0) 
                              (xdrx_modent 11 p0) 
                            ) 
                          ) 
                        ) 
                      ) 
                    ) 
                  ) 
                ) 
              ) 
            ) 
            (setq m1 (1+ m1)) 
          ) 
        ) 
      ) 
      (setq a1 0) 
    ) 
  ) 
  (princ) 
) 
  [/FONT]

shisj · 发表于 2004-8-2 12:40:11

水平不够，还没有看懂啊。

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

[原创]：合并图元又有新招

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

相关帖子

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

相关帖子

浏览过的版块