这里是#039;这是几个例子
前两个使用法线,第三个使用ucs- 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
-
|