社区 › AutoLISP/Visual LISP 编程技术 › 首尾连接但不闭合的多段线如何使之闭合

gaics 发表于 2020-4-14 17:33:03

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

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

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

KO你 发表于 2020-4-22 16:00:28

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 发表于 2023-3-31 11:49:30

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

bdboy 发表于 2020-4-21 06:25:45

本帖最后由 bdboy 于 2020-4-21 06:37 编辑

KO你 发表于 2020-4-19 07:15
(defun c:erc () (command "Pedit" "M" (ssget) "" "J" "" "c" ""))
如果封闭线的某一段直线段有多个端点，怎么在封闭的同时把中部多余的端点清理掉？（就是类似用overkill命令）

xvjiex 发表于 2020-4-15 11:27:34

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

nzl1116 发表于 2020-4-15 11:46:26

vla-put-closed

gaics 发表于 2020-4-15 13:12:41

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


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

KO你 发表于 2020-4-19 07:15:25

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

bdboy 发表于 2020-4-22 23:35:45

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

不能运行。。。。

weijiewen 发表于 2023-3-27 10:49:24

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

没复制对吧，可以运行

查看完整版本: 首尾连接但不闭合的多段线如何使之闭合