Copy Object from UCS to another UCS

[roger.wall]

Hello I would like to write some VBA code to copy a solid with one UCS set (eg. "FROM" ucs) , set another UCS ("To" UCS) and copy it to there and for it to align to this new UCS. Can somebody please give me a clue as to how to do this. Regards, Roger.

[roger.wall]

I think i should use the Transformation Matrix somehow but just not sure how to do it

[Ed__Jobe]

You need to use the TranslateCoordinates method. Here is the info you need and an example.

[roger.wall]

Hi Ed, Thanks so much for your reply. I know how to translate points from one UCS to another (or UCS to WCS, etc). I want to move/copy an object (a solid) from being aligned  (say with XY plane) of one UCS to the XY plane of another UCS.  Regards, Roger.

[Ed__Jobe]

Are you saying, for example, you have a knob on the south face of a box and you want to place a copy of the knob on the north face? Assuming you have a UCS for each face.

[roger.wall]

Yes that's correct -  the knob is a solid i have drawn via VBA. The UCSs are both strangely orientated ie. not on standard Front, Back, left right, etc planes.  They are aligned to slopping surfaces of a building.  So say to a sloped, twisted door for the knob. I have the UCSs set up for the From and To locations. I want to copy the knob from once ucs to the other.  The knob would have to copy, move and the rotate some how in all 3 axis to align to the new UCS.  Thank you for your interest in my problem, Regards Roger.

[SEANT61 · Accepted solution]

AutoCAD’s ActiveX API (VBA) does not come with the full complement of matrix manipulation functionality.  That’s one of the benefits of switching to one of the .NET languages – C# or VB.NET.

Painstakingly, though, the functions can be reproduced for VBA.  The attached routine has one – the Inverse Matrix function.  That allows me to copy an object from a UCS to the WCS.  The object can then be reoriented to another UCS.  Additional matrix’s arithmetic function could allow moves from one UCS directly to another.

The Code below was used for the linked screencast.  See the attached file and examine the Named UCSs.

https://autode.sk/3bhRCo2 

Sub CopySolidToUCS()

Dim entEnt As AcadEntity
Dim entCopy As AcadEntity

Dim varPkPt As Variant

Dim dblUCSMatrix() As Double
Dim dblInvMatrix() As Double

Dim strWorkingUcsName As String
Dim FromUCS As AcadUCS
Dim ToUCS As AcadUCS

With ThisDrawing

   On Error Resume Next
   .Utility.GetEntity entEnt, varPkPt, "Select an Entity: "
   If Err <> 0 Then Exit Sub
   
   strWorkingUcsName = .Utility.GetString(0, "Input ""From"" UCS name: ")
   Set FromUCS = .UserCoordinateSystems.Item(strWorkingUcsName)
   
   If Err <> 0 Then
      .Utility.Prompt ("UCS of that name could not be found: Terminating Sub!" & vbLf)
         On Error GoTo 0
      Exit Sub
   End If
   
   Set entCopy = entEnt.Copy()
   entCopy.Visible = False
   
   dblUCSMatrix = FromUCS.GetUCSMatrix()
   dblInvMatrix = InverseMatrix(dblUCSMatrix)
   entCopy.TransformBy dblInvMatrix

   strWorkingUcsName = .Utility.GetString(0, "Input ""To"" UCS name: ")
   Set ToUCS = .UserCoordinateSystems.Item(strWorkingUcsName)
   
   If Err <> 0 Then
      .Utility.Prompt ("UCS of that name could not be found: Terminating Sub!" & vbLf)
      entCopy.Delete
      On Error GoTo 0
      Exit Sub
   End If
   
   entCopy.TransformBy ToUCS.GetUCSMatrix()
   entCopy.Visible = True
   
   On Error GoTo 0

End With
End Sub


Function InverseMatrix(m() As Double) As Double()
Dim dblDeterm As Double
Dim dblInvMat(3, 3) As Double
dblDeterm = (m(0, 0) * ((m(1, 1) * (m(2, 2) * m(3, 3) - m(2, 3) * m(3, 2))) + (-m(1, 2) * (m(2, 1) * m(3, 3) - m(2, 3) * m(3, 1))) + (m(1, 3) * (m(2, 1) * m(3, 2) - m(2, 2) * m(3, 1))))) + (-m(0, 1) * ((m(1, 0) * (m(2, 2) * m(3, 3) - m(2, 3) * m(3, 2))) + (-m(1, 2) * (m(2, 0) * m(3, 3) - m(2, 3) * m(3, 0))) + (m(1, 3) * (m(2, 0) * m(3, 2) - m(2, 2) * m(3, 0))))) + (m(0, 2) * ((m(1, 0) * (m(2, 1) * m(3, 3) - m(2, 3) * m(3, 1))) + (-m(1, 1) * (m(2, 0) * m(3, 3) - m(2, 3) * m(3, 0))) + (m(1, 3) * (m(2, 0) * m(3, 1) - m(2, 1) * m(3, 0))))) + (-m(0, 3) * ((m(1, 0) * (m(2, 1) * m(3, 2) - m(2, 2) * m(3, 1))) + (-m(1, 1) * (m(2, 0) * m(3, 2) - m(2, 2) * m(3, 0))) + (m(1, 2) * (m(2, 0) * m(3, 1) - m(2, 1) * m(3, 0)))))
If dblDeterm = 0 Then Exit Function 'Some error checking required
dblDeterm = 1 / dblDeterm
 
dblInvMat(0, 0) = dblDeterm * ((m(1, 1) * (m(2, 2) * m(3, 3) - m(2, 3) * m(3, 2))) + (-m(1, 2) * (m(2, 1) * m(3, 3) - m(2, 3) * m(3, 1))) + (m(1, 3) * (m(2, 1) * m(3, 2) - m(2, 2) * m(3, 1))))
dblInvMat(0, 1) = dblDeterm * -((m(0, 1) * (m(2, 2) * m(3, 3) - m(2, 3) * m(3, 2))) + (-m(0, 2) * (m(2, 1) * m(3, 3) - m(2, 3) * m(3, 1))) + (m(0, 3) * (m(2, 1) * m(3, 2) - m(2, 2) * m(3, 1))))
dblInvMat(0, 2) = dblDeterm * ((m(0, 1) * (m(1, 2) * m(3, 3) - m(1, 3) * m(3, 2))) + (-m(0, 2) * (m(1, 1) * m(3, 3) - m(1, 3) * m(3, 1))) + (m(0, 3) * (m(1, 1) * m(3, 2) - m(1, 2) * m(3, 1))))
dblInvMat(0, 3) = dblDeterm * -((m(0, 1) * (m(1, 2) * m(2, 3) - m(1, 3) * m(2, 2))) + (-m(0, 2) * (m(1, 1) * m(2, 3) - m(1, 3) * m(2, 1))) + (m(0, 3) * (m(1, 1) * m(2, 2) - m(1, 2) * m(2, 1))))
dblInvMat(1, 0) = dblDeterm * -((m(1, 0) * (m(2, 2) * m(3, 3) - m(2, 3) * m(3, 2))) + (-m(1, 2) * (m(2, 0) * m(3, 3) - m(2, 3) * m(3, 0))) + (m(1, 3) * (m(2, 0) * m(3, 2) - m(2, 2) * m(3, 0))))
dblInvMat(1, 1) = dblDeterm * ((m(0, 0) * (m(2, 2) * m(3, 3) - m(2, 3) * m(3, 2))) + (-m(0, 2) * (m(2, 0) * m(3, 3) - m(2, 3) * m(3, 0))) + (m(0, 3) * (m(2, 0) * m(3, 2) - m(2, 2) * m(3, 0))))
dblInvMat(1, 2) = dblDeterm * -((m(0, 0) * (m(1, 2) * m(3, 3) - m(1, 3) * m(3, 2))) + (-m(0, 2) * (m(1, 0) * m(3, 3) - m(1, 3) * m(3, 0))) + (m(0, 3) * (m(1, 0) * m(3, 2) - m(1, 2) * m(3, 0))))
dblInvMat(1, 3) = dblDeterm * ((m(0, 0) * (m(1, 2) * m(2, 3) - m(1, 3) * m(2, 2))) + (-m(0, 2) * (m(1, 0) * m(2, 3) - m(1, 3) * m(2, 0))) + (m(0, 3) * (m(1, 0) * m(2, 2) - m(1, 2) * m(2, 0))))
dblInvMat(2, 0) = dblDeterm * ((m(1, 0) * (m(2, 1) * m(3, 3) - m(2, 3) * m(3, 1))) + (-m(1, 1) * (m(2, 0) * m(3, 3) - m(2, 3) * m(3, 0))) + (m(1, 3) * (m(2, 0) * m(3, 1) - m(2, 1) * m(3, 0))))
dblInvMat(2, 1) = dblDeterm * -((m(0, 0) * (m(2, 1) * m(3, 3) - m(2, 3) * m(3, 1))) + (-m(0, 1) * (m(2, 0) * m(3, 3) - m(2, 3) * m(3, 0))) + (m(0, 3) * (m(2, 0) * m(3, 1) - m(2, 1) * m(3, 0))))
dblInvMat(2, 2) = dblDeterm * ((m(0, 0) * (m(1, 1) * m(3, 3) - m(1, 3) * m(3, 1))) + (-m(0, 1) * (m(1, 0) * m(3, 3) - m(1, 3) * m(3, 0))) + (m(0, 3) * (m(1, 0) * m(3, 1) - m(1, 1) * m(3, 0))))
dblInvMat(2, 3) = dblDeterm * -((m(0, 0) * (m(1, 1) * m(2, 3) - m(1, 3) * m(2, 1))) + (-m(0, 1) * (m(1, 0) * m(2, 3) - m(1, 3) * m(2, 0))) + (m(0, 3) * (m(1, 0) * m(2, 1) - m(1, 1) * m(2, 0))))
dblInvMat(3, 0) = dblDeterm * -((m(1, 0) * (m(2, 1) * m(3, 2) - m(2, 2) * m(3, 1))) + (-m(1, 1) * (m(2, 0) * m(3, 2) - m(2, 2) * m(3, 0))) + (m(1, 2) * (m(2, 0) * m(3, 1) - m(2, 1) * m(3, 0))))
dblInvMat(3, 1) = dblDeterm * ((m(0, 0) * (m(2, 1) * m(3, 2) - m(2, 2) * m(3, 1))) + (-m(0, 1) * (m(2, 0) * m(3, 2) - m(2, 2) * m(3, 0))) + (m(0, 2) * (m(2, 0) * m(3, 1) - m(2, 1) * m(3, 0))))
dblInvMat(3, 2) = dblDeterm * -((m(0, 0) * (m(1, 1) * m(3, 2) - m(1, 2) * m(3, 1))) + (-m(0, 1) * (m(1, 0) * m(3, 2) - m(1, 2) * m(3, 0))) + (m(0, 2) * (m(1, 0) * m(3, 1) - m(1, 1) * m(3, 0))))
dblInvMat(3, 3) = dblDeterm * ((m(0, 0) * (m(1, 1) * m(2, 2) - m(1, 2) * m(2, 1))) + (-m(0, 1) * (m(1, 0) * m(2, 2) - m(1, 2) * m(2, 0))) + (m(0, 2) * (m(1, 0) * m(2, 1) - m(1, 1) * m(2, 0))))

InverseMatrix = dblInvMat
 
End Function

[SEANT61]

Linked Screencast

 

[roger.wall]

Hi SeanT61, Thanks for that. I think that is pretty close. Can you please tell me:

1. HOw much extra stuff can you do with VB.nat as apoosed to VBA

2. What is a good resourse for convert VBA to vb.net? is it painfull?

3.  What is a good resource for understanding these matrixes - past just the basic stuff.

THanks so much. Take care. ROger Wall

[SEANT61]

Answers:

1. Plenty. VBA has fairly limited access to the underpinnings of AutoCAD's geometry engine and UI. The .NET API rivals the Native ARX API regarding full access.
2. My advise here would be to not try to convert the VBA. I'd say learn .NET (I'd also advise C#), and re-write any legacy program with the more comprehensive and efficient ACAD code base.
3. Look for a copy of 'Visual Basic Graphics Programming' (non .NET Visual Basic). That suggestion is rather ironic given the previous endorsements. But, perhaps, it would allow for concurrent learning of as new language, as well as matrix programming in a medium already well understood.