不同ucs中的圆柱体

Public Sub ucstest()
    Dim ucsObj As AcadUCS
    Dim origin As Variant
    Dim xAxisPnt(0 To 2) As Double
    Dim yAxisPnt(0 To 2) As Double
    Dim ucsorigion(0 To 2) As Double
    ' Define the UCS
    origin = Null
    origin = ThisDrawing.Utility.GetPoint
    xAxisPnt(0) = origin(0): xAxisPnt(1) = origin(1): xAxisPnt(2) = origin(2) - 1
    yAxisPnt(0) = origin(0): yAxisPnt(1) = origin(1) + 1: yAxisPnt(2) = origin(2)
    ' Add the UCS to the UserCoordinatesSystems collection
    Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
    ThisDrawing.ActiveUCS = ucsObj
    ThisDrawing.ModelSpace.AddCylinder origin, 1, 3
End Sub

Public Sub ucstest()
    Dim origin As Variant
    Dim xAxisPnt As Variant
    Dim yAxisPnt(0 To 2) As Double
    Dim ucsorigion(0 To 2) As Double
    Dim objcyl As Acad3DSolid
    Dim dblLength As Double
    Dim objLine As AcadLine
    Dim varpick As Variant
    Dim obje As AcadEntity
    ThisDrawing.Utility.GetEntity obje, varpick
    Set objLine = obje
    dblLength = objLine.Length
    origin = Null
    origin = ThisDrawing.Utility.GetPoint
    xAxisPnt = ThisDrawing.Utility.GetPoint(origin)
    Set objcyl = ThisDrawing.ModelSpace.AddCylinder(origin, 1, dblLength)
    Dim ang As Double
    ang = 90
    ang = ang * 3.141592 / 180#
    objcyl.Rotate3D origin, xAxisPnt, ang
End Sub

Public Sub CylinderFromLine()
    Dim oCyl As Acad3DSolid
    Dim oCircle As AcadCircle
    Dim oLine As AcadLine
    Dim varpick As Variant
    Dim Ent As AcadEntity
    Dim N, oReg
    Dim RegEnt(0) As AcadEntity
    Dim V(2) As Double
    Dim Unit As Double
    Dim Vn(2) As Double
    Dim P1, P2
    
    ThisDrawing.Utility.GetEntity Ent, varpick
    If Not TypeOf Ent Is AcadLine Then Exit Sub
    Set oLine = Ent
   ' V = oLine.Delta 'Don't use the treacherous delta
    P1 = oLine.StartPoint: P2 = oLine.EndPoint
    V(0) = P2(0) - P1(0): V(1) = P2(1) - P1(1): V(2) = P2(2) - P1(2)
    
    'Normalise the vector(It's length=1)
    Unit = Sqr(V(0) * V(0) + V(1) * V(1) + V(2) * V(2))
    Vn(0) = V(0) / Unit: Vn(1) = V(1) / Unit: Vn(2) = V(2) / Unit
    
    Set oCircle = ThisDrawing.ModelSpace.AddCircle(oLine.StartPoint, 1)
    oCircle.Normal = Vn
    Set RegEnt(0) = oCircle
    oReg = ThisDrawing.ModelSpace.AddRegion(RegEnt)
    Set oCyl = ThisDrawing.ModelSpace.AddExtrudedSolid(oReg(0), oLine.Length, 0)
End Sub
Public Sub CylinderFromPoints()
    'this mimics the Cylinder command
    Dim oCyl As Acad3DSolid
    Dim oCircle As AcadCircle
    Dim Rad As Double
    Dim P1, P2
    Dim N, oReg
    Dim dLength As Double
    Dim RegEnt(0) As AcadEntity
    Dim Util As AcadUtility
    
    Set Util = ThisDrawing.Utility
    P1 = Util.GetPoint(, "Specify center point for base of cylinder:")
    Rad = Util.GetDistance(ToUcs(P1), "Specify radius for base of cylinder:")
    P2 = ThisDrawing.Utility.GetPoint(ToUcs(P1), "Specify center of other end of cylinder:")
    Dim V(2) As Double
    V(0) = P2(0) - P1(0): V(1) = P2(1) - P1(1): V(2) = P2(2) - P1(2)
    Dim Unit As Double
    Dim Vn(2) As Double
    'Normalise the vector(It's length=1)
    Unit = Sqr(V(0) * V(0) + V(1) * V(1) + V(2) * V(2))
    Vn(0) = V(0) / Unit: Vn(1) = V(1) / Unit: Vn(2) = V(2) / Unit
    
    dLength = Sqr(V(0) ^ 2 + V(1) ^ 2 + V(2) ^ 2)
    Set oCircle = ThisDrawing.ModelSpace.AddCircle(P1, Rad)
    oCircle.Normal = Vn
    Set RegEnt(0) = oCircle
    oReg = ThisDrawing.ModelSpace.AddRegion(RegEnt)
    Set oCyl = ThisDrawing.ModelSpace.AddExtrudedSolid(oReg(0), dLength, 0)
End Sub
Public Sub CylinderFromUcs()
    Dim oUcs As AcadUCS
    Dim Orig As Variant
    Dim xAxisPnt(0 To 2) As Double
    Dim yAxisPnt(0 To 2) As Double
    Dim oCyl As Acad3DSolid
   
    Orig = ThisDrawing.Utility.GetPoint
    Set oCyl = ThisDrawing.ModelSpace.AddCylinder(Zero, 1, 3)
    ' Define the UCS
    xAxisPnt(0) = 0: xAxisPnt(1) = 0: xAxisPnt(2) = -1
    yAxisPnt(0) = 0: yAxisPnt(1) = 1: yAxisPnt(2) = 0
    Set oUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, xAxisPnt, yAxisPnt, "New_UCS")
    oUcs.origin = Orig
    oCyl.TransformBy oUcs.GetUCSMatrix
End Sub
Function ToUcs(pt As Variant) As Variant
    ToUcs = ThisDrawing.Utility.TranslateCoordinates(pt, acWorld, acUCS, False)
End Function