管道-对准站偏移（C3D）

Sub AddCOGOPointsForPipe()
Dim sCivilAppName As String
sCivilAppName = "AeccXUiLand.AeccApplication.5.0"
Dim oAcadApp As AcadApplication
Set oAcadApp = ThisDrawing.Application
Dim oEnt As AcadEntity
Dim oCivilApp As AeccApplication
Set oCivilApp = oAcadApp.GetInterfaceObject(sCivilAppName)
Dim oDocument As AeccDocument
Set oDocument = oCivilApp.ActiveDocument
Dim oPoints As AeccPoints
Set oPoints = oDocument.Points
Dim oPoint As AeccPoint
Dim oPipe As AeccPipe
Dim vStation As Double
Dim vOffset As Double
Dim vPipeStart(2) As Double
Dim vPipeEnd(2) As Double
Dim vSelectedPoint As Variant
    
ThisDrawing.Utility.GetEntity oEnt, vSelectedPoint, "Select Pipe: "
    
Set oPipe = oEnt
oPipe.StartPoint.GetPoint vPipeStart(0), vPipeStart(1), vPipeStart(2)
oPipe.Endpoint.GetPoint vPipeEnd(0), vPipeEnd(1), vPipeEnd(2)
vPipeStart(2) = vPipeStart(2) - oPipe.InnerHeight
vPipeEnd(2) = vPipeEnd(2) - oPipe.InnerHeight
[color=red]oPipe.Alignment.StationOffset vPipeStart(0), vPipeStart(1), vStation, vOffset
MsgBox "station: " & vStation & " - offset: " & vOffset[/color]
Set oPoint = oPoints.Add(vPipeStart)
Set oPoint = oPoints.Add(vPipeEnd)
Set oPipe = Nothing
Set oPoint = Nothing
Set oAcadApp = Nothing
Set oCivilApp = Nothing
Set oDocument = Nothing
Set oPoints = Nothing
End Sub