首尾连接但不闭合的多段线如何使之闭合

gaics

多段线首尾连接貌似闭合，但实际上是不闭合的。直接利用属性面板或者Pedit命令使之闭合后会多一个重复的夹点，我的方法是通过修改组码删除重复的点，再使之闭合。请教各位有更简单的方法吗？

2. (defun c:tt5 (/ ent a pt i ii lst)
   
3.   (setq ent(entget (car (entsel))))
   
4.   (setq pt (assoc 10 ent))
   
5.   (setq i 0)
   
6.   (setq ii 0)
   
7.   (setq lst '())
   
8.   (repeat (length ent)
   
9.     (setq a (nth i ent))
   
10.     (if  (equal pt a)
    
11.       (progn (setq ii (1+ ii))
    
12.        (if (< ii 2)
    
13.          (setq lst (cons a lst))
    
14.        )
    
15.       )
    
16.       (setq lst (cons a lst))
    
17.     )
    
18.     (setq i (1+ i))
    
19.   )
    
20.   (setq ent (reverse lst))
    
21.   (entmod (subst '(70 . 1) '(70 . 0) ent))
    
22.   (princ)
    
23. )

(defun c:tt5 (/ ent a pt i ii lst)<br />   (setq ent(entget (car (entsel))))<br />   (setq pt (assoc 10 ent))<br />   (setq i 0)<br />   (setq ii 0)<br />   (setq lst '())<br />   (repeat (length ent)<br />     (setq a (nth i ent))<br />     (if  (equal pt a)<br />       (progn (setq ii (1+ ii))<br />        (if (< ii 2)<br />          (setq lst (cons a lst))<br />        )<br />       )<br />       (setq lst (cons a lst))<br />     )<br />     (setq i (1+ i))<br />   )<br />   (setq ent (reverse lst))<br />   (entmod (subst '(70 . 1) '(70 . 0) ent))<br />   (princ)<br /> )

KO你

bdboy 发表于 2020-4-21 06:25
如果封闭线的某一段直线段有多个端点，怎么在封闭的同时把中部多余的端点清理掉？（就是类似用overkill命 ...

在论坛上就能找到
快捷键  qdd  多段线顶点优化
(defun c:qdd(/ om ss l_length i j n mm z data new_list last_list m_list en en_data old_pt_num f_list b_list pt1 pt2 pt_1 pt_2 pt_3
              pt_num ang1 ang2 ang_d new_en_data new_pt_num)
  (SETVAR "CMDECHO" 0)
  (setq om (getvar "osmode"))                            ;取得对象捕捉的位码
  (setvar "osmode" 0)                                    ;关掉对象捕捉
  (setq ss (ssget  '((0 . "LWPOLYLINE"))));选择多个对象
  (setq l_length 0)
  (repeat (sslength ss)
    (setq i 0
          j 0
          n 0
          z 0
          mm 0
          data (list '(0 0))
          new_list (list '(0 0))
          last_list (list '(0 0))
          m_list (list '(0 0))
    )
    (setq en (ssname ss l_length));获取第“l_length”个对象的对象名
    (setq en_data (entget en));获取对象列表
    (setq old_pt_num (assoc 90 en_data))
  (if (> (cdr old_pt_num) 2)
   (progn
   
    (setq b_list (list(car (reverse en_data))));获取对象数据中最后一个列表数据（群码 210）
   
    ;;;获取新的列表格式为每个节点坐标及40、41、42群码为一个列表，与其他节点的列表合为一个列表
    (while (/= (nth j en_data) nil)
      (if (=(car(nth j en_data)) 10)
        (progn
         (setq data (append (list(list (nth j en_data) (nth (+ j 1) en_data) (nth (+ j 2) en_data) (nth (+ j 3) en_data))) data))
         (setq z (+ z 1))
         (if (= z 1)
           (setq f_list (carnth j en_data));获取对象数据中第一个节点坐标前的列表数据
         );end if
        );end progn
      );end if
      (setq j (+ j 1))
     );end while
    (setq data (cdr(reverse data)))
   
   ;;;判断两点是否相同，是则将相同点的列表删除
    (while (/= (nth i data) nil)
      (setq pt1  (cdr (car (nth i data))))
      (if (/= (nth (+ i 1) data) nil)
         (setq pt2  (cdr (car (nth (+ i 1) data))))
         (setq pt2  (cdr (car (nth 0 data))))      
       );end if
      (if (or (>= (distance pt1 pt2) 0.0001) (/= (cdr (car (reverse (nth i data )))) 0 ))
        (setq new_list (append (list (nth i data )) new_list))
       );end if
      (setq i (+ i 1))
    );end while
    (setq new_list (cdr(reverse new_list)))
   
    ;;;删除同一条线上的点
    (while (/= (nth n new_list) nil)
      (setq pt_1 (cdr (car (nth n new_list))))
      (if (/= (nth (+ n 1) new_list) nil)
        (setq pt_2 (cdr (car (nth (+ n 1) new_list))))
        (setq pt_2 (cdr (car (nth 0 new_list))))
      );end if
      (if (/= (nth (+ n 2) new_list) nil)
        (setq pt_3 (cdr (car (nth (+ n 2) new_list))))
        (if (/= (nth (+ n 1) new_list) nil)
          (setq pt_3 (cdr (car (nth 0 new_list))))
          (setq pt_3 (cdr (car (nth 1 new_list))))
        );end if
      );end if
      (setq ang1 (angle pt_2 pt_1))
      (setq ang2 (angle pt_2 pt_3))
      (setq ang_d (- ang2 ang1))
      (if (and (>= (abs ang_d) 0.001) (>= (abs (- (abs ang_d) pi)) 0.001))
        (if (/= (nth (+ n 1) new_list) nil)
         (setq last_list (append (list (nth (+ n 1) new_list)) last_list))
         (setq last_list (append (list (nth 0 new_list)) last_list))
        );end if  
      );end if
      (setq n (+ n 1))
    );end while
    (setq last_list (cdr(reverse last_list)))
    (setq last_list (append (list(car (reverse last_list))) (reverse (cdr (reverse last_list)))));获得最终节点列表
    (setq pt_num (length last_list));获取最后节点坐标的个数
   
    ;;;将各节点与40、41、42合成的列表分开并与其他节点列表合为统一个列表，格式为对象数据的列表格式
    (while (/= (nth mm last_list) nil)
      (setq nn 0)
      (while (/= (nth nn (nth mm last_list)) nil)
        (setq m_list (append (list(nth nn (nth mm last_list))) m_list))
        (setq nn (+ nn 1))
      );end while
        (setq mm (+ mm 1))
     );end while
    (setq m_list (cdr(reverse m_list)))
   
    ;;;对象更新
    (setq new_en_data (append f_list m_list b_list))
    (setq new_pt_num (cons 90 pt_num))
    (setq new_en_data (subst new_pt_num old_pt_num new_en_data))
    (entmod new_en_data)
    (setq l_length (+ l_length 1))
   );end progn
  );end if  
);end repeat
   (setvar "osmode" om)
   (alert "多余节点删除完毕！")
)

(defun carnth (m l)                        
; 表取头,保留表L前面I-1个元素，函数返回新表  
(if (= m (length l))
  l   
(progn
      (setq l (reverse l)
            m (- (length l) m 1)
            l (cdrnth m l)
      )
     (reverse l)
    )
  )
)
(defun cdrnth (m l)
; 表取尾,去除表L后面I个元素，函数返回新表
        (repeat (1+ m) (setq l (cdr l)))
)

llsheng_73

1. (defun closepline(e / en c70 e2);;去除多段线首尾重合点并闭合
   
2.   (setq en(entget e)c70(cdr(assoc 70 en))e2(reverse en))
   
3.   (if(equal(vlax-curve-getstartpoint e)
   
4.            (vlax-curve-getpointatparam e(1-(cdr(assoc 90 en))))1e-8)
   
5.     (progn
   
6.       (vl-every'(lambda(x)(if(/=(car x)10)(setq e2(cdr e2))))e2)
   
7.       (entmod(subst(cons 70(logior c70 1))(cons 70 c70)
   
8.                    (append(reverse(cdr e2))(List(assoc 210 en))))
   
9.                    ))))

(defun closepline(e / en c70 e2);;去除多段线首尾重合点并闭合<br />   (setq en(entget e)c70(cdr(assoc 70 en))e2(reverse en))<br />   (if(equal(vlax-curve-getstartpoint e)<br />            (vlax-curve-getpointatparam e(1-(cdr(assoc 90 en))))1e-8)<br />     (progn<br />       (vl-every'(lambda(x)(if(/=(car x)10)(setq e2(cdr e2))))e2)<br />       (entmod(subst(cons 70(logior c70 1))(cons 70 c70)<br />                    (append(reverse(cdr e2))(List(assoc 210 en))))<br />                    ))))

bdboy

KO你 发表于 2020-4-19 07:15
(defun c:erc () (command "Pedit" "M" (ssget) "" "J" "" "c" ""))

如果封闭线的某一段直线段有多个端点，怎么在封闭的同时把中部多余的端点清理掉？（就是类似用overkill命令）

xvjiex

感谢分享，通过修改组码闭合速度快，效率高。

nzl1116

vla-put-closed

gaics

nzl1116 发表于 2020-4-15 11:46
vla-put-closed

vla-put-closed和(subst '(70 . 1) '(70 . 0) ent)或者pedit命令一样，可以闭合但是不能清除多余的顶点。

KO你

(defun c:erc () (command "Pedit" "M" (ssget) "" "J" "" "c" ""))

bdboy

KO你 发表于 2020-4-22 16:00
在论坛上就能找到
快捷键  qdd  多段线顶点优化
(defun c:qdd(/ om ss l_length i j n mm z data new_l ...

不能运行。。。。

weijiewen

bdboy 发表于 2020-4-22 23:35
不能运行。。。。

没复制对吧，可以运行