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

brbright 发表于 2015-11-17 11:43:03

本帖最后由 brbright 于 2015-12-9 11:40 编辑

增加、删除多段线顶点。

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

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

CAD小帮手 发表于 2018-7-16 11:33:47

作用：清除多余的节点

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

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

kb2481 发表于 2021-8-3 10:41:57

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

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

LIULISHENG 发表于 2019-7-17 08:37:42

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

你好，能发下链接吗

brbright 发表于 2015-11-17 11:43:52

本帖最后由 brbright 于 2015-12-9 11:42 编辑

(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 "(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 发表于 2015-11-18 15:56:18

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

xiaolong1487 发表于 2015-11-20 12:24:22

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

xiaotao 发表于 2015-11-23 01:16:15

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

ynhh 发表于 2015-11-23 09:14:10

感谢大师的分享

zwf100 发表于 2015-12-1 20:58:49

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

brbright 发表于 2015-12-9 11:43:59

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

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

huai-xiao-hai 发表于 2016-9-12 21:33:13

好东西，谢谢

hooboxu 发表于 2016-9-13 15:51:27

挺给力。。。。

页: [1] 2 3

明经CAD社区's Archiver

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