给多段线增加节点的lisp代码，希望高手指点，修改为起始点不变，增加节点。
工作中需要用到这个，由于此代码在点击多段线起点、终点附近的中点时，会出现起点变为该中点的情况。而我希望起、终点不变。把中点变为增加的点。但是本菜鸟不知道在哪里修改代码，烦请高手帮忙改一下。
最好能贴出源码，以便在下学习。
;;以下为论坛高手原代码
(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)
)
这个代码nb的地方，就是可以选取多段线外的点为节点。比Lee MAC的自由一点。缺点是不能处理有圆弧的多段线。 增点有了，减点也有了，简直太好了。 ;;;--------------------------------------------------------
;;;函数： c:ad
;;;--------------------------------------------------------
;;;来源： 作者: caoyin
;;;编制时间：2012.3
;;;功能: 添加多段线的顶点
;;;语法:
;;;参数
;;;返回值:
;;;备注:线上加点
;;;--------------------------------------------------------
(defun C:AD (/ EN OBJ PT PP);by caoyin
(if (and (setq EN (entsel "\n选择多段线: "))
(setq EN (car EN))
(sssetfirst nil (ssadd EN))
(setq OBJ (vlax-ename->vla-object EN))
(or (= (vla-get-objectname OBJ) "AcDbPolyline")
(and (princ "\n所选的对象不是多段线。") nil)
)
)
(while (and (setq PT (getpoint "\n指定新顶点: "))
(setq PT (trans PT 1 0))
(setq PP (vlax-curve-getclosestpointto OBJ PT))
)
(vlax-invoke
OBJ
'ADDVERTEX
(1+ (fix (vlax-curve-getparamatpoint OBJ PP)))
(list (car PT) (cadr PT))
)
)
)
(princ)
) 刚试了一下，离起点，终点很近的时候，还是存在新增点变为起点和终点的问题。只是代码比你贴的精练。
另外，试验时总结的规律是，当新增点到最后一段直线段的距离小于该点到起、终点距离时（不含延长线），增加的点就在线的中间。 这功能我一般用不上 因为我用南方cass
页:
[1]