AutoCAD VBA (AutoCAD COM API) has built-in coordinate transform function: AcadUtility.TranslateCoordinates(). So, basically there is no need to convert the lisp code you provided.
In your case, you have a entity's bounding box, which is presented with 2 points (min point and max point). The 2 points' coordinates are in WCS. You want to know the 2 points' coordinates in current UCS. Following code shows how to call TranslateCoordinates():
Option Explicit
Public Sub GetEntityBoundingBox()
Dim ent As AcadEntity
Dim pt As Variant
Dim maxPt As Variant
Dim minPt As Variant
On Error Resume Next
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Select an entity:"
If ent Is Nothing Then Exit Sub
'' Get the entity's bounding box points, in WCS
ent.GetBoundingBox minPt, maxPt
ShowPoints "Coordinates in WCS", minPt, maxPt
'' Get the entity's bounding box point, shown in Editor (UCS)
maxPt = ThisDrawing.Utility.TranslateCoordinates(maxPt, acWorld, acUCS, 0)
minPt = ThisDrawing.Utility.TranslateCoordinates(minPt, acWorld, acUCS, 0)
ShowPoints "Coordinates in UCS", minPt, maxPt
End Sub
Private Sub ShowPoints(generalText As String, firstPt As Variant, secondPt As Variant)
Dim maxText As String
Dim minText As String
maxText = vbTab & "First Point =>" & vbTab & "X: " & firstPt(0) & vbTab & "Y: " & firstPt(1)
minText = vbTab & "Second Point ->" & vbTab & "X: " & secondPt(0) & vbTab & "Y: " & secondPt(1)
MsgBox generalText & vbCrLf & vbCrLf & minText & vbCrLf & maxText
End Sub
Sorry for getting this discussion back late because of being a bit busy in past a few days.
I misunderstood your question and thought you just want to know an entity's bounding box coordinates that converted to current UCS.
Now I know what you want is the "Bounding Box" with the entity's appearance in the UCS (thus the bounding box is different from the one calculated with its WCS coordinate with the VBA method AcadEntity.GetBoundingBox()).
Because we need to call AcadEntity.GetBoundingBox() to get the max/min points of the bounding box, which is calculated based on the entity's WCS coordinates, so to do what you want, logically, is rather simple: transform the entity according to its UCS transformation IN WCS, so that the entity would appear in WCS as if it is in UCS. Then call AcadEntity.GetBoundingBox(), thus, we get the bounding box's max/min point coordinates with the values that are the same as if the entity's bounding box in UCS.
Well, while it is sounds simply, but with VBA, there are a couple of catches that makes things complicated:
1. Firstly, you need to get the UCS transform matrix. The catch is, if the current UCS is not saved (not named), the AcadUcs.GetUcsMatrix() returns wrong matrix. So, if the current UCS is not named, we need to save/name it and make it as ThisDrawing.ActiveUCS;
2. We must invert the UCS matrix before transform the entity. It is unfortunately, there is no existing VBA support to get inverse transform matrix (4 x 4 matrix). My work currently is doing AutoCAD .NET API, which provides enough Matrix calculation, and find it is frustrating that there is no easy way to invert the transform matrix. Fortunately, someone post VBA code in this forum years ago to do this inverting work here. (IMO, anyone who want to stick with Acad VBA for a while, should save this precious code!).
In my code example below, instead of transforming the entity with UCS matrix, and then transform it back after the calculation, I create a copy of the entity, transform it to get wanted coordinates, and then erase the copy. Here is the code:
Option Explicit
Public Sub GetUcsBoundungBox()
Dim ucs As AcadUCS
If ThisDrawing.GetVariable("UCSNAME") = "" Then
'' current UCS is not saved, we must save it first
With ThisDrawing
Set ucs = .UserCoordinateSystems.Add( _
.GetVariable("UCSORG"), _
.GetVariable("UCSXDIR"), _
.GetVariable("UCSYDIR"), _
"OriginalUCS")
End With
ThisDrawing.ActiveUCS = ucs
Else
Set ucs = ThisDrawing.ActiveUCS 'current UCS is saved
End If
Dim ucsMatrix As Variant
ucsMatrix = ucs.GetUCSMatrix
'' Invert the UCS matrix
Dim inverseMatrix(0 To 3, 0 To 3) As Double
Dim inverseOk As Boolean
inverseOk = InvertMatrix(ucsMatrix, inverseMatrix)
If Not inverseOk Then
MsgBox "Error"
Exit Sub
End If
Dim ent As AcadEntity
Dim entCopy As AcadEntity
Dim pt As Variant
On Error Resume Next
ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Pick entity:"
If ent Is Nothing Then Exit Sub
Set entCopy = ent.Copy()
entCopy.ColorIndex = 2
entCopy.TransformBy inverseMatrix
Dim minPt As Variant
Dim maxPt As Variant
'' The entity's WCS bounding box
ent.GetBoundingBox minPt, maxPt
ShowPoints "Coordinates in WCS", minPt, maxPt
'' The appeared bounding box in UCS
entCopy.GetBoundingBox minPt, maxPt
ShowPoints "Coordinates in UCS", minPt, maxPt
entCopy.Delete
End Sub
Private Sub ShowPoints(generalText As String, firstPt As Variant, secondPt As Variant)
Dim maxText As String
Dim minText As String
maxText = vbTab & "First Point =>" & _
vbTab & "X: " & ThisDrawing.Utility.RealToString(firstPt(0), acDefaultUnits, 3) & _
vbTab & "Y: " & ThisDrawing.Utility.RealToString(firstPt(1), acDefaultUnits, 3)
minText = vbTab & "Second Point ->" & _
vbTab & "X: " & ThisDrawing.Utility.RealToString(secondPt(0), acDefaultUnits, 3) & _
vbTab & "Y: " & ThisDrawing.Utility.RealToString(secondPt(1), acDefaultUnits, 3)
MsgBox generalText & vbCrLf & vbCrLf & minText & vbCrLf & maxText
End Sub
Here is the code to invert transform matrix (while one can directly get it from https://forums.autodesk.com/t5/vba/invert-a-transformation-matrix/m-p/11074048#M106055 , I still post it make make my reply complete):
Option Explicit
''https://forums.autodesk.com/t5/vba/invert-a-transformation-matrix/m-p/11074048#M106055
Public Function InvertMatrix(ByVal MatrixIn As Variant, ByRef MatrixOut As Variant) As Boolean
''## This code dervied from code found here:
''## https://stackoverflow.com/questions/1148309/inverting-a-4x4-matrix
''## Both of the above parameters are 4x4 arrays (0 to 3, 0 to 3)
''## These just help with visibility/alignment by using a leading 'O' since i can't use leading zeroes...
Dim O0 As Integer: O0 = 0
Dim O1 As Integer: O1 = 1
Dim O2 As Integer: O2 = 2
Dim O3 As Integer: O3 = 3
Dim O4 As Integer: O4 = 4
Dim O5 As Integer: O5 = 5
Dim O6 As Integer: O6 = 6
Dim O7 As Integer: O7 = 7
Dim O8 As Integer: O8 = 8
Dim O9 As Integer: O9 = 9
Dim m00 As Double: m00 = MatrixIn(0, 0)
Dim m01 As Double: m01 = MatrixIn(0, 1)
Dim m02 As Double: m02 = MatrixIn(0, 2)
Dim m03 As Double: m03 = MatrixIn(0, 3)
Dim m04 As Double: m04 = MatrixIn(1, 0)
Dim m05 As Double: m05 = MatrixIn(1, 1)
Dim m06 As Double: m06 = MatrixIn(1, 2)
Dim m07 As Double: m07 = MatrixIn(1, 3)
Dim m08 As Double: m08 = MatrixIn(2, 0)
Dim m09 As Double: m09 = MatrixIn(2, 1)
Dim m10 As Double: m10 = MatrixIn(2, 2)
Dim m11 As Double: m11 = MatrixIn(2, 3)
Dim m12 As Double: m12 = MatrixIn(3, 0)
Dim m13 As Double: m13 = MatrixIn(3, 1)
Dim m14 As Double: m14 = MatrixIn(3, 2)
Dim m15 As Double: m15 = MatrixIn(3, 3)
Dim inv(0 To 15) As Double
Dim out(0 To 15) As Double
Dim det As Double
Dim i As Integer
inv(O0) = 0 + (m05 * m10 * m15) - (m05 * m11 * m14) - (m09 * m06 * m15) + (m09 * m07 * m14) + (m13 * m06 * m11) - (m13 * m07 * m10)
inv(O4) = 0 - (m04 * m10 * m15) + (m04 * m11 * m14) + (m08 * m06 * m15) - (m08 * m07 * m14) - (m12 * m06 * m11) + (m12 * m07 * m10)
inv(O8) = 0 + (m04 * m09 * m15) - (m04 * m11 * m13) - (m08 * m05 * m15) + (m08 * m07 * m13) + (m12 * m05 * m11) - (m12 * m07 * m09)
inv(12) = 0 - (m04 * m09 * m14) + (m04 * m10 * m13) + (m08 * m05 * m14) - (m08 * m06 * m13) - (m12 * m05 * m10) + (m12 * m06 * m09)
inv(O1) = 0 - (m01 * m10 * m15) + (m01 * m11 * m14) + (m09 * m02 * m15) - (m09 * m03 * m14) - (m13 * m02 * m11) + (m13 * m03 * m10)
inv(O5) = 0 + (m00 * m10 * m15) - (m00 * m11 * m14) - (m08 * m02 * m15) + (m08 * m03 * m14) + (m12 * m02 * m11) - (m12 * m03 * m10)
inv(O9) = 0 - (m00 * m09 * m15) + (m00 * m11 * m13) + (m08 * m01 * m15) - (m08 * m03 * m13) - (m12 * m01 * m11) + (m12 * m03 * m09)
inv(13) = 0 + (m00 * m09 * m14) - (m00 * m10 * m13) - (m08 * m01 * m14) + (m08 * m02 * m13) + (m12 * m01 * m10) - (m12 * m02 * m09)
inv(O2) = 0 + (m01 * m06 * m15) - (m01 * m07 * m14) - (m05 * m02 * m15) + (m05 * m03 * m14) + (m13 * m02 * m07) - (m13 * m03 * m06)
inv(O6) = 0 - (m00 * m06 * m15) + (m00 * m07 * m14) + (m04 * m02 * m15) - (m04 * m03 * m14) - (m12 * m02 * m07) + (m12 * m03 * m06)
inv(10) = 0 + (m00 * m05 * m15) - (m00 * m07 * m13) - (m04 * m01 * m15) + (m04 * m03 * m13) + (m12 * m01 * m07) - (m12 * m03 * m05)
inv(14) = 0 - (m00 * m05 * m14) + (m00 * m06 * m13) + (m04 * m01 * m14) - (m04 * m02 * m13) - (m12 * m01 * m06) + (m12 * m02 * m05)
inv(O3) = 0 - (m01 * m06 * m11) + (m01 * m07 * m10) + (m05 * m02 * m11) - (m05 * m03 * m10) - (m09 * m02 * m07) + (m09 * m03 * m06)
inv(O7) = 0 + (m00 * m06 * m11) - (m00 * m07 * m10) - (m04 * m02 * m11) + (m04 * m03 * m10) + (m08 * m02 * m07) - (m08 * m03 * m06)
inv(11) = 0 - (m00 * m05 * m11) + (m00 * m07 * m09) + (m04 * m01 * m11) - (m04 * m03 * m09) - (m08 * m01 * m07) + (m08 * m03 * m05)
inv(15) = 0 + (m00 * m05 * m10) - (m00 * m06 * m09) - (m04 * m01 * m10) + (m04 * m02 * m09) + (m08 * m01 * m06) - (m08 * m02 * m05)
det = m00 * inv(O0) + _
m01 * inv(O4) + _
m02 * inv(O8) + _
m03 * inv(12)
If det = 0 Then
InvertMatrix = False
Else
det = 1# / det
For i = 0 To 15
out(i) = inv(i) * det
Next
End If
MatrixOut(0, 0) = out(0)
MatrixOut(0, 1) = out(1)
MatrixOut(0, 2) = out(2)
MatrixOut(0, 3) = out(3)
MatrixOut(1, 0) = out(4)
MatrixOut(1, 1) = out(5)
MatrixOut(1, 2) = out(6)
MatrixOut(1, 3) = out(7)
MatrixOut(2, 0) = out(8)
MatrixOut(2, 1) = out(9)
MatrixOut(2, 2) = out(10)
MatrixOut(2, 3) = out(11)
MatrixOut(3, 0) = out(12)
MatrixOut(3, 1) = out(13)
MatrixOut(3, 2) = out(14)
MatrixOut(3, 3) = out(15)
InvertMatrix = True
End Function
Hope this helps.
If @norman.yuan solved your problem, please use the button to accept his solution.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
