求指导，用AddExtrudedSolidAlongPath创建实体失败

672277923

我想画一条管道，看是否与其他管道冲突，想用AddExtrudedSolidAlongPath这个方法扫掠路径生成实体，结果看了帮助文件，老是提示创建失败。
我仔细阅读了帮助文件的示例，复制粘贴到CAD VBA编辑器中，运行还是提示创建失败。

提示如下：



示例如下：

1. Sub Example_AddExtrudedSolidAlongPath()
   
2.     ' 该示例将面域沿样条曲线所定义的路径拉伸成实体。
   
3.     ' 面域是由圆弧和直线创建的。
   
4.    
   
5.     Dim curves(0 To 1) As AcadEntity
   
6. 
   
7.     ' 定义圆弧
   
8.     Dim centerPoint(0 To 2) As Double
   
9.     Dim radius As Double
   
10.     Dim startAngle As Double
    
11.     Dim endAngle As Double
    
12.     centerPoint(0) = 5#: centerPoint(1) = 3#: centerPoint(2) = 0#
    
13.     radius = 2#
    
14.     startAngle = 0
    
15.     endAngle = 3.141592
    
16.     Set curves(0) = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)
    
17.    
    
18.     ' 定义线
    
19.     Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).startPoint, curves(0).endPoint)
    
20.         
    
21.     ' 创建面域
    
22.     Dim regionObj As Variant
    
23.     regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
    
24.    
    
25.     ' 定义拉伸路径(样条曲线对象)
    
26.     Dim splineObj As AcadSpline
    
27.     Dim startTan(0 To 2) As Double
    
28.     Dim endTan(0 To 2) As Double
    
29.     Dim fitPoints(0 To 8) As Double
    
30.    
    
31.     ' 定义样条曲线对象
    
32.     startTan(0) = 10: startTan(1) = 10: startTan(2) = 10
    
33.     endTan(0) = 10: endTan(1) = 10: endTan(2) = 10
    
34.     fitPoints(0) = 0: fitPoints(1) = 10: fitPoints(2) = 10
    
35.     fitPoints(0) = 10: fitPoints(1) = 10: fitPoints(2) = 10
    
36.     fitPoints(0) = 15: fitPoints(1) = 10: fitPoints(2) = 10
    
37.     Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
    
38.    
    
39.     ' 创建实体
    
40.     Dim solidObj As Acad3DSolid
    
41.     Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(regionObj(0), splineObj)
    
42.     ZoomAll
    
43.    
    
44. End Sub
    

Sub Example_AddExtrudedSolidAlongPath()<br />     ' 该示例将面域沿样条曲线所定义的路径拉伸成实体。<br />     ' 面域是由圆弧和直线创建的。<br />     <br />     Dim curves(0 To 1) As AcadEntity<br /> <br />     ' 定义圆弧<br />     Dim centerPoint(0 To 2) As Double<br />     Dim radius As Double<br />     Dim startAngle As Double<br />     Dim endAngle As Double<br />     centerPoint(0) = 5#: centerPoint(1) = 3#: centerPoint(2) = 0#<br />     radius = 2#<br />     startAngle = 0<br />     endAngle = 3.141592<br />     Set curves(0) = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)<br />     <br />     ' 定义线<br />     Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).startPoint, curves(0).endPoint)<br />         <br />     ' 创建面域<br />     Dim regionObj As Variant<br />     regionObj = ThisDrawing.ModelSpace.AddRegion(curves)<br />     <br />     ' 定义拉伸路径(样条曲线对象)<br />     Dim splineObj As AcadSpline<br />     Dim startTan(0 To 2) As Double<br />     Dim endTan(0 To 2) As Double<br />     Dim fitPoints(0 To 8) As Double<br />     <br />     ' 定义样条曲线对象<br />     startTan(0) = 10: startTan(1) = 10: startTan(2) = 10<br />     endTan(0) = 10: endTan(1) = 10: endTan(2) = 10<br />     fitPoints(0) = 0: fitPoints(1) = 10: fitPoints(2) = 10<br />     fitPoints(0) = 10: fitPoints(1) = 10: fitPoints(2) = 10<br />     fitPoints(0) = 15: fitPoints(1) = 10: fitPoints(2) = 10<br />     Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)<br />     <br />     ' 创建实体<br />     Dim solidObj As Acad3DSolid<br />     Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(regionObj(0), splineObj)<br />     ZoomAll<br />     <br /> End Sub<br />

672277923

我好像明白了，路径不能与轮廓在同一平面。。。

zzyong00

这是自己解决问题了

672277923

zzyong00 发表于 2021-1-7 16:34
这是自己解决问题了

用VBA确实功能并不像其他种类的那么强大，写得还是很吃力的

mikewolf2k

672277923 发表于 2021-6-17 08:31
用VBA确实功能并不像其他种类的那么强大，写得还是很吃力的

哪个程序支持路径和轮廓在同一平面？