[原创]：合并直线

lijiao · 发表于 2003-8-13 15:07:19

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

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

×

搞三维设计时经常遇到这样的问题：
三维软件（如SOLIDWORKS、INVENTOR等）的三维功能比较丰富，但二维功能却不多么令人满意，三维转二维后图形不标准，转到ACAD中后，又会产生许多重叠的线，即一条线段变成了许多短线。
针对这个问题，我编写了一段程序来进行处理，可以将这些重叠的线段合并在一起。
现贴出源代码，请大家指点指点。

[FONT=courier new]
(defun c:hbzhx (/ ss ss1 ss2 ss3 zongshu xuhao)
(if (setq ss (ssget (list (cons 0 "LINE")
(cons 410 (getvar "CTAB"))
)
)
)
(progn
(setq ss (ss->list ss)
zongshu (length ss)
xuhao 1
)
(while (> (length ss) 1)
(setq ss1 (car ss)
ss (vl-remove ss1 ss)
ss3 ss
)
(grtext -1
(strcat "正在处理："
(rtos xuhao 2 1)
"/"
(rtos zongshu 2 1)
)
)
(setq xuhao (1+ xuhao))
(while (> (length ss3) 0)
(setq ss2 (car ss3)
ss3 (vl-remove ss2 ss3)
)
(if (hbline ss1 ss2)
(progn
(setq ss (vl-remove ss2 ss)
ss3 ss
)
(grtext -1
(strcat "正在处理："
(rtos xuhao 2 1)
"/"
(rtos zongshu 2 1)
)
)
(setq xuhao (1+ xuhao))
(vla-delete (vlax-ename->vla-object ss2))
)
)
)
)
)
)
(grtext)
(princ)
)
(defun hbline (ent_line1 ent_line2 / ent_data1
ent_data2 p1 p2 p3 p4
pt ang1 ang2 gxbj
)
(setq ent_data1 (entget ent_line1)
ent_data2 (entget ent_line2)
p1 (cdr (assoc 10 ent_data1))
p2 (cdr (assoc 11 ent_data1))
p3 (cdr (assoc 10 ent_data2))
p4 (cdr (assoc 11 ent_data2))
pt (sorty p1 p2)
p1 (car pt)
p2 (cadr pt)
pt (sorty p3 p4)
p3 (car pt)
p4 (cadr pt)
ang1 (angle p1 p2)
ang2 (angle p3 p4)
gxbj nil
)
(if (equal ang1 pi 0.0001)
(setq pt p1
p1 p2
p2 pt
ang1 0.0
)
)
(if (equal ang2 pi 0.0001)
(setq pt p3
p3 p4
p4 pt
ang2 0.0
)
)
(if (equal ang1 (* 2 pi) 0.0001)
(setq ang1 0.0)
)
(if (equal ang2 (* 2 pi) 0.0001)
(setq ang2 0.0)
)
(if (equal ang1 ang2 0.0001)
(if (or (not (equal (car p1) (car p3) 0.0001))
(not (equal (cadr p1) (cadr p3) 0.0001))
)
(progn
(if (equal ang1 0.0 0.0001)
(setq pt (sortx p1 p3))
(setq pt (sorty p1 p3))
)
(if
(or (equal ang1 (angle (car pt) (cadr pt)) 0.0001)
(equal ang1 (- (* 2 pi) (angle (car pt) (cadr pt))) 0.0001)
)
(if (or (equal (distance p1 p2)
(+ (distance p1 p3) (distance p2 p3))
0.0001
)
(equal (distance p1 p2)
(+ (distance p1 p4) (distance p2 p4))
0.0001
)
)
(setq gxbj t)
)
)
)
(setq gxbj t)
)
)
(if gxbj
(progn
(if (equal 0.0 ang1 0.0001)
(setq pt
(vl-sort (list p1 p2 p3 p4)
(function (lambda (e1 e2) (< (car e1) (car e2))))
)
)
(setq pt
(vl-sort (list p1 p2 p3 p4)
(function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
)
)
)
(setq p1 (car pt)
p2 (nth 3 pt)
p1 (cons 10 p1)
p2 (cons 11 p2)
ent_data1 (subst p1 (assoc 10 ent_data1) ent_data1)
ent_data1 (subst p2 (assoc 11 ent_data1) ent_data1)
)
(entmod ent_data1)
)
)
gxbj
)
(defun ss->list (ss / cs_i out)
(if (= (type ss) 'PICKSET)
(progn
(setq cs_i 0
out '()
)
(repeat (sslength ss)
(setq out (cons (ssname ss cs_i) out))
(setq cs_i (1+ cs_i))
)
(setq out (reverse out))
)
)
)
(defun sortx (pt1 pt2 /)
(vl-sort (list pt1 pt2)
(function (lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
)
(defun sorty (pt1 pt2 /)
(vl-sort (list pt1 pt2)
(function (lambda (e1 e2)
(< (cadr e1) (cadr e2))
)
)
)
)
[/FONT]

[FONT=courier new] 
(defun c:hbzhx (/ ss ss1 ss2 ss3 zongshu xuhao) 
  (if (setq ss (ssget (list (cons 0 "LINE") 
                            (cons 410 (getvar "CTAB")) 
                      ) 
               ) 
      ) 
    (progn 
      (setq ss            (ss->list ss) 
            zongshu (length ss) 
            xuhao   1 
      ) 
      (while (> (length ss) 1) 
        (setq ss1 (car ss) 
              ss  (vl-remove ss1 ss) 
              ss3 ss 
        ) 
        (grtext        -1 
                (strcat        "正在处理：" 
                        (rtos xuhao 2 1) 
                        "/" 
                        (rtos zongshu 2 1) 
                ) 
        ) 
        (setq xuhao (1+ xuhao)) 
        (while (> (length ss3) 0) 
          (setq        ss2 (car ss3) 
                ss3 (vl-remove ss2 ss3) 
          ) 
          (if (hbline ss1 ss2) 
            (progn 
              (setq ss        (vl-remove ss2 ss) 
                    ss3        ss 
              ) 
              (grtext -1 
                      (strcat "正在处理：" 
                              (rtos xuhao 2 1) 
                              "/" 
                              (rtos zongshu 2 1) 
                      ) 
              ) 
              (setq xuhao (1+ xuhao)) 
              (vla-delete (vlax-ename->vla-object ss2)) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (grtext) 
  (princ) 
) 
 
 
(defun hbline (ent_line1         ent_line2           /            ent_data1 
               ent_data2         p1          p2           p3            p4 
               pt        ang1         ang2          gxbj 
              ) 
  (setq        ent_data1 (entget ent_line1) 
        ent_data2 (entget ent_line2) 
        p1          (cdr (assoc 10 ent_data1)) 
        p2          (cdr (assoc 11 ent_data1)) 
        p3          (cdr (assoc 10 ent_data2)) 
        p4          (cdr (assoc 11 ent_data2)) 
        pt          (sorty p1 p2) 
        p1          (car pt) 
        p2          (cadr pt) 
        pt          (sorty p3 p4) 
        p3          (car pt) 
        p4          (cadr pt) 
        ang1          (angle p1 p2) 
        ang2          (angle p3 p4) 
        gxbj          nil 
  ) 
  (if (equal ang1 pi 0.0001) 
    (setq pt   p1 
          p1   p2 
          p2   pt 
          ang1 0.0 
    ) 
  ) 
  (if (equal ang2 pi 0.0001) 
    (setq pt   p3 
          p3   p4 
          p4   pt 
          ang2 0.0 
    ) 
  ) 
  (if (equal ang1 (* 2 pi) 0.0001) 
    (setq ang1 0.0) 
  ) 
  (if (equal ang2 (* 2 pi) 0.0001) 
    (setq ang2 0.0) 
  ) 
  (if (equal ang1 ang2 0.0001) 
    (if        (or (not (equal (car p1) (car p3) 0.0001)) 
            (not (equal (cadr p1) (cadr p3) 0.0001)) 
        ) 
      (progn 
        (if (equal ang1 0.0 0.0001) 
          (setq pt (sortx p1 p3)) 
          (setq pt (sorty p1 p3)) 
        ) 
        (if 
          (or (equal ang1 (angle (car pt) (cadr pt)) 0.0001) 
              (equal ang1 (- (* 2 pi) (angle (car pt) (cadr pt))) 0.0001) 
          ) 
           (if (or (equal (distance p1 p2) 
                          (+ (distance p1 p3) (distance p2 p3)) 
                          0.0001 
                   ) 
                   (equal (distance p1 p2) 
                          (+ (distance p1 p4) (distance p2 p4)) 
                          0.0001 
                   ) 
               ) 
             (setq gxbj t) 
           ) 
        ) 
      ) 
      (setq gxbj t) 
    ) 
  ) 
  (if gxbj 
    (progn 
      (if (equal 0.0 ang1 0.0001) 
        (setq pt 
               (vl-sort        (list p1 p2 p3 p4) 
                        (function (lambda (e1 e2) (< (car e1) (car e2)))) 
               ) 
        ) 
        (setq pt 
               (vl-sort        (list p1 p2 p3 p4) 
                        (function (lambda (e1 e2) (< (cadr e1) (cadr e2)))) 
               ) 
        ) 
      ) 
      (setq p1              (car pt) 
            p2              (nth 3 pt) 
            p1              (cons 10 p1) 
            p2              (cons 11 p2) 
            ent_data1 (subst p1 (assoc 10 ent_data1) ent_data1) 
            ent_data1 (subst p2 (assoc 11 ent_data1) ent_data1) 
      ) 
      (entmod ent_data1) 
    ) 
  ) 
  gxbj 
) 
(defun ss->list        (ss / cs_i out) 
  (if (= (type ss) 'PICKSET) 
    (progn 
      (setq cs_i 0 
            out        '() 
      ) 
      (repeat (sslength ss) 
        (setq out (cons (ssname ss cs_i) out)) 
        (setq cs_i (1+ cs_i)) 
      ) 
      (setq out (reverse out)) 
    ) 
  ) 
) 
(defun sortx (pt1 pt2 /) 
  (vl-sort (list pt1 pt2) 
           (function (lambda (e1 e2) 
                       (< (car e1) (car e2)) 
                     ) 
           ) 
  ) 
) 
(defun sorty (pt1 pt2 /) 
  (vl-sort (list pt1 pt2) 
           (function (lambda (e1 e2) 
                       (< (cadr e1) (cadr e2)) 
                     ) 
           ) 
  ) 
) 
  [/FONT]

panzhongw · 发表于 2003-8-13 18:06:16

好东西！值得学习！

zb_lou · 发表于 2003-8-19 17:46:34

我也想过编这样的程序
这是个好东西！很好！

chenhang · 发表于 2004-4-24 17:38:33

最初由 lijiao 发布
[B]搞三维设计时经常遇到这样的问题：
三维软件（如SOLIDWORKS、INVENTOR等）的三维功能比较丰富，但二维功能却不多么令人满意，三维转二维后图形不标准，转到ACAD中后，又会产生许多重叠的线，即一条线段变成了许多短... [/B]

能编一个中间断开一定距离的直线合并吗?

XDSoft · 发表于 2004-4-24 18:37:14

最初由 chenhang 发布
[B][QUOTE]最初由 lijiao 发布
[B]搞三维设计时经常遇到这样的问题：
三维软件（如SOLIDWORKS、INVENTOR等）的三维功能比较丰富，但二维功能却不多么令人满意，三维转二维后图形不标准，转到ACAD中后，又会产?.. [/B]

晓东工具箱的“曲线工具”里面的“合并线段”就是你要求的。

lijiao · 发表于 2004-4-25 10:35:29

由于我是搞机械的，所以没有安装晓东工具箱
我希望将共线，并且相互重叠或首尾相接的线进行合并，否则不要合并。

XDSoft · 发表于 2004-4-25 10:38:06

最初由 lijiao 发布
[B]由于我是搞机械的，所以没有安装晓东工具箱
我希望将共线，并且相互重叠或首尾相接的线进行合并，否则不要合并。 [/B]

现在的晓东工具箱90％的工具是“通用”的，“合并线段”正是你上面要求的。

lijiao · 发表于 2004-4-25 12:04:24

我安装一下试试
多谢
最近我也打算研究一下晓东工具箱

XDSoft · 发表于 2004-4-25 12:22:37

最初由 lijiao 发布
[B]我安装一下试试
多谢
最近我也打算研究一下晓东工具箱 [/B]

推荐你下载0.29版本装到2002下面，在2004、2005下比2002，晓东工具箱少了一些工具。比如带动态拖动的等等。

kingofrpg · 发表于 2004-4-25 12:54:50

AutoCAD的扩展工具Express Tools里的PLJOIN命令不就干这个的吗？

PFD8667 · 发表于 2004-8-22 07:48:02

晓东工具主要用于建筑,我搞机械的感到不适用

xjjy · 发表于 2004-9-11 11:35:12

这是个好东西！很好！
很使用！
谢谢！

dezhang · 发表于 2005-10-14 23:10:33

请问什么是ET

camelry · 发表于 2005-10-19 07:11:24

谢谢！

比木愚 · 发表于 2005-10-24 16:27:10

我觉的XD工具不是很实用，你说的那个用2006就能解决啊！J命令，很好用啊

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

[原创]：合并直线

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

评分

本帖被以下淘专辑推荐:

相关帖子

Re: [原创]：合并直线

Re: Re: [原创]：合并直线