多段线增加顶点lsp

wzg

1. ;;;多段线或直线增加顶点，直线转为多线段
   
2. ;wzg 修改于20150417
   
3. (defun c:pljd ( / en en2 oldce HH:LwAddVertex)
   
4. ;;164.34 [功能] 多段线增加顶点 By 自贡黄明儒
   
5. ;;示例(HH:LwAddVertex (car(setq en(entsel))) (cadr en))
   
6. (defun HH:LwAddVertex (en pt / GR N PP LwAddVertex)
   
7.   ;;增加一个顶点
   
8.   (defun LwAddVertex (obj index pt bugle sw ew)
   
9.     (vlax-invoke obj 'addvertex index pt)
   
10.     (vla-setbulge obj index bugle)
    
11.     (vla-setwidth obj index sw ew)
    
12.   )
    
13.   (setq pp (vlax-curve-getClosestPointTo en (trans pt 1 0)))
    
14.   (setq n (fix (vlax-curve-getParamAtPoint en pp)))
    
15.   (setq obj (vlax-ename->vla-object en))
    
16.   (vla-GetWidth obj n 'sw 'ew)
    
17.   (setq pp (getpoint "\n 指定新增点 "))
    
18.   (setq pp (mapcar '+ '(0 0) pp))
    
19.   (vl-catch-all-apply 'LwAddVertex (list obj (1+ n) pp 0 sw sw))
    
20. )
    
21. ;;---------------------------
    
22. (initget "  ")
    
23. (setq en (entsel "\n选择直线或多线段要加点的子段..."))
    
24. (cond
    
25.         ((= en "")nil)
    
26.         ((and en
    
27.                 (wcmatch(cdr(assoc 0(entget(car en))))"LWPOLYLINE")
    
28.                 )
    
29.                 (HH:LwAddVertex (car en) (cadr en))
    
30.                  (c:pljd)
    
31.         )
    
32.         ((and en
    
33.                 (wcmatch(cdr(assoc 0 (entget (car en))))"LINE")
    
34.             )
    
35.                 (setq oldce (getvar "PEDITACCEPT"))
    
36.                 (setvar "PEDITACCEPT" 1)
    
37.                 (command "pedit" en "W" "0" "")
    
38.                 (setvar "PEDITACCEPT" oldce)
    
39.                 (setvar "cmdecho" 1)
    
40.                 (setq en2 (entlast))
    
41.                 (HH:LwAddVertex en2 (cadr en))
    
42.                 (c:pljd)
    
43.         )
    
44.         (t (c:pljd))       
    
45. )
    
46. (princ)
    
47. )
    
48. 
    

复制代码

游四方天地

请问能按照距离批量加点吗？不用手动的。

dx002386

多段线增加顶点lsp  感谢分享  好用

崔四成

不错啊，赞一个

hdgc111

多谢楼主分享

zjy6999

多谢分享！

suihan001

过来学习学习，查漏补缺一下