|
是通过拉伸路径来画管道的,输入两个点时能画出管道,当输入三个及三个以上的点是就有问题了,对于三个和三个以上的点的思路是这样的:
1.取第一点,第二点,第三点分别赋给point1,point2,point3(在这里遇到一个问题,point1和point3的点是正确的,point2的点就不正确,不知道是为什么),
2.根据这三个点,确立用户坐标系,在用户坐标系中画出多段线,回复到WCS坐标系,
3.在point1处,生成管道的剖面,根据多段线来进行三维旋转,最后进行拉伸
基本思路就是这样,下面是程序,各位高手帮我看看哪要改,是毕业设计的东西,求助大家了
说明:p(i)是自定义类型,用来存放输入的点的XYZ坐标的
For i = 1 To (UBound(p) - 1)
point1(0) = p(i - 1).x: point1(1) = p(i - 1).y: point1(2) = p(i - 1).z
point2(0) = p(i).x: point2(0) = p(i).y: point2(2) = p(i).z
point3(0) = p(i + 1).x: point3(1) = p(i + 1).y: point3(2) = p(i + 1).z
If p(i - 1).z = p(i).z & p(i).z = p(i + 1).z Then
'设定坐标系
'定义UCS参数
UCSorigin(0) = 0:UCSorigin(1) = 0:UCSorigin(2) = p(i).z
UCS1Point(0) = 10:UCS1Point(1) = 0:UCS1Point(2) = p(i).z
UCS1Point(0) = 0:UCS1Point(1) = 10:UCS1Point(2) = p(i).z
'创建UCS
Set myUCS=ThisDrawing.UserCoordinateSystems.Add (UCSorigin, UCS1Point, UCS2Point, "新建UCS")
'设置当前UCS
ThisDrawing.ActiveUCS = myUCS
'画多段线
point5(0) = point1(0): point5(1) = point1(1)
point5(2) = point2(0): point5(3) = point2(1)
point5(4) = point3(0): point5(5) = point3(1)
Set polyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(point5)
'回复WCS
ThisDrawing.SendCommand "UCS" & vbCr & vbCr
ElseIf p(i - 1).y = p(i).y & p(i).y = p(i + 1).y Then
'设定坐标系
'定义UCS参数
UCSorigin(0) = 0:UCSorigin(1) = p(i).y:UCSorigin(2) = 0
UCS1Point(0) = 10:UCS1Point(1) = p(i).y:UCS1Point(2) = 0
UCS2Point(0) = 0:UCS2Point(1) = p(i).y:UCS2Point(2) = 10
'创建UCS
Set myUCS = ThisDrawing.UserCoordinateSystems.Add(UCSorigin, UCS1Point, UCS2Point, "新建UCS")
'设置当前UCS
ThisDrawing.ActiveUCS = myUCS
'画多段线
point5(0) = point1(0): point5(1) = point1(2)
point5(2) = point2(0): point5(3) = point2(2)
point5(4) = point3(0): point5(5) = point3(2)
Set polyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(point5)
'回复WCS
ThisDrawing.SendCommand "UCS" & vbCr & vbCr
ElseIf p(i - 1).x = p(i).x & p(i).x = p(i + 1).x Then
'设定坐标系
'定义UCS参数
UCSorigin(0) = p(i).x:UCSorigin(1) = 0:UCSorigin(2) = 0
UCS1Point(0) = p(i).x:UCS1Point(1) = 10:UCS1Point(2) = 0
UCS1Point(0) = p(i).x:UCS1Point(1) = 0:UCS1Point(2) = 10
'创建UCS
Set myUCS = ThisDrawing.UserCoordinateSystems.Add(UCSorigin, UCS1Point, UCS2Point, "新建UCS")
'设置当前UCS
ThisDrawing.ActiveUCS = myUCS
'画多段线
point5(0) = point1(1): point5(1) = point1(2)
point5(2) = point2(1): point5(3) = point2(2)
point5(4) = point3(1): point5(5) = point3(2)
Set polyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(point5)
'回复WCS
ThisDrawing.SendCommand "UCS" & vbCr & vbCr
End If
'创建面域
Set circle1(0) = ThisDrawing.ModelSpace.AddCircle(point1, radius1)
Set circle2(0) = ThisDrawing.ModelSpace.AddCircle(point1, radius2)
regionObj1 = ThisDrawing.ModelSpace.AddRegion(circle1)
regionObj2 = ThisDrawing.ModelSpace.AddRegion(circle2)
'布尔运算
regionObj1(0).Boolean acSubtraction, regionObj2(0)
'三维旋转
If point1(0) point2(0) & point1(1) = point2(1) & point1(2) = point2(2) Then
point4(0) = point1(0)
point4(1) = point1(1) + 10
point4(2) = point1(2)
Set line1 = ThisDrawing.ModelSpace.AddLine(point1, point4)
regionObj1(0).Rotate3D point1, point4, rotateAngle
line1.Delete
circle1(0).Delete
circle2(0).Delete
ElseIf point1(0) = point2(0) & point1(1) point2(1) & point1(2) = point2(2) Then
point4(0) = point1(0) + 10
point4(1) = point1(1)
point4(2) = point1(2)
Set line1 = ThisDrawing.ModelSpace.AddLine(point1, point3)
regionObj1(0).Rotate3D point1, point4, rotateAngle
line1.Delete
circle1(0).Delete
circle2(0).Delete
End If
'拉伸
Set regionObj1(0) = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(regionObj1(0), polyObj)
Next i
|
|