Hi,
an DEM Thema habe ich mich auch schon oft und lang versucht. Sozusagen einige Wochen in Summe. Das schöne ist ja das die Blöcke notfalls auch noch Bestandteil anderer Blöcke sein können welche ja auch im Raum noch... 3DROTATE(Der Befehl Rotiert ja um alle Achsen...) .... Was die Angelegenheit na klar drastisch trivialisiert
Also du kannst dann Vektorechnung beidhändig mit Verve schwingen und bis zur Rente hast das dann raus. Nee
Irgendjemand hat irgendwann mir dazu mal einen Hinweis für ein .Net API gegeben. Damit Kommst du an die Transformations Matrix des Blockes ran. Als auch dessen Inverse. Die Matrix beschreibt wie der Block im 3D Raum realtiv zu seinem Eigner angeordnet wurde. Stichwort entity.transform ...
Die inverse beschreibt was man passiert wenn man den Block explodiert. Sprich die Entitys wieder zurück in den übergeordneten Block transformiert.
Das ist in .Net ein besserer Einzeiler. Man steinige mich nicht für den fürchterlichen code - Ich brauchte das neulich mal auf die Schnelle und nicht in schön. Das liegt bei mir derzeit noch alles sehr sehr roh auf der Werkbank.
Bei geschachtelten Blöcken muss man diese Transformationsmatrix nun noch jedes mal mit der des übergeordneten Blocks multiplizieren. Es ist also nicht die Gesamtmatrix sondern nur realtiv zum jeweiliegen Eigner.
Ich hangele mich rekursiv einmal durch alle Blockreferenzen in der Zeichnung und ergänze die in VBA nicht vorhandene Transformationsmatrix über ein Dictionary.
Mit dieser Info kann man nun Entitys zwischen Blöcken kopieren, an Blöcken Entitys dazu adddieren (da habe ich sowas mal ohne .net hier gepostet) oder auf Punkte im Modelspace zugreifen usw. Oder halt einfach nur Koordinaten umrechnen.
Was bei dir ja der Fall sein dürfte.
Das Ganze klappt auch mit skalierten und gescherten , gespiegelten Blöcken. Steckt ja alles in bereits in dieser Matrix .
Einen mathematischen Einstieg in das Thema findest du auch hier
http://www.mttcs.org/Skripte/Pra/Material/vorlesung3.pdf
Die Pdfs gehen von 1-10 - Allgem. Einführung in Computergrafik sind schön gemacht
https://www.tu-ilmenau.de/fileadmin/media/gdv/Lehre/Computergrafik_I/Uebung/gdv1gt.pdf
'This Funtion return the Product of
'MatrixA MatrixB
'The Product of two Matrix will get one Matrix
'that dose the same as use TransformBy
'with bouth matrix
Public Function MatrixProduct(MatrixA, MatrixB)
Dim M, n1, n2, R, I, j, j1 As Long
Dim Product() As Double
M = UBound(MatrixA, 1)
n1 = UBound(MatrixA, 2)
n2 = UBound(MatrixB, 1)
R = UBound(MatrixB, 2)
If n1 <> n2 Then Exit Function
ReDim Product(M, R)
For I = 0 To M
For j = 0 To R
Product(I, j) = 0
For j1 = 0 To n1
Product(I, j) = Product(I, j) + (MatrixA(I, j1) * MatrixB(j1, j))
Next
Next
Next
MatrixProduct = Product
End Function
Sub MATRIX_DBG(MAT() As Double)
'debug.print
'debug.print MAT(0, 0), MAT(0, 1), MAT(0, 2), MAT(0, 3)
'debug.print MAT(1, 0), MAT(1, 1), MAT(1, 2), MAT(1, 3)
'debug.print MAT(2, 0), MAT(2, 1), MAT(2, 2), MAT(2, 3)
'debug.print MAT(3, 0), MAT(3, 1), MAT(3, 2), MAT(3, 3)
End Sub
Sub matrix_test()
Dim tmatrix As New slope64.matrix
Dim ENTITY As AcadEntity
Dim HANDLE As String
For Each ENTITY In ThisDrawing.PickfirstSelectionSet
If LCase(ENTITY.objectname) = "acdbblockreference" Then
HANDLE = ENTITY.HANDLE
GoTo weiter
End If
Next
Exit Sub
weiter:
HANDLE = "85D"
' Dim tmatrix As New slope64.matrix
tmatrix.HANDLE = HANDLE
tmatrix.init_matrix
Dim I As Long
Dim MAT(0 To 3, 0 To 3) As Double
Dim INV(0 To 3, 0 To 3) As Double
I = 0
MAT(0, 0) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(0, 1) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(0, 2) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(0, 3) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(1, 0) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(1, 1) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(1, 2) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(1, 3) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(2, 0) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(2, 1) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(2, 2) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(2, 3) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(3, 0) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(3, 1) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(3, 2) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(3, 3) = tmatrix.get_block_transform_matrix(I): I = I + 1
'debug.print
'debug.print MAT(0, 0), MAT(0, 1), MAT(0, 2), MAT(0, 3)
'debug.print MAT(1, 0), MAT(1, 1), MAT(1, 2), MAT(1, 3)
'debug.print MAT(2, 0), MAT(2, 1), MAT(2, 2), MAT(2, 3)
'debug.print MAT(3, 0), MAT(3, 1), MAT(3, 2), MAT(3, 3)
I = 0
INV(0, 0) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(0, 1) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(0, 2) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(0, 3) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(1, 0) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(1, 1) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(1, 2) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(1, 3) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(2, 0) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(2, 1) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(2, 2) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(2, 3) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(3, 0) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(3, 1) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(3, 2) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(3, 3) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
Dim P As Point3d
Dim p2 As Point3d
p2 = POINT_TRANSFORM(P, MAT())
'debug.print p2.x
'debug.print p2.y
'debug.print p2.z
End Sub
Function POINT_TRANSFORM(POINT As Point3d, MAT() As Double) As Point3d
Dim RES As Point3d
RES.x = POINT.x * MAT(0, 0) + POINT.y * MAT(0, 1) + POINT.z * MAT(0, 2) + MAT(0, 3)
RES.y = POINT.x * MAT(1, 0) + POINT.y * MAT(1, 1) + POINT.z * MAT(1, 2) + MAT(1, 3)
RES.z = POINT.x * MAT(2, 0) + POINT.y * MAT(2, 1) + POINT.z * MAT(2, 2) + MAT(2, 3)
RES.INFO = POINT.INFO
POINT_TRANSFORM = RES
End Function
Function ARRAY_from_string(S As String) As Double()
Dim ARR() As Double
Dim ROWS() As String
Dim COLS() As String
ROWS = split(S, vbLf)
COLS = split(ROWS(0), vbTab)
ReDim ARR(UBound(ROWS), UBound(COLS))
For I = LBound(ROWS) To UBound(ROWS)
COLS = split(ROWS(I), vbTab)
For j = LBound(COLS) To UBound(COLS)
ARR(I, j) = val(COLS(j))
Next
Next
ARRAY_from_string = ARR
End Function
Function ARRAY_to_string(MAT() As Double) As String
Dim out As New cStringBuilder
For I = LBound(MAT, 1) To UBound(MAT, 1)
For j = LBound(MAT, 2) To UBound(MAT, 2)
out.Append (Trim(str((MAT(I, j)))))
If j <> UBound(MAT, 2) Then out.Append vbTab
Next
If I <> UBound(MAT, 1) Then out.Append vbLf
Next
ARRAY_to_string = out.toString
End Function
Sub block_matrix_recursive(BLOCKREF As AcadBlockReference, c As Long, MAT() As Double, INV() As Double, DICT As DICTIONARY_VBA, SM As String, SI As String)
Dim layertext As String
Dim BNAME As String
Dim block As AcadBlock
Dim ENTITY As AcadEntity
Dim M() As Double
Dim I() As Double
BNAME = BLOCKREF.NAME
If DICT.Exists(BLOCKREF.NAME) Then Exit Sub
DICT.Add BLOCKREF.NAME, BNAME
'debug.print BNAME, c, Blockref.HANDLE, Blockref.effectivename
If c = 0 Then
Call entity_get_matrix(BLOCKREF.HANDLE, MAT(), INV())
Call Entity_Set_EXT(BLOCKREF, "MAT", "")
Call Entity_Set_EXT(BLOCKREF, "INV", "")
Call Entity_Set_EXT(BLOCKREF, "MAT_PRD", "")
Call Entity_Set_EXT(BLOCKREF, "INV_PRD", "")
SM = ARRAY_to_string(MAT)
SI = ARRAY_to_string(INV)
Else
Call entity_get_matrix(BLOCKREF.HANDLE, M(), I())
SM = SM & vbCr & ARRAY_to_string(M)
SI = SI & vbCr & ARRAY_to_string(I)
'note: the multiply order is important A*B <> B*A !
MAT = MatrixProduct(MAT, M) 'to be checked if it doesnt has to be (M,MAT)
INV = MatrixProduct(I, INV) 'working the new matrix has to be multiply with the existing one
End If
c = c + 1
Call Entity_Set_EXT(BLOCKREF, "MAT", SM)
Call Entity_Set_EXT(BLOCKREF, "INV", SI)
Call Entity_Set_EXT(BLOCKREF, "MAT_PRD", ARRAY_to_string(MAT))
Call Entity_Set_EXT(BLOCKREF, "INV_PRD", ARRAY_to_string(INV))
Set block = ThisDrawing.BLOCKS.ITEM(BNAME)
For Each ENTITY In block
If ENTITY.objectname = "AcDbBlockReference" Then
Set BLOCKREF = ENTITY
If ENTITY.objectname = "AcDbBlockReference" Then
Call block_matrix_recursive(BLOCKREF, c, MAT, INV, DICT, SM, SI)
End If
End If
Next
End Sub
Sub entity_get_matrix(HANDLE, MAT() As Double, INV() As Double)
Dim tmatrix As New slope64.matrix
tmatrix.HANDLE = HANDLE
tmatrix.init_matrix
Dim I As Long
ReDim MAT(0 To 3, 0 To 3) As Double
ReDim INV(0 To 3, 0 To 3) As Double
I = 0
MAT(0, 0) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(0, 1) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(0, 2) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(0, 3) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(1, 0) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(1, 1) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(1, 2) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(1, 3) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(2, 0) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(2, 1) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(2, 2) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(2, 3) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(3, 0) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(3, 1) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(3, 2) = tmatrix.get_block_transform_matrix(I): I = I + 1
MAT(3, 3) = tmatrix.get_block_transform_matrix(I): I = I + 1
I = 0
INV(0, 0) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(0, 1) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(0, 2) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(0, 3) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(1, 0) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(1, 1) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(1, 2) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(1, 3) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(2, 0) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(2, 1) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(2, 2) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(2, 3) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(3, 0) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(3, 1) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(3, 2) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
INV(3, 3) = tmatrix.get_block_transform_matrix_inverse(I): I = I + 1
End Sub
VB.NET Erweiterung - Steinigt mich mir egal !:
Option Compare Text
Option Strict Off
Imports System.IO
Imports AcadApplication = Autodesk.AutoCAD.ApplicationServices.Application
Imports AcadDocument = Autodesk.AutoCAD.ApplicationServices.Document
Imports AcadWindows = Autodesk.AutoCAD.Windows
Imports acApp = Autodesk.AutoCAD.ApplicationServices.Application
Imports AcWindowsNS = Autodesk.AutoCAD.Windows
'Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Runtime
Imports MgdAcApplication = Autodesk.AutoCAD.ApplicationServices.Application
Imports MgdAcDocument = Autodesk.AutoCAD.ApplicationServices.Document
Imports MgdAcDB = Autodesk.AutoCAD.ApplicationServices.DatabaseExtension
Imports VB6 = Microsoft.VisualBasic
Imports VB7 = Microsoft.VisualBasic
Imports WIN32 = Microsoft.Win32
Imports Microsoft.VisualBasic
Imports System.Runtime.InteropServices
Imports System.Text
Imports Microsoft.Win32
Imports Autodesk.AutoCAD.Geometry
<ComClass(MATRIX.ClassId, MATRIX.InterfaceId, MATRIX.EventsId)>
Public Class MATRIX
#Region "COM-GUIDs"
' Diese GUIDs stellen die COM-Identität für diese Klasse
' und ihre COM-Schnittstellen bereit. Wenn Sie sie ändern, können vorhandene
' Clients nicht mehr auf die Klasse zugreifen.
Public Const ClassId As String = "cdc7e7ed-c096-4d67-bef1-6c6a6cc73c0b"
Public Const InterfaceId As String = "5c3ac512-0f92-4c5a-b32f-c4b43996ab4e"
Public Const EventsId As String = "293d685c-2bb1-46ce-a9a0-515740f9c21e"
#End Region
' Eine erstellbare COM-Klasse muss eine Public Sub New()
' ohne Parameter aufweisen. Andernfalls wird die Klasse
' nicht in der COM-Registrierung registriert und kann nicht
' über CreateObject erstellt werden.
Public Sub New()
MyBase.New()
End Sub
Private M_Block_Name As String
Private M_Block_Handle As String
Private p_mat(15) As Double
Private p_inv(15) As Double
Private P_Handle As String
Public Property Handle As String
Get
Return P_Handle
End Get
Set
P_Handle = Value
End Set
End Property
Public Function init_matrix() As String
If Len(P_Handle) = 0 Then Exit Function
Dim db As Autodesk.AutoCAD.DatabaseServices.Database = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database
Dim ln As Long = Convert.ToInt64(P_Handle, 16) ' Not create a Handle from the long integer
Dim hn As Handle = New Handle(ln) ' And attempt to get an ObjectId for the Handle
Dim OID As ObjectId = db.GetObjectId(False, hn, 0)
'Dim db As Autodesk.AutoCAD.DatabaseServices.Database = HostApplicationServices.WorkingDatabase
'Dim ed As Editor = MgdAcApplication.DocumentManager.MdiActiveDocument.Editor
Dim i As Long
For i = 0 To 15
p_mat(i) = 0
p_inv(i) = 0
Next
Try
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim ent As BlockReference = CType(tr.GetObject(OID, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), BlockReference)
Dim mat As Matrix3d = ent.BlockTransform
Dim inv As Matrix3d = ent.BlockTransform.Inverse()
p_mat = mat.ToArray()
p_inv = inv.ToArray()
tr.Commit()
End Using
Catch ex As System.Exception
'ed.WriteMessage(ex.ToString())
End Try
End Function
Public Function get_block_transform_matrix(i As Long) As Double
Return p_mat(i)
End Function
Public Function get_block_transform_matrix_inverse(i As Long) As Double
Return p_inv(i)
End Function
end class
------------------
Wer es nicht versucht, hat schon verlorn
Und bei 3 Typos gibts den vierten gratis !
<<< not for sale !
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP