[求助]：vla-add3dpoly和vla-addlightweightpoly的问题

ahlzl

我刚学LISP，有个问题向各位请教：vla-add3dpoly和vla-addlightweightpoly方法怎么用？我用VBA写了一个画三维螺旋线的程序，现在想用VLISP写，在vla-add3dpoly这卡着了，诚请高手按我的VBA程序的想路帮我写一段VLISP代码（不要用commmand函数，要用vla-add3dpoly方法），先谢谢了。

2. 
   
3. Sub Example_Add3DPoly()
   
4. 
   
5. Dim polyObj As Acad3DPolyline
   
6. Dim points() As Double
   
7. Dim a, n As Integer
   
8. Dim R1, R2, H As Double
   
9. Dim pa As Variant
   
10. Const PI = 3.1415926535
    
11. 
    
12. pa = ThisDrawing.Utility.GetPoint(, "请输入基点：")
    
13. R1 = ThisDrawing.Utility.GetDistance(pa, "请输入起点半径：")
    
14. R2 = ThisDrawing.Utility.GetDistance(pa, "请输入终点半径：")
    
15. H = ThisDrawing.Utility.GetDistance(pa, "请总高度：")
    
16. n = ThisDrawing.Utility.GetReal("请输入匝数:")
    
17. 
    
18. ReDim points(0 To 3 * 360 * n + 2) As Double
    
19. 
    
20. For a = 0 To 3 * 360 * n Step 3
    
21. points(a) = pa(0) + (R1 + (a / 3) * (R2 - R1) / 360 / n) _
    
22. * Cos(2 * PI * (a / 3) / 360)
    
23. points(a + 1) = pa(1) + (R1 + (a / 3) * (R2 - R1) / 360 / n) _
    
24. * Sin(2 * PI * (a / 3) / 360)
    
25. points(a + 2) = pa(2) + H * (a / 3) / 360 / n
    
26. Next
    
27. 
    
28. Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)
    
29. ZoomExtents
    
30. End Sub
    

<br /> Sub Example_Add3DPoly()<br /> <br /> Dim polyObj As Acad3DPolyline<br /> Dim points() As Double<br /> Dim a, n As Integer<br /> Dim R1, R2, H As Double<br /> Dim pa As Variant<br /> Const PI = 3.1415926535<br /> <br /> pa = ThisDrawing.Utility.GetPoint(, "请输入基点：")<br /> R1 = ThisDrawing.Utility.GetDistance(pa, "请输入起点半径：")<br /> R2 = ThisDrawing.Utility.GetDistance(pa, "请输入终点半径：")<br /> H = ThisDrawing.Utility.GetDistance(pa, "请总高度：")<br /> n = ThisDrawing.Utility.GetReal("请输入匝数:")<br /> <br /> ReDim points(0 To 3 * 360 * n + 2) As Double<br /> <br /> For a = 0 To 3 * 360 * n Step 3<br /> points(a) = pa(0) + (R1 + (a / 3) * (R2 - R1) / 360 / n) _<br /> * Cos(2 * PI * (a / 3) / 360)<br /> points(a + 1) = pa(1) + (R1 + (a / 3) * (R2 - R1) / 360 / n) _<br /> * Sin(2 * PI * (a / 3) / 360)<br /> points(a + 2) = pa(2) + H * (a / 3) / 360 / n<br /> Next<br /> <br /> Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)<br /> ZoomExtents<br /> End Sub<br />

lsjjm

Creates a 3D polyline from the given array of coordinates.
VBA : RetVal = object.Add3Dpoly(PointsArray)
VL : RetVal = (vla-Add3Dpoly object PointsArray)
(setq myobj (vla-Add3DPoly mspace tmp))
Example :

2. (defun c:al-Add3DPoly ( / mspace pt ptlist tmp myobj)
   
3.   (vl-load-com)
   
4.   (setq mspace (vla-get-modelspace
   
5.                    (vla-get-activedocument
   
6.                              (vlax-get-acad-object))))
   
7.   (setq pt (getpoint "\nSpecify start point: "))
   
8.   ; Start by assembling a list of points
   
9.   (setq ptlist (cons pt ptlist))
   
10.   (while (setq pt (getpoint "\nSpecify next point: " pt))
    
11.     (setq ptlist (cons pt ptlist))
    
12.   );while
    
13.   ; "dissolve" the points into atoms with append:
    
14.   (setq ptlist (apply 'append ptlist))
    
15.   ; If number of coordinates in point list is not
    
16.   ; a multiple of 3 then a lwpolyline can't be made.
    
17.   ; If it's a multiple of 3 then put the point
    
18.   ; list into an array and pass it on to Add3DPoly:
    
19.   (if (= (rem (length ptlist) 3) 0)
    
20.     (progn
    
21.       (setq
    
22.         tmp (vlax-make-safearray
    
23.                vlax-vbDouble
    
24.                (cons 0 (- (length ptlist) 1))
    
25.             )
    
26.       )
    
27.       (vlax-safearray-fill tmp ptlist)
    
28.       (setq myobj (vla-Add3DPoly mspace tmp))
    
29.     );progn
    
30.     (princ "\nError: 3DPoly could not be created")
    
31.   );if
    
32. (princ)
    
33. );defun

(defun c:al-Add3DPoly ( / mspace pt ptlist tmp myobj)<br />   (vl-load-com)<br />   (setq mspace (vla-get-modelspace<br />                    (vla-get-activedocument<br />                              (vlax-get-acad-object))))<br />   (setq pt (getpoint "\nSpecify start point: "))<br />   ; Start by assembling a list of points<br />   (setq ptlist (cons pt ptlist))<br />   (while (setq pt (getpoint "\nSpecify next point: " pt))<br />     (setq ptlist (cons pt ptlist))<br />   );while<br />   ; "dissolve" the points into atoms with append:<br />   (setq ptlist (apply 'append ptlist))<br />   ; If number of coordinates in point list is not<br />   ; a multiple of 3 then a lwpolyline can't be made.<br />   ; If it's a multiple of 3 then put the point<br />   ; list into an array and pass it on to Add3DPoly:<br />   (if (= (rem (length ptlist) 3) 0)<br />     (progn<br />       (setq<br />         tmp (vlax-make-safearray <br />                vlax-vbDouble<br />                (cons 0 (- (length ptlist) 1))<br />             )<br />       )<br />       (vlax-safearray-fill tmp ptlist)<br />       (setq myobj (vla-Add3DPoly mspace tmp))<br />     );progn<br />     (princ "\nError: 3DPoly could not be created")<br />   );if<br /> (princ)<br /> );defun

ahlzl

谢谢lsjjm 兄！程序我已运行了，虽然还不能全看懂，但思路已知道了，正在慢慢消化。
再一次谢谢lsjjm 兄！

laogao988

晕死了！看不懂哦！可不可以说明一下下在什么文件夹里面

winabcd

我正学这方面的内容，看了2楼的例子，帮助很大，谢谢。

JOSDENNIS

可不可給一個 VLA-ADDSPLINE 方式的看看. 我不懂SPLINE 的怎麼建, 我也看過HELP文件, 可是看不太明. 我看大俠們的就很容易看明, 謝謝,

Free-Lancer

2. 
   
3. (defun c:tt (/ pts pls ept spt spl)
   
4.   (while (setq pt (getpoint "\nPoint<Exit>: "))
   
5.     (setq pts (cons pt pts))
   
6.   )
   
7.   (if (> (length pts) 1)
   
8.     (progn
   
9.       (setq pls        (apply 'append pts)
   
10.             ept        (mapcar '- (car pts) (cadr pts))
    
11.             spt        (mapcar '- (cadr (reverse pts)) (last pts))
    
12.             spl        (vlax-make-variant
    
13.                   (vlax-safearray-fill
    
14.                     (vlax-make-safearray
    
15.                       vlax-vbdouble
    
16.                       (cons 1 (length pls))
    
17.                     )
    
18.                     pls
    
19.                   )
    
20.                 )
    
21.       )
    
22.       (vla-addspline
    
23.         (vla-get-modelspace
    
24.           (vla-get-activedocument (vlax-get-acad-object))
    
25.         )
    
26.         spl
    
27.         (vlax-3d-point spt)
    
28.         (vlax-3d-point ept)
    
29.       )
    
30.     )
    
31.   )
    
32.   (princ)
    
33. )

<br /> (defun c:tt (/ pts pls ept spt spl)<br />   (while (setq pt (getpoint "\nPoint<Exit>: "))<br />     (setq pts (cons pt pts))<br />   )<br />   (if (> (length pts) 1)<br />     (progn<br />       (setq pls        (apply 'append pts)<br />             ept        (mapcar '- (car pts) (cadr pts))<br />             spt        (mapcar '- (cadr (reverse pts)) (last pts))<br />             spl        (vlax-make-variant<br />                   (vlax-safearray-fill<br />                     (vlax-make-safearray<br />                       vlax-vbdouble<br />                       (cons 1 (length pls))<br />                     )<br />                     pls<br />                   )<br />                 )<br />       )<br />       (vla-addspline<br />         (vla-get-modelspace<br />           (vla-get-activedocument (vlax-get-acad-object))<br />         )<br />         spl<br />         (vlax-3d-point spt)<br />         (vlax-3d-point ept)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

434939575

都是老前辈啊。我2014年才开始学习VIA------.学习了，