多段线点清理
本帖最后由 木香 于 2021-9-24 16:29 编辑[*];;应该有很多小伙伴对多段线上杂乱的点有强迫症,抛个砖,发个清理多线共线及重复点的段子,代码内容还有待优化
[*](defun c:plcl (/ a data delst lay llst llst2 m n name newdata p43 p70 ss)
[*](if (and (setq ss (ssget (list (cons 0 "LWPOLYLINE")))) (setq m 0))
[*] (repeat (sslength ss)
[*] (setq name (ssname ss m))
[*] (setq data (entget name))
[*] (setq p70 (cdr (assoc 70 data)));闭合性
[*] (setq lay (cdr (assoc 8 data)));图层
[*] (setq p43 (cdr (assoc 43 data)));线宽
[*] (setq llst (coordinates3d-list name));端点表
[*] (setq llst2 (list (car llst)));构造仅含有效点的新点表
[*] (setq n 1);从第二点开始比较
[*] (setq delst '())
[*] (while (<= n (- (length llst) 2))
[*] (if (or
[*] (> (length (cadr (list-frequnt2 (nth n llst) llst 0.1))) 1);在容差0.1以内的存在重复点
[*] (< (setq a (lines-ang (nth n llst) (nth (1- n) llst) (nth n llst) (nth (1+ n) llst))) 0.1);连续的点存在共线点
[*] )
[*] (setq delst (cons (nth n llst) delst))
[*] (setq llst2 (cons (nth n llst) llst2));构造仅含有效点的新点表
[*] )
[*] (setq n (1+ n))
[*] )
[*] (if (or
[*] (> (length (cadr (list-frequnt2 (last llst) llst 0.1))) 1)
[*] (< (setq a (lines-ang (last llst) (car llst) (car llst) (cadr llst))) 0.1)
[*] )
[*] (setq delst (cons (last llst) delst))
[*] (setq llst2 (cons (last llst) llst2))
[*] );第一点单独处理，与末位点及第二点判断重复、共线关系
[*] (reverse llst2)
[*] (if (not (= (length llst) (length llst2)))
[*] (progn
[*] (setq newdata
[*] (entget
[*] (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (1- (length llst2))) (cons 70 p70) (cons 8 lay) (cons 62 1))
[*] (mapcar '(lambda (x)(cons 10 x)) llst2))
[*] )
[*] )
[*] );创建新多段线
[*] (entupd (cdr (assoc -1 (entmod (subst (cons 43 p43) (assoc 43 newdata) newdata)))))
[*] (entdel name);删除旧多段线
[*] )
[*] ;(princ "\n没有需要处理的多段线")
[*] )
[*] (setq m (1+ m))
[*] )
[*])
[*](princ)
[*])
[*];两直线夹角（锐角值）
[*](defun lines-ang (p1 p2 p3 p4 / ang1)
[*](setq ang1 (abs (- (angle p1 P2) (angle p3 P4))));
[*](cond
[*] ((and (> ang1 (* pi 0.5)) (<= ang1 pi)) (setq ang1 (- pi ang1)))
[*] ((and (> ang1 pi) (<= ang1 (* pi 1.5))) (setq ang1 (- ang1 pi)))
[*] ((and (> ang1 (* pi 1.5)) (<= ang1 (* pi 2))) (setq ang1 (- (* pi 2) ang1)))
[*])
[*]ang1
[*])
[*]
[*];(list-frequnt2 '(1.01 50) (list '(1.01 50) '(1.01 50.01) '(2 100) '(2.01 100.01) '(1.1 50)) 0.01)
[*];;返回表内重复元素及在表内的次序(带容差值)
[*](defun list-frequnt2 (lstmember lst fuzz / el n orlst)
[*](setq orlst '())
[*](setq n 0)
[*](repeat (length lst)
[*] (setq el (nth n lst))
[*] (if (equal lstmember el fuzz)
[*] (setq orlst (cons n orlst))
[*] )
[*] (setq n (1+ n))
[*])
[*](if orlst
[*] (setq orlst (reverse orlst))
[*])
[*](list lstmember orlst)
[*])
[*]
[*];;抄来的函数
[*];;调试：(setq lsta (coordinates3d-list (car (entsel "\n请选择曲线"))))
[*];;简介:取得曲线顶点，适用于：样条曲线-"SPLINE"；三维多段线"-POLYLINE"；多义线-"LWPOLYLINE"；椭圆弧-"ELLIPSE"；圆弧-"ARC"；直线-"line"
[*];;二级子函数： ch-lst
[*];;调用格式：(ch-lst ei lsti)
[*](defun coordinates3d-list (e / obj pname lst)
[*](defun ch-lst (ei lsti / ind nn lstn lsti1)
[*] (setq ind 0
[*] nn (if (= (cdr (assoc 0 (entget ei))) "LWPOLYLINE") 2 3)
[*] lstn '()
[*] )
[*] (repeat (/ (length lsti) nn)
[*] (if (= (cdr (assoc 0 (entget ei))) "LWPOLYLINE")
[*] (setq lsti1 (list (nth ind lsti) (nth (1+ ind) lsti) (cdr (assoc 38 (entget ei)))))
[*] (setq lsti1 (list (nth ind lsti) (nth (1+ ind) lsti) (nth (+ 2 ind) lsti)))
[*] )
[*] (setq lstn (cons lsti1 lstn)
[*] ind (+ ind nn)
[*] )
[*] )
[*] (setq lstn (reverse lstn))
[*]);二级子函数
[*](vl-load-com)
[*](setq obj (vlax-ename->vla-object e)
[*] pname (cdr (assoc 0 (entget e)))
[*])
[*](cond
[*] ((= pname "SPLINE")
[*] (setq lst (ch-lst e (vlax-safearray->list (vlax-variant-value (vla-get-ControlPoints obj)))))
[*] )
[*] ((or (= pname "LWPOLYLINE") (= pname "POLYLINE"))
[*] (setq lst (ch-lst e(vlax-safearray->list (vlax-variant-value (vla-get-Coordinates obj)))))
[*] )
[*] (T
[*] (setq lst (list (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint obj)))
[*] (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint obj))))
[*] )
[*] )
[*])
[*]lst
[*])
论坛里好像有过类似的功能，不知道哪个更好用。 支持！！！！！！！！！！！！！！！！！ 烟盒迷唇 发表于 2021-9-25 10:52
论坛里好像有过类似的功能，不知道哪个更好用。
CAB写过一个 代码在浩辰上使用有问题，选择多段线后，多段线会消失。
页:
[1]