社区 › VB › 三维效果如何实现?

zhuxuhong 发表于 2005-6-2 12:42:00

三维效果如何实现?

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

zhuxuhong 发表于 2005-6-2 22:47:00

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

zhuxuhong 发表于 2005-6-3 06:28:00

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

yulijin608 发表于 2005-6-3 09:40:00

楼主公司是做地下管线探测的?在哪?
可以用AddRegion先构成一个矩形的面,然后用AddRevolvedSolid旋转所构成的面,就可以得到一个三维管线了

zhuxuhong 发表于 2005-6-3 11:14:00

是啊,我们是搞测绘的,我们现在开始做管线方面的工作.yulijin608你也搞这方面的吧?
有机会多向你学习.我先试试

zhuxuhong 发表于 2005-6-3 12:55:00

为什么我这么旋转不好用呢?
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 发表于 2005-6-3 13:41:00

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

zhuxuhong 发表于 2005-6-3 19:41:00

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

查看完整版本: 三维效果如何实现?