[LISP函数]：多义线添加顶点

ttthhh_hb

[PHP];;;功能：多义线添加顶点
;;;用法：(Add_Vertex <多义线ename>  <点pt> <凸度bulge>)
;;;如果点pt在多义线上，则添加该点作为多义线的一个顶点，并保持该点处的曲率不变；
;;;如果点pt不在多义线上，则添加该点作为多义线的最后一个顶点，并使新加子段的凸度为bulge。
(defun Add_Vertex (ename pt bulge / obj n dm d1 d2 pcen v plist)
  (setq obj (vlax-ename->vla-object ename))
  (if (vlax-curve-getParamAtPoint obj pt)
    (progn
  (setq n (fix (vlax-curve-getParamAtPoint obj pt)))
  (setq dm (vlax-curve-getDistAtPoint obj pt))
  (setq d1 (vlax-curve-getDistAtParam obj n))
  (setq d2 (vlax-curve-getDistAtParam obj (1+ n)))
  (setq v (vlax-curve-getsecondderiv obj n))
  (if (zerop (vla-getbulge obj n))
    (vla-AddVertex obj (1+ n) (ax:2DPoint pt))
    (progn
      (if (> (vla-getbulge obj n) 0)
        (setq pcen (mapcar '+ (vlax-safearray->list (vlax-variant-value (vla-get-Coordinate obj n))) v))
        (setq pcen (mapcar '- (vlax-safearray->list (vlax-variant-value (vla-get-Coordinate obj n))) v))
      )
      (setq ang2m
            (* 0.25
               (- (angle pcen (vlax-safearray->list (vlax-variant-value(vla-get-Coordinate obj (1+ n)))))
                  (angle pcen pt)
               )
            )
            angm1
            (* 0.25
               (- (angle pcen pt)
                  (angle pcen (vlax-safearray->list (vlax-variant-value(vla-get-Coordinate obj n))))
               )
            )
      )
      (vla-AddVertex obj (1+ n) (ax:2DPoint pt))
      (vla-SetBulge obj n (/ (sin angm1) (cos angm1)))
      (vla-SetBulge obj (1+ n) (/ (sin ang2m) (cos ang2m)))
    )
  )
  )
  (progn
    (setq plist        (vlax-safearray->list
                  (vlax-variant-value
                    (vla-get-coordinates obj)
                  )
                )
    )
    (vla-AddVertex obj (/ (length plist) 2) (ax:2DPoint pt))
    (vla-SetBulge obj (1- (/ (length plist) 2)) bulge)
    )
  )
  (vla-update obj)
  (princ)
)

(defun ax:2DPoint (pt)
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbdouble '(0 . 1))
      (list (car pt) (cadr pt))
    )
  )
)
[/PHP]

laoxie_1983

怎么不能用呀？给点提示

ttthhh_hb

这是函数，并非命令，看清楚了。

KLDC

选择增加的点不在多义线上时,可不可以把这个新增的点放在选中的那一段多线段两个顶点之间?

caddog

我也写了一个,看看

2. 
   
3.   [FONT=courier new]
   
4. ;;;--------------------------------------------------------
   
5. ;;;函数： c:adv
   
6. ;;;--------------------------------------------------------
   
7. ;;;来源：           　作者: caddog
   
8. ;;;编制时间：2007.3
   
9. ;;;功能:     添加多段线的顶点
   
10. ;;;语法:     
    
11. ;;;参数      
    
12. ;;;返回值:   
    
13. ;;;备注  :   学习VBA看到ADDVERTEX,试着写了一个看看,没考虑弧
    
14. ;;;--------------------------------------------------------
    
15. (DEFUN C:ad (/        2dp ename n obj        p pp ss1 ss2 t1        var2dp StartWidth
    
16.               endWidth)
    
17.   (SETQ SS1 (ENTSEL "\n请选择一条多段线:"))
    
18.   (SETQ ENAME (CAR SS1))
    
19.   (SETQ OBJ (VLAX-ENAME->VLA-OBJECT ENAME))
    
20.   ;;如果是多段线则处理
    
21.   (IF (WCMATCH (VLA-GET-OBJECTNAME obj) "LWPOLYLINE,AcDbPolyline") ;_ 结束wcmatch
    
22.     (PROGN
    
23.       ;;显示多段线的夹点,便于用户查看       
    
24.       (SETQ ss2 (SSADD ENAME))
    
25.       (SSSETFIRST NIL ss2)
    
26.       ;;提示用户选择插入点
    
27.       (SETQ P (GETPOINT "\n请选择插入点:"))
    
28.       ;;当点P有值时循环
    
29.       (WHILE p
    
30.         ;;确定用户所指定的插入点的位置,是在哪个顶点之后
    
31.         (SETQ PP (VLAX-CURVE-GETCLOSESTPOINTTO OBJ (TRANS P 1 0)))
    
32.         (SETQ N (+ (FIX (VLAX-CURVE-GETPARAMATPOINT OBJ PP)) 1))
    
33.         ;;取插入点外原来的起始宽度和终止宽度
    
34.         ;;试着用PEDIT命令添加顶点,观察加入点后宽度的变化可知
    
35.         ;;新加入顶点的起始/终止宽度均为原来的的终止宽度
    
36.         (VLA-GETWIDTH obj (- n 1) 'StartWidth 'endWidth)
    
37.         ;;创建安全数组,并将点取的坐标赋给它.注意ADDVERTEX方法只接受二维点
    
38.         (SETQ 2DP (VLAX-MAKE-SAFEARRAY VLAX-VBDOUBLE '(0 . 1)))
    
39.         (VLAX-SAFEARRAY-FILL 2DP (LIST (CAR P) (CADR P)))
    
40.         ;;转换安全数组为变体
    
41.         (SETQ VAR2DP (VLAX-MAKE-VARIANT 2DP))
    
42.         ;;调用ACTIVEX方法添加顶点
    
43.         (VLA-ADDVERTEX OBJ N VAR2DP)
    
44.         ;;调整宽度
    
45.         (VLA-SETWIDTH obj n endWidth endWidth)
    
46. 
    
47.         (SETQ P (GETPOINT "\n请选择插入点:"))
    
48.       ) ;_end while
    
49.       (PRINC)
    
50.       (SSSETFIRST NIL) ;_取消夹取的状态
    
51.     ) ;_end progn
    
52.     (PROGN
    
53.       (PRINC "\n您选择的不是多段线!")
    
54.       (PRINC)
    
55.     ) ;_end else progn
    
56.   ) ;_end if
    
57.   (princ)
    
58. ) ;_end defun
    
59.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;--------------------------------------------------------<br /> ;;;函数： c:adv<br /> ;;;--------------------------------------------------------<br /> ;;;来源：           　作者: caddog<br /> ;;;编制时间：2007.3<br /> ;;;功能:     添加多段线的顶点<br /> ;;;语法:     <br /> ;;;参数      <br /> ;;;返回值:   <br /> ;;;备注  :   学习VBA看到ADDVERTEX,试着写了一个看看,没考虑弧<br /> ;;;--------------------------------------------------------<br /> (DEFUN C:ad (/        2dp ename n obj        p pp ss1 ss2 t1        var2dp StartWidth<br />               endWidth)<br />   (SETQ SS1 (ENTSEL "\n请选择一条多段线:"))<br />   (SETQ ENAME (CAR SS1))<br />   (SETQ OBJ (VLAX-ENAME->VLA-OBJECT ENAME))<br />   ;;如果是多段线则处理<br />   (IF (WCMATCH (VLA-GET-OBJECTNAME obj) "LWPOLYLINE,AcDbPolyline") ;_ 结束wcmatch<br />     (PROGN<br />       ;;显示多段线的夹点,便于用户查看        <br />       (SETQ ss2 (SSADD ENAME))<br />       (SSSETFIRST NIL ss2)<br />       ;;提示用户选择插入点<br />       (SETQ P (GETPOINT "\n请选择插入点:"))<br />       ;;当点P有值时循环<br />       (WHILE p<br />         ;;确定用户所指定的插入点的位置,是在哪个顶点之后<br />         (SETQ PP (VLAX-CURVE-GETCLOSESTPOINTTO OBJ (TRANS P 1 0)))<br />         (SETQ N (+ (FIX (VLAX-CURVE-GETPARAMATPOINT OBJ PP)) 1))<br />         ;;取插入点外原来的起始宽度和终止宽度<br />         ;;试着用PEDIT命令添加顶点,观察加入点后宽度的变化可知<br />         ;;新加入顶点的起始/终止宽度均为原来的的终止宽度<br />         (VLA-GETWIDTH obj (- n 1) 'StartWidth 'endWidth)<br />         ;;创建安全数组,并将点取的坐标赋给它.注意ADDVERTEX方法只接受二维点<br />         (SETQ 2DP (VLAX-MAKE-SAFEARRAY VLAX-VBDOUBLE '(0 . 1)))<br />         (VLAX-SAFEARRAY-FILL 2DP (LIST (CAR P) (CADR P)))<br />         ;;转换安全数组为变体<br />         (SETQ VAR2DP (VLAX-MAKE-VARIANT 2DP))<br />         ;;调用ACTIVEX方法添加顶点<br />         (VLA-ADDVERTEX OBJ N VAR2DP)<br />         ;;调整宽度<br />         (VLA-SETWIDTH obj n endWidth endWidth)<br /> <br />         (SETQ P (GETPOINT "\n请选择插入点:"))<br />       ) ;_end while<br />       (PRINC)<br />       (SSSETFIRST NIL) ;_取消夹取的状态<br />     ) ;_end progn<br />     (PROGN<br />       (PRINC "\n您选择的不是多段线!")<br />       (PRINC)<br />     ) ;_end else progn<br />   ) ;_end if<br />   (princ)<br /> ) ;_end defun<br />   [/FONT]<br />

szdn

怎么用呀？给点提示