圆范数
**** Hidden Message ***** 所以，要么我设置每个对象正常，要么我让世界当前，这可能是一个清洗。Mick这种情况在C#中也会发生吗？ 感谢回复，实际上，如果我将Wcs设为当前，正常就可以了(0，0，1)。
插入时，blockref也接收ucs法线，因此我正在计算旋转并保持法线不变。数学是有点棘手的(我可以看到这一切，但我似乎需要一个矩阵，所以这是不值得的)，所以我想我会插入它设置法线为0，0，1，然后使用ucs矩阵转换它。这是简单的解决办法，但我不会说是最好的。 以防有人懂数学。通过将ucs xdir向量从ucs法线(x和y的叉积)转换到世界法线，然后将新的向量角度与世界x轴进行比较，可以找到旋转。 这听起来像是你需要做你在op中所说的，在wcs中创建块，然后将其xform到所需的位置，无论如何，这都是很好的做法，并保持了origin-al数学的简单性。如果你能在插入块时得到目标ucs，那将很容易 -
创建块@ origin，
获取当前的ucs（或类似）
构建矩阵与ucs
xform块并完成。
hth 好建议米克。
作为插入函数，以下工作正常，但我稍后必须更改插入点（oBref.InsertionPoint=insPt），不知道为什么。
Function InsertBlockref(Space As AcadBlock, insPt As Variant, sName As String, Optional Sc As Double = 1, Optional Rot As Double = 0) As AcadBlockReference
Dim oBref As AcadBlockReference
Dim Zero(2) As Double
Dim N(2) As Double, oUcs As AcadUCS
Dim Att
Set oBref = Space.InsertBlock(Zero, sName, Sc, Sc, Sc, Rot)
If ThisDrawing.GetVariable("Worlducs") = 1 Then
Set InsertBlockref = oBref
Exit Function
End If
N(2) = 1
oBref.Normal = N
If oBref.HasAttributes Then
For Each Att In oBref.GetAttributes
Att.Normal = N
Next Att
End If
Set oUcs = GetActiveUcs
oBref.TransformBy oUcs.GetUCSMatrix
oBref.InsertionPoint = insPt
Set InsertBlockref = oBref
End Function
和一个函数
Function GetActiveUcs() As AcadUCS
Dim Origin
Dim Xaxis
Dim Yaxis
Dim strNm As String, sUcs As String
sUcs = ThisDrawing.GetVariable("UCSNAME")
If sUcs = "" Then
' Current UCS is not saved so get the data and save it
'A ucs is saved when a user makes and saves one or
' a user clicks on an isoview button
With ThisDrawing
If .GetVariable("WORLDUCS") = 1 Then
Xaxis = Zero: Yaxis = Zero
Xaxis(0) = 1: Yaxis(1) = 1
Set GetActiveUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, Xaxis, Yaxis, "World")
Exit Function
End If
Origin = .GetVariable("UCSORG")
Xaxis = .GetVariable("UCSXDIR")
Yaxis = .GetVariable("UCSYDIR")
strNm = "Active"
End With
Set GetActiveUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, Xaxis, Yaxis, strNm)
'Changing the origin later stops the error message
'-2145320930 UCS X axis and Y axis are not perpendicular
GetActiveUcs.Origin = Origin
ThisDrawing.ActiveUCS = GetActiveUcs
Else
Select Case sUcs
Case "*TOP*", "TOP"
Set GetActiveUcs = SetOrthoUCS("Top")
Case "*BOTTOM*"
Set GetActiveUcs = SetOrthoUCS("Bottom")
Case "*LEFT*"
Set GetActiveUcs = SetOrthoUCS("Left")
Case "*RIGHT*"
Set GetActiveUcs = SetOrthoUCS("Right")
Case "*FRONT*"
Set GetActiveUcs = SetOrthoUCS("Front")
Case "*BACK*"
Set GetActiveUcs = SetOrthoUCS("Back")
Case Else
Set GetActiveUcs = ThisDrawing.ActiveUCS'current UCS is saved
End Select
End If
End Function
嗨，Bryco，以为我会复活这个线程，因为我现在自己也有同样的问题，我不能一辈子知道为什么他们没有在vba中实现更多的几何类，特别是矩阵。哦，好吧...
我从上面的函数中获取它，如果没有ucs名称，即它是“”，我们将得到一个空对象ID错误，因此我们必须将当前ucs保存到ucs表中，并从那里获取它以将对象转换为当前ucs，这是对的吗？
另外，你有 SetOrthoUCS 函数吗？
谢谢，
米克。 同意Mick的观点，C#有这么多现成的好数学。
Public Function SetOrthoUCS(Optional strUcs As String = "Top") As AcadUCS
Dim dOrigin(2) As Double
Dim dXaxisPnt(2) As Double
Dim dYaxisPnt(2) As Double
'all the ucs' will originate from 0,0,0 as per the behavior in acad
Select Case strUcs
Case "Top"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 1: dYaxisPnt(2) = 0
Case "Bottom"
dXaxisPnt(0) = -1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 1: dYaxisPnt(2) = 0
Case "Right"
dXaxisPnt(0) = 0: dXaxisPnt(1) = 1: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case "Left"
dXaxisPnt(0) = 0: dXaxisPnt(1) = -1: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case "Front"
dXaxisPnt(0) = 1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case "Back"
dXaxisPnt(0) = -1: dXaxisPnt(1) = 0: dXaxisPnt(2) = 0
dYaxisPnt(0) = 0: dYaxisPnt(1) = 0: dYaxisPnt(2) = 1
Case Else
Exit Function
End Select
Set SetOrthoUCS = ThisDrawing.UserCoordinateSystems.Add(dOrigin, dXaxisPnt, dYaxisPnt, strUcs)
ThisDrawing.ActiveUCS = SetOrthoUCS
End Function
谢谢布里科，我会给那些运行，看看它如何进行。
页:
[1]