麻烦哪位老师大大修改下线相接的代码谢谢

flytoday

                                        ;
(defun ss-sslist (ss / n en enlis)
  (setq n (sslength ss))
  (repeat n
    (setq en (ssname ss (setq n (1- n))))
    (setq enlis (cons en enlis))
  )
)
(defun c:swl (/ ss)
  (setvar "CMDECHO" 0)
  (command "undo" "be")
  (setq ss (ssget))
  (setq ss (ss-sslist ss))
  (foreach x ss
    (mapcar '(lambda (y)
               (command "join" x y "")
             )
            ss
    )
  )
  (command "undo" "e")
  (setvar "CMDECHO" 1)
  (princ)
)


这个代码为开心哥原创。我用着用着感觉不是那么顺手。。
这个代码功能就是在一条直线上的几段线，合并成一条线。。
我想增加个功能，就是增加个条件线与线端点距离限制，只合并限制距离之类的端点线。如下图

langjs

求人不如求己，还是自己学会才好，实在不会在求助。大家都很忙的……

改了一个论坛的删除重复线的程序给你，自己编就懒得编了。
;;; ==========================
;;; 功能：线连接　　 命令:qq　
;;; ==========================
(defun c:qq (/ b biaoji data e1 e2 ent i j jd k line_a line_b line_list p1 p2 p3 p4 p5 p6 s ss xuhao zongshu)
  (defun line_data (ent / b e1 e2 jd k p1 p2)
    (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)
  )
  (setvar "cmdecho" 0)
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (command ".UNDO" "g")
      (if (null juli0001)
        (setq juli0001 100)               ; 此处是默认的直线最大连接间距为100,其它默认值自行修改
      )
      (if (setq s (getint (strcat "\n设置直线最大连接间距:<" (itoa juli0001) ">")))
        (setq juli0001 s)
      )
      (setq line_list '()
            jd 1e-5
      )
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i))))
        (setq line_list (cons (line_data ent) line_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 zongshu (length line_list)
            i 0
            j 0
            xuhao 0
      )
      (princ (strcat "\n共选择" (rtos zongshu) "条线"))
      (while (> (length line_list) 0)
        (setq xuhao (1+ 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)
        )
        (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)
             )
              (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))
                                                      )
                                                    )
                       )
                    p6 (cadr p5)
              )
              (if (or
                    (equal p1 p6 jd)
                    (equal p3 p6 jd)
                  )
                (progn
                  (setq p1 (car p5)
                        p2 (last p5)
                        line_list (cdr line_list)
                  )
                  (entdel (last line_b))
                  (setq xuhao (1+ xuhao))
                  (setq i (1+ i))
                )
                (if (or
                      (< (distance p2 p3) juli0001)
                    )
                  (progn
                    (setq p1 (car p5)
                          p2 (last p5)
                          line_list (cdr line_list)
                    )
                    (entdel (last line_b))
                    (setq xuhao (1+ xuhao))
                    (setq j (1+ j))
                  )
                  (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) "条重复线，连接了" (rtos j) "条线，剩余" (rtos (- zongshu j i)) "条线。"))
      (command ".UNDO" "E")
    )
  )
  (princ)
)

hgf876

这个命令( swl )好像不能合并线噢。

flytoday

hgf876 发表于 2012-2-25 12:56
这个命令( swl )好像不能合并线噢。

下载那个附件可以哦我又试了哈

hgf876

flytoday 发表于 2012-2-25 13:09
下载那个附件可以哦我又试了哈

哈哈，我在AUTOCAD2004中试用的，不行。
在AUTOCAD2009试用是可以。

flytoday

hgf876 发表于 2012-2-25 13:31
哈哈，我在AUTOCAD2004中试用的，不行。
在AUTOCAD2009试用是可以。

2006以上都行吧

flytoday

咋没高手出手勒。要又沉了自己顶上~

tjuzkj

提供个思路：
1.选择所有要连接的直线，取得它们的两个端点坐标，构建一个点集。
2.对集合内的点进行排序。
3.依次判断相邻两点的距离，如第2点与第3点，第4点与第5点，......，
   如距离小于你设定的值，则剔除该两个点。
4.删除原有直线选择集。
5.依次取出经过处理后的点集中的点，如第1点与第2点，第3点与第4点，依次用line命令画线！
6.经过以上步骤，你想要的效果就能实现了！

flytoday

tjuzkj 发表于 2012-2-25 19:50
提供个思路：
1.选择所有要连接的直线，取得它们的两个端点坐标，构建一个点集。
2.对集合内的点进行排序 ...

哥，偶不会啊。真不会

haiyunzhou

7楼思路不错 学习了