三维效果如何实现?

zhuxuhong

我想将下图中的管线用VBA以三维形式显示,如在图上画一条线与其相交的管线以三维开式显示,也就是剖面图那种效果,可不知该如下下手?下图中每条管线都有属性信息,(如管径\埋深...),井位有坐标信息

zhuxuhong

简单点说就是图上有多条直线，Z坐标都不为零，我想用三维显示。并且有些显示方的，有些是圆的。请问斑主用VBA该怎么做？

zhuxuhong

如果想创建圆柱体，RetVal = object.AddCylinder(Center, Radius, Height) 它的参数就这三个，那我有多条直线本来是相交的，但变成柱体后不得变成平行了？熟悉3D操作的朋友麻烦你们也指点一下。谢谢

yulijin608

楼主公司是做地下管线探测的?在哪?


可以用AddRegion先构成一个矩形的面,然后用AddRevolvedSolid旋转所构成的面,就可以得到一个三维管线了

zhuxuhong

是啊,我们是搞测绘的,我们现在开始做管线方面的工作.yulijin608你也搞这方面的吧?

有机会多向你学习.我先试试

zhuxuhong

为什么我这么旋转不好用呢?

Sub test()
Dim curves(0 To 3) As AcadEntity

' This example adds a line in model space

Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double

' Define the start and end points for the line
startPoint(0) = 1#: startPoint(1) = 1#: startPoint(2) = 0#
endPoint(0) = 5#: endPoint(1) = 5#: endPoint(2) = 0#

'Á¬½Ó³É·â±ÕÇøÓò
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
Dim offsetobj As Variant
offsetobj = lineObj.Offset(0.25)
Set curves(0) = lineObj
Set curves(1) = offsetobj(0)
Set curves(2) = ThisDrawing.ModelSpace.AddLine(lineObj.startPoint, offsetobj(0).startPoint)
Set curves(3) = ThisDrawing.ModelSpace.AddLine(lineObj.endPoint, offsetobj(0).endPoint)

' Create the region
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
regionObj(0).Color = acCyan
ZoomAll
MsgBox "Revolve the region to create the solid.", , "AddRevolvedSolid Example"

' Define the rotation axis
Dim axisPt(0 To 2) As Double
Dim axisDir(0 To 2) As Double
Dim angle As Double
axisPt(0) = 5: axisPt(1) = 5: axisPt(2) = 0
axisDir(0) = 11: axisDir(1) = 1: axisDir(2) = 3
angle = 0.785

' Create the solid
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid(regionObj(0), axisPt, axisDir, angle)
solidObj.Color = acRed
ZoomAll

' Change the viewing direction of the viewport
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
MsgBox "Solid created.", , "AddRevolvedSolid Example"

End Sub

yulijin608

应当是旋转轴的问题, Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid(regionObj(0), lineObj.startPoint, lineObj.endPoint, 6.28) '6.28表示旋转一周

zhuxuhong

AddRevolvedSolid出错，怪了我就只是把示例改了一点就不行了