不同ucs中的圆柱体
好吧，我又难倒自己了 ；我试图定义一个新的ucs，并在该ucs而不是wcs中绘制一个圆柱体 ；这是我到目前为止的代码[代码我想我需要以某种方式改变我的坐标，但我从来没有这样做过，所以我该怎么做？圆柱体使用这个变体是在WCS中，我认为这是我的问题 或者对于那些想要大局的人，我真正需要做的是 插入圆时，它将插入到世界坐标中，但它将采用当前ucs的法线。设置圆。法线为0,0,1，然后使用ucsmatrix变换圆 如果你只想画一个圆并挤出，继续…
…但是有一个圆柱体命令要求第一个端点中心和半径，然后提示；圆柱体或[另一端中心]的高度“；它允许您将另一端的中心放置在空间中的任何位置，而不考虑UCS ；可能值得一次调查。 它真的很脏，但我的大脑正在关闭
这是可行的，但也有一些怪癖：
1-你选择一条定义圆柱体走向的线
2-你选择线的中点b/c圆柱体由质心放置
3-你必须选择线的第三个点（正交/极性开是件好事）
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 周一需要进行更多清理 这里是#039；这是几个例子
前两个使用法线，第三个使用ucsPublic 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
布莱科，这些很好用 
；现在，你能解释一下发生了什么吗？这样我就知道发生了什么，这样我就可以在将来使用它了 ；干得好。 谢谢你。我本打算写一篇关于这方面的文章，但它'；这需要一点时间
对于圆柱体以外的对象，请注意Ucs方法，由于某些原因，圆柱体的工作原理与其他实体略有不同
“帮助说”；创建一个三维实体圆柱体，其底部位于WCS的XY平面上&引用；通常，在世界中插入一些东西，确保法线为0,0,1，然后将其转换为所需的ucs（或矩阵）
Bryco，我再次喜欢你的代码，谢谢你的优雅（雅达）'J#039&书信电报；
页:
[1]
2