Hi,
Da du in einem VBA Forum gelandet bist einige Lösungsvorschläge in VBA.
1.) Alles was man mit Formularen in VB6 oder irgendeinem VBA veranstalten kann funktioniert auch in Autocad.
2.) Texte mit Variablen vorzubelegen geht, ist aber trickreich. Hintergrund ist einfach, das man ja die Textfelder erst selektieren muß um zu wissen in was man hineinschreiben / auslesen möchte.
Sogenannte HANDLES verändern sich von Zeichnung zu Zeichnun, taugen also nicht dazu.
Ich hab da gerade so ein ähnliches Problem (Templatesystem) und gehe das wie folgt an.
Ich erzeuge für jeden Text ein ACADDICTIONARY also ein extension Dictionary.
In diesem Dictionary schreibe ich den Textnamen , Das Texttemplate und die Eingabeaufforderungen für ggf lokale Variablen hinein. In deinem Falle dürfte es reichen Den Texten eine eindeutige Kennung zu geben. Diese ACADDictionarys überleben auch beim kopieren zwischen verscheidenen Zeichnungen.
Das Anklatschen von XDATA ist keine allzu gute Idee. Die überleben ein AUDIT ggf nur noch verkrüppelt. Glaub die werden bei 200 Zeichen abgeschnitten. Kann man ausprobieren, wenn die Länge langt aber...
Nun kann man diese Texte addressieren. Schlimmstenfalls läuft man einmal durch die Zeichnung und baut einen Index für die vorhandenen Namen auf. Ich mach soetwas geren mit den Windows scripting dictionarys. KEY=Textidentifyer und Value = HANDLE zu dem Textobjekt.
Somit lässt sich jedes Textelement über das Dictionary eindeutig ansprechen und der Inhalt ändern. Ewas programmcode zum spielen hab ich angehängt. Ich meine in einem meiner letzten Posts hab ich mich auch übder Dictionarys ausgelassen. Wenn nicht hier noch einmal fragen.
Das durchlaufen der Zeichnung um den Index aufzubauen geht selbst mittels Holzhammermethode rasend schenll. Eleganter ist eine Auswahl mit einem Selektionsetfilter. Man kann auch den Index in ein ACAD dictionary schreiben. Muß man dann aber pflegen - oder neu aufbauen... Da ist mir die Scripting Dictionary Methode lieber.
Gruß
Thomas
Function Entity_Set_EXT(Entity As AcadEntity, TAG As String, value As String) As Boolean
Entity_Set_EXT = False
Dim DICT As AcadDictionary
Dim RECORD As AcadXRecord
Const TYPE_STRING = 1
Set DICT = Entity.GetExtensionDictionary
On Error Resume Next
err.Clear
Set RECORD = DICT.GetObject(TAG)
If err.number <> 0 Then
Set RECORD = DICT.AddXRecord(TAG)
End If
On Error GoTo 0
RECORD.TranslateIDs = True
err.Clear
ArraySize = 0
Dim XRecordDataType As Variant
Dim XRecordData As Variant
ReDim XRecordDataType(0 To ArraySize) As Integer
ReDim XRecordData(0 To ArraySize) As Variant
XRecordDataType(0) = 1000
XRecordData(0) = value
Call RECORD.SetXRecordData(XRecordDataType, XRecordData)
'RECORD.GetXRecordData XRecordDataType, XRecordData
If err.number = 0 Then Entity_Set_EXT = True
End Function
Function Entity_Get_EXT(Entity As AcadEntity, TAG As String, value As String)
Entity_Get_EXT = False
Dim DICT As AcadDictionary
Dim RECORD As AcadXRecord
ArraySize = 0
Dim XRecordDataType As Variant
Dim XRecordData As Variant
' ReDim XRecordDataType(0 To ArraySize) As Integer
' ReDim XRecordData(0 To ArraySize) As Variant
If Entity.HASEXTENSIONDICTIONARY Then
err.Clear
On Error Resume Next
Set DICT = Entity.GetExtensionDictionary
' For i = 0 To dict.count - 1
' On Error GoTo 0
' Set RECORD = dict.ITEM(i)
'
' RECORD.GetXRecordData XRecordDataType, XRecordData
'
'
' Value = XRecordData(0)
' ' debug.print RECORD.Name, Value
' Next
Set RECORD = DICT.GetObject(TAG)
RECORD.GetXRecordData XRecordDataType, XRecordData
value = XRecordData(0)
On Error GoTo 0
If err.number = 0 Then Entity_Get_EXT = True
End If
End Function
Sub Entity_clone_dict(Src As AcadEntity, dest As AcadEntity)
Dim KEY As Variant
Dim TYP As Variant
Dim DAT As Variant
Dim SRC_RECORD As AcadXRecord
Dim DESR_RECORD As AcadXRecord
Dim S As String
Dim D As String
Dim i As Long
If Not Src.HASEXTENSIONDICTIONARY Then Exit Sub
err.Clear
On Error Resume Next
Set DICT = Src.GetExtensionDictionary
Set dic2 = dest.GetExtensionDictionary
KEY = DICT.keys
For i = 0 To DICT.count - 1
Set SRC_RECORD = DICT.ITEM(CStr(KEY(i)))
KEY = SRC_RECORD.name
SRC_RECORD.GetXRecordData TYP, DAT
S = KEY
D = DAT(0)
Call Entity_Set_EXT(dest, S, D)
' On Error Resume Next
' err.Clear
' Set DEST_RECORD = dict2.GetObject(KEY)
' If err.Number <> 0 Then
' Set DEST_RECORD = dict2.AddXRecord(KEY)
' End If
' On Error GoTo 0
'
' ' debug.print TYP(0), DAT(0)
' Call DEST_RECORD.SetXRecordData(TYP, DAT)
Next
' debug.print err.desc
End Sub
Function DRAWING_Set_DICT(dictname As String, TAG As String, value As String) As Boolean
DRAWING_Set_DICT = False
Dim DICT As AcadDictionary
Dim RECORD As AcadXRecord
Const TYPE_STRING = 1
err.Clear
On Error Resume Next
Set DICT = ThisDrawing.Dictionaries(dictname)
If err.number <> 0 Then
err.Clear
Set DICT = ThisDrawing.Dictionaries.Add(dictname)
End If
If err.number <> 0 Then Exit Function
On Error GoTo 0
On Error Resume Next
err.Clear
Set RECORD = DICT.GetObject(TAG)
If err.number <> 0 Then
Set RECORD = DICT.AddXRecord(TAG)
End If
On Error GoTo 0
RECORD.TranslateIDs = True
err.Clear
ArraySize = 0
Dim XRecordDataType As Variant
Dim XRecordData As Variant
ReDim XRecordDataType(0 To ArraySize) As Integer
ReDim XRecordData(0 To ArraySize) As Variant
XRecordDataType(0) = 1000
XRecordData(0) = value
Call RECORD.SetXRecordData(XRecordDataType, XRecordData)
'RECORD.GetXRecordData XRecordDataType, XRecordData
If err.number = 0 Then DRAWING_Set_DICT = True
End Function
Function DRAWING_Get_DICT(dictname As String, TAG As String, value As String) As Boolean
DRAWING_Get_DICT = False
Dim DICT As AcadDictionary
Dim RECORD As AcadXRecord
ArraySize = 0
Dim XRecordDataType As Variant
Dim XRecordData As Variant
' ReDim XRecordDataType(0 To ArraySize) As Integer
' ReDim XRecordData(0 To ArraySize) As Variant
err.Clear
On Error Resume Next
Set DICT = ThisDrawing.Dictionaries(dictname)
Set RECORD = DICT.GetObject(TAG)
RECORD.GetXRecordData XRecordDataType, XRecordData
value = XRecordData(0)
On Error GoTo 0
If err.number = 0 Then DRAWING_Get_DICT = True
End Function
Sub testextdat()
Dim Entity As AcadEntity
Dim value As String
Dim solid As Acad3DSolid
For i = 1 To 1024
S = S & "aB"
Next
For Each Entity In ThisDrawing.modelspace
Call Entity_Set_EXT(Entity, "TEST", Entity.HANDLE & S)
Call Entity_Get_EXT(Entity, "TEST", value)
' debug.print Len(VALUE), VALUE
Next
End Sub
------------------
Wer es nicht versucht, hat schon verlorn
Und bei 3 Typos gibts den vierten gratis !
<<< for sale !
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP