[修订][va,vd]增加、删除多段线顶点v2

brbright

增加、删除多段线顶点。

感谢网友们的反馈。
对有【弧线段】的多段线，第一版会出错。
原因是原代码没有处理多段线的【凸度表】，增加删除顶点后【凸度表】对应的【顶点】顺序会发生变化。
抽时间改写了原代码。

另外，原来的编辑多段线顶点，用处不大。编写后，我自己就从来没用过，所以就不再改写，也不再发上来了。

CAD小帮手

作用：清除多余的节点

CAD小帮手技术交流群1： 115604002  （视频和原图档请在群文件下载）       

CAD小帮手技术交流群2： 618984401  （视频和原图档请在群文件下载）

kb2481

htxhtx 发表于 2019-7-17 08:27
论坛有个增删顶点，非常经典！、
1.可以实时显示顶点；
2.可以连续操作！

这个有点厉害 能找的到链接吗

LIULISHENG

htxhtx 发表于 2019-7-17 08:27
论坛有个增删顶点，非常经典！、
1.可以实时显示顶点；
2.可以连续操作！

你好，能发下链接吗

brbright

(vl-load-com)
(defun c:va (/                        tx_ent                   t_1
             t_ent                t_entsel           t_getpoint
             t_near_point        t_param_line           t_param_near
             t_polyline_bulges        t_polyline_vertices
             t_polyline_vertices_num                   t_sel_point
             t_vla_vertices
            )
  ;;选择多段线
  (setq t_entsel (entsel))
  ;;取得多段线、选择点、vla
  (setq t_ent (car t_entsel))
  (setq t_sel_point (cadr t_entsel))
  (setq tx_ent (vlax-ename->vla-object t_ent))
  ;;捕捉多段线上到选择点的最近点
  (setq        t_near_point
         (vlax-curve-getclosestpointto
           tx_ent
           (trans t_sel_point 1 0)
         )
  )
  ;;计算最近点在多段线上的标记，四舍五入取整获得选择点的最近顶点标记,从0算起
  (setq
    t_param_near
     (fix (+ (vlax-curve-getparamatpoint tx_ent t_near_point)
             0.5
          )
     )
  )
  ;;计算最近点在多段线上的标记，取整获得线段起点顶点标记,从0算起
  (setq
    t_param_line
     (fix (vlax-curve-getparamatpoint tx_ent t_near_point)
     )
  )
  ;;因为弧线段要加顶点，需要注意的地方较多，建议手工处理
  (if (= (vla-getbulge tx_ent t_param_line) 0.0)
    (princ)
    (progn
      (princ "\n这是弧线段,建议手工处理,程序退出")
      (exit)
    )
  )
  ;;取得多段线顶点表
  (setq        t_polyline_vertices
         (vlax-safearray->list
           (vlax-variant-value
             (vlax-get-property tx_ent 'Coordinates)
           )
         )
  )
  ;;计算多段线顶点的数量
  (setq t_polyline_vertices_num (/ (length t_polyline_vertices) 2))
  ;;记录多段线凸度值表
  (setq t_polyline_bulges (list))
  (setq t_1 0)
  (repeat t_polyline_vertices_num
    (setq t_polyline_bulges
           (cons (vla-getbulge tx_ent t_1)
                 t_polyline_bulges
           )
    )
    (setq t_1 (1+ t_1))
  )
  (setq t_polyline_bulges (reverse t_polyline_bulges))
  ;;选择新点
  ;;选择新点
  ;;选择新点
  (setq t_getpoint (trans (getpoint) 1 0))
  ;;在点表添加点
  (cond
    ;;检测到第一点，起点前加点，表头加点
    ((= t_param_near 0)
     (setq t_polyline_vertices
            (cons (cadr t_getpoint) t_polyline_vertices)
     )
     (setq t_polyline_vertices
            (cons (car t_getpoint) t_polyline_vertices)
     )
    )
    ;;检测到终点，终点后加点，表尾加点
    ((= t_param_near (1- t_polyline_vertices_num))
     (setq t_polyline_vertices
            (append
              t_polyline_vertices
              (list (car t_getpoint) (cadr t_getpoint))
            )
     )
    )
    ;;其他则在多段线线段中间加直线，表中间加点
    (t
     (progn
       (setq t_polyline_vertices
              (br:insertnth
                t_polyline_vertices
                (+ (* 2 t_param_line) 2)
                (cadr t_getpoint)
              )
       )
       (setq t_polyline_vertices
              (br:insertnth
                t_polyline_vertices
                (+ (* 2 t_param_line) 2)
                (car t_getpoint)
              )
       )
     )
    )
  )
  ;;凸度表加零
  (setq        t_polyline_bulges
         (br:insertnth t_polyline_bulges t_param_line 0.0)
  )
  ;;将多段线顶点表转换为vlisp能处理数据表
  (setq        t_vla_vertices
         (vlax-make-safearray
           vlax-vbDouble
           (cons 0 (1- (length t_polyline_vertices)))
         )
  )
  (vlax-safearray-fill t_vla_vertices t_polyline_vertices)
  ;;更新多段线顶点
  (vlax-put-property tx_ent 'Coordinates t_vla_vertices)
  ;;更新多段线凸度
  (setq t_1 0)
  (repeat (length t_polyline_bulges)
    (vla-setbulge
      tx_ent
      t_1
      (nth t_1 t_polyline_bulges)
    )
    (setq t_1 (1+ t_1))
  )
  (princ)
)

;;删除顶点
(defun c:vd (/                        tx_ent                   t_1
             t_ent                t_entsel           t_getpoint
             t_near_point        t_param_line           t_param_near
             t_polyline_bulges        t_polyline_vertices
             t_polyline_vertices_num                   t_sel_point
             t_vla_vertices
            )
  ;;选择多段线
  (setq t_entsel (entsel))
  ;;取得多段线、选择点、vla
  (setq t_ent (car t_entsel))
  (setq t_sel_point (cadr t_entsel))
  (setq tx_ent (vlax-ename->vla-object t_ent))
  ;;捕捉多段线上到选择点的最近点
  (setq        t_near_point
         (vlax-curve-getclosestpointto
           tx_ent
           (trans t_sel_point 1 0)
         )
  )
  ;;计算最近点在多段线上的标记，四舍五入取整获得选择点的最近顶点标记,从0算起
  (setq
    t_param_near
     (fix (+ (vlax-curve-getparamatpoint tx_ent t_near_point)
             0.5
          )
     )
  )
  ;;计算最近点在多段线上的标记，取整获得线段起点顶点标记,从0算起
  (setq
    t_param_line
     (fix (vlax-curve-getparamatpoint tx_ent t_near_point)
     )
  )
  ;;因为弧线段要加顶点，需要注意的地方较多，建议手工处理
  (if (= (vla-getbulge tx_ent t_param_near) 0.0)
    (princ)
    (progn
      (princ "\n这是弧线段,建议手工处理,程序退出")
      (exit)
    )
  )
  (if (< t_param_near 1)
    (princ)
    (progn (if (= (vla-getbulge tx_ent (1- t_param_near)) 0.0)
             (princ)
             (progn
               (princ "\n这是弧线段,建议手工处理,程序退出")
               (exit)
             )
           )
    )
  )
  ;;取得多段线顶点表
  (setq        t_polyline_vertices
         (vlax-safearray->list
           (vlax-variant-value
             (vlax-get-property tx_ent 'Coordinates)
           )
         )
  )
  ;;计算多段线顶点的数量
  (setq t_polyline_vertices_num (/ (length t_polyline_vertices) 2))
  ;;记录多段线凸度值表
  (setq t_polyline_bulges (list))
  (setq t_1 0)
  (repeat t_polyline_vertices_num
    (setq t_polyline_bulges
           (cons (vla-getbulge tx_ent t_1)
                 t_polyline_bulges
           )
    )
    (setq t_1 (1+ t_1))
  )
  (setq t_polyline_bulges (reverse t_polyline_bulges))
  ;;在点表删除点
  (cond
    ;;检测到第一点，起点删除点，表头删除点
    ((= t_param_near 0)
     (setq t_polyline_vertices
            (cdr t_polyline_vertices)
     )
     (setq t_polyline_vertices
            (cdr t_polyline_vertices)
     )
    )
    ;;检测到终点，终点删除点，表尾删除点
    ((= t_param_near (1- t_polyline_vertices_num))
     (setq t_polyline_vertices (reverse t_polyline_vertices))
     (setq t_polyline_vertices
            (cdr t_polyline_vertices)
     )
     (setq t_polyline_vertices
            (cdr t_polyline_vertices)
     )
     (setq t_polyline_vertices (reverse t_polyline_vertices))
    )
    ;;其他则在多段线线段中间删点，表中间删点
    (t
     (progn
       (setq t_polyline_vertices
              (LM:RemoveNth
                (+ (* 2 t_param_near) 0)
                t_polyline_vertices
              )
       )
       (setq t_polyline_vertices
              (LM:RemoveNth
                (+ (* 2 t_param_near) 0)
                t_polyline_vertices
              )
       )
     )
    )
  )
  ;;凸度表删凸度
  (setq        t_polyline_bulges
         (LM:RemoveNth t_param_line t_polyline_bulges)
  )
  ;;将多段线顶点表转换为vlisp能处理数据表
  (setq        t_vla_vertices
         (vlax-make-safearray
           vlax-vbDouble
           (cons 0 (1- (length t_polyline_vertices)))
         )
  )
  (vlax-safearray-fill t_vla_vertices t_polyline_vertices)
  ;;更新多段线顶点
  (vlax-put-property tx_ent 'Coordinates t_vla_vertices)
  ;;更新多段线凸度
  (setq t_1 0)
  (repeat (length t_polyline_bulges)
    (vla-setbulge
      tx_ent
      t_1
      (nth t_1 t_polyline_bulges)
    )
    (setq t_1 (1+ t_1))
  )
  (princ)
)
;;自编函数，在列表中插入元素
;;自编函数，在列表中插入元素
;;自编函数，在列表中插入元素
(defun br:insertnth (t_list        t_n           t_new      /
                     t_1        t_list_1   t_list_2   t_list_new
                     t_list_num
                    )
  (setq t_n (fix t_n))
  (setq t_list_num (length t_list))
  (setq t_list_new (list t_new))
  (cond        ((= t_n 0)
         (setq t_list (append t_list_new t_list))
        )
        ((= t_n t_list_num)
         (setq t_list (append t_list t_list_new))
        )
        ((> t_n t_list_num) (print "[error](br:insertnth) n > length"))
        (t
         (progn
           (setq t_list_1 (list))
           (setq t_list_2 (list))
           (setq t_1 (1- t_n))
           (repeat t_n
             (setq t_list_1 (cons (nth t_1 t_list) t_list_1))
             (setq t_1 (1- t_1))
           )

           (setq t_1 (1- t_list_num))
           (repeat (- t_list_num t_n)
             (setq t_list_2 (cons (nth t_1 t_list) t_list_2))
             (setq t_1 (1- t_1))
           )
           (setq t_list (append t_list_1 t_list_new t_list_2))
         )
        )

  )
  t_list
)

;;----------------------=={ Remove Nth }==--------------------;;
;;                                                            ;;
;;  Removes the item at the nth index in a supplied list      ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ? 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  n - index of item to remove (zero based)                  ;;
;;  l - list from which item is to be removed                 ;;
;;------------------------------------------------------------;;
;;  Returns:  List with item at index n removed               ;;
;;------------------------------------------------------------;;

(defun LM:RemoveNth ( n l / i )
    (setq i -1)
    (vl-remove-if '(lambda ( x ) (= (setq i (1+ i)) n)) l)
)

xyccf

很厉害哦.............!

xiaolong1487

很好，但是如果多段线有弧段就好像不理想了！

xiaotao

不错，我正找这方面的程序，真是想什么就来什么！3Q

ynhh

感谢大师的分享

zwf100

不错，这个很方便，增加节点不用点左右点就可以直接加

brbright

xiaolong1487 发表于 2015-11-20 12:24
很好，但是如果多段线有弧段就好像不理想了！

抽时间稍微改了一下，你看看能不能用。谢谢。

huai-xiao-hai

好东西，谢谢

hooboxu

挺给力。。。。