拉伸实体的高度参数在VB中可以查询和修改吗？

杨坚。

想用VB做一个小软件统计各种管的长度，管的截面有各种各样的，都是通过面域拉伸生成的。编程过程中发现好像“3Dsolid”实体只能查询到“SolidType”属性，ActiveX好像没有提供“拉伸长度”对应的属性，所以就卡在这个环节。
请教各位大神在VB中是否有办法查询（更改）这种拉伸形成的实体的拉伸长度？

如果VB中无法实现能不能做一个ARX或者DLL，然后在VB中引用？
附送上CAD中图形的截图。。

杨坚。

忘记说了，目前在用CAD 2019版本

mikewolf2k

ACAD没做过，MS中做过类似的操作，从mesh三角网构成的模型逆向回原来的模型，只有所有的点坐标，根本就没有什么高度截面等信息。在MS中我是先把这个型材树起来，然后用最小包围圈获得高度。不知道你能不能在ACAD中同样实现。效果供参考：
链接: https://pan.baidu.com/s/17qkCdO_NVyoq1SmLH8iBRg 提取码: cz4d

杨坚。

mikewolf2k 发表于 2020-12-21 14:05
ACAD没做过，MS中做过类似的操作，从mesh三角网构成的模型逆向回原来的模型，只有所有的点坐标，根本就没有 ...

也是一个方法，但不是很直接，而且不能编辑

672277923

我想做一个通过一条线扫掠的一条管道，为什么用RetVal = object.AddExtrudedSolidAlongPath(Profile, Path)

这个方法创建不成功呢？我看了示例，示例也是创建不成功，不知道大哥知道是什么原因吗？
提示如下：





自带的参考文件里面的示例如下：

2. Sub Example_AddExtrudedSolidAlongPath()
   
3.     ' 该示例将面域沿样条曲线所定义的路径拉伸成实体。
   
4.     ' 面域是由圆弧和直线创建的。
   
5.    
   
6.     Dim curves(0 To 1) As AcadEntity
   
7. 
   
8.     ' 定义圆弧
   
9.     Dim centerPoint(0 To 2) As Double
   
10.     Dim radius As Double
    
11.     Dim startAngle As Double
    
12.     Dim endAngle As Double
    
13.     centerPoint(0) = 5#: centerPoint(1) = 3#: centerPoint(2) = 0#
    
14.     radius = 2#
    
15.     startAngle = 0
    
16.     endAngle = 3.141592
    
17.     Set curves(0) = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)
    
18.    
    
19.     ' 定义线
    
20.     Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).startPoint, curves(0).endPoint)
    
21.         
    
22.     ' 创建面域
    
23.     Dim regionObj As Variant
    
24.     regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
    
25.    
    
26.     ' 定义拉伸路径(样条曲线对象)
    
27.     Dim splineObj As AcadSpline
    
28.     Dim startTan(0 To 2) As Double
    
29.     Dim endTan(0 To 2) As Double
    
30.     Dim fitPoints(0 To 8) As Double
    
31.    
    
32.     ' 定义样条曲线对象
    
33.     startTan(0) = 10: startTan(1) = 10: startTan(2) = 10
    
34.     endTan(0) = 10: endTan(1) = 10: endTan(2) = 10
    
35.     fitPoints(0) = 0: fitPoints(1) = 10: fitPoints(2) = 10
    
36.     fitPoints(0) = 10: fitPoints(1) = 10: fitPoints(2) = 10
    
37.     fitPoints(0) = 15: fitPoints(1) = 10: fitPoints(2) = 10
    
38.     Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
    
39.    
    
40.     ' 创建实体
    
41.     Dim solidObj As Acad3DSolid
    
42.     Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(regionObj(0), splineObj)
    
43.     ZoomAll
    
44.    
    
45. 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 发表于 2020-12-25 19:59
我想做一个通过一条线扫掠的一条管道，为什么用RetVal = object.AddExtrudedSolidAlongPath(Profile, Path) ...

面域和空间曲线都创建成功了，手动操作扫掠命令是发现还是不能创建实体。后来网上查了一下，可能的原因是扫掠面域的半径大于扫掠路径的最小半径导致实体创建不成功。
应该改变一下扫掠路径或者面域的参数是可以的。