77077 发表于 2015-7-13 01:28:51

断面线添加顶点--多段线添加顶点

多段线添加顶点(defun C:tt (/ en dxfold dxf10 dxf90 pt ptlst dxfnew)
(princ "\n 断面线添加顶点")
(if (and (setq en (car (entsel "\n 选择设计断面线:")))
         (setq dxfold (entget EN))
         (= (cdr(assoc 0 dxfold)) "LWPOLYLINE")
       )
(progn
    (setq dxf10 (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxfold)
          dxf90 (1+ (cdr(assoc 90 dxfold)))
          dxfold (vl-remove-if '(lambda (x) (or (= (car x) 10) (= (car x) 40) (= (car x) 41) (= (car x) 42)))dxfold)
          dxfold (subst (cons 90 dxf90) (assoc 90 dxfold) dxfold)
         )
    (while (= (car (setq grpt (grread nil 5 0))) 5)
       (setq pt (cons 10 (cadr grpt))
             ptlst (cons pt dxf10)
             ptlst (vl-sort ptlst '(lambda(a b)(< (cadr a) (cadr b))))
             dxfnew (append dxfold ptlst)
             )
       (entmod dxfnew)
   );while
    );progn
    (alert "错误，所选不符合要求")
);if
)演示：

spp_wall 发表于 2015-7-13 08:20:48

不错！！！！！！！！！！！！！！

LIULISHENG 发表于 2018-1-2 11:53:13

效果不错哦

技术工作室 发表于 2022-9-8 15:00:05

效果不错，顶一个

wanhongron 发表于 2023-6-3 17:44:43

能增加捕捉模式吗

66453250 发表于 2023-6-12 19:47:07

效果不错，顶一个

cchessbd 发表于 2023-6-12 20:26:03

哦，太棒了，楼主真的是高手！！！解决了我的问题了，6666666
页: [1]
查看完整版本: 断面线添加顶点--多段线添加顶点