| |
 | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Blöcke nummerieren (926 mal gelesen)
|
usocher Mitglied
 Beiträge: 3 Registriert: 23.05.2020
|
erstellt am: 23. Mai. 2020 17:32 <-- editieren / zitieren --> Unities abgeben:         
Ich mochte mit einem VBA-Programm Blöcke durchnummerieren Der Blockname ist bekannt Der Text für die Nummer ist als Attribut im Block deffiniert z.B. BlockNr Die Nummerierung soll auf einem bekannten Layer in x-Richtung erfolgen Ist das möglich?
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadffm Ehrenmitglied V.I.P. h.c. 良い精神

 Beiträge: 21533 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 23. Mai. 2020 19:23 <-- editieren / zitieren --> Unities abgeben:          Nur für usocher
Hallo, das ist möglich, wie so ziemlich alle Objektmanipulationen. Durch durchläufst den Modellbereich (oder wo auch immer die Objekte zum bearbeiten sind), prüfst ob es eine Blockreferenz ist, prüfst ob der EFFECTIVENAME dem gesuchten Blocknamen entspricht, liest die Attribute der Blockreferenz aus, falls vorhanden und änderst dann den TextString des Attributes. Zugleich kannst du dann den Layer des Attributes ändern. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin

 Beiträge: 2624 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 24. Mai. 2020 17:05 <-- editieren / zitieren --> Unities abgeben:          Nur für usocher
Hallo usocher, Willkommen im Forum Wie cadffm schon schrieb ist das relativ einfach. Die Frage ist, was bedeutet: "Die Nummerierung soll auf einem bekannten Layer in x-Richtung erfolgen" ? und wie gut kennst Du Dich in VBA (für Autocad) aus? Wenn Du nur bestimmte Blockreferenzen auf einem bestimmten Layer brauchst, würde ich hier vorab einen SelectionsSet mit den beiden Kriterien machen. Diesen kannst Du dann in einer zweiten Liste nach den X-Werten aufsteigend sortieren lassen und danach die Attribute ändern. BlockReference.EffektiveName kann man verwenden, wäre aber nur bei dynamischen Blöcken notwendig Für normale Blöcke kann man auch einfach BlockReference.Name verwenden. Grüße Klaus Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
usocher Mitglied
 Beiträge: 3 Registriert: 23.05.2020
|
erstellt am: 25. Mai. 2020 18:24 <-- editieren / zitieren --> Unities abgeben:         
|
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin

 Beiträge: 2624 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 26. Mai. 2020 16:16 <-- editieren / zitieren --> Unities abgeben:          Nur für usocher
Hi, Beispielprojekte gäbe es viele wenn man die richtigen Suchbegriffe eingibt Nachdem ich aber zu faul zum suchen bin habe ich hier mal schnell eine Variante codiert Die oberen Zeilen mußt Du für Dich anpassen - Gesucht werden alle Blöcke mit einem definierten Namen auf einem definierten Layer - das angegebene Attribut wird neu beschrieben (von 1 bis .. durchnummeriert) Wenn Du etwas anderes brauchst, mußt Du das klarer definieren Code:
Sub BlockNummer() Dim BlockName As String Dim AttName As String Dim LayName As String BlockName = "BLOCK_1" ' <<< hier Blockname in Großbuchstaben AttName = "BLOCKNR" ' <<< hier Attributnamen sind immer Großbuchstaben LayName = "Block_Texte" ' <<< hier Layername der durchsucht werden soll, auf diesem befindet sich der Block Dim d() As Integer ' in diesem Feld wird sortiert Dim dMax As Integer Dim L As Integer, L2 As Integer, L3 As Integer Dim SSet1 As AcadSelectionSet Dim ssMode As Integer Dim oBlockRef As AcadBlockReference Dim oAttDef As Variant ' Definieren der Filter Dim FilterType(2) As Integer Dim FilterData(2) As Variant FilterType(0) = 0: FilterData(0) = "Insert" ' Blöcke FilterType(1) = 2: FilterData(1) = BlockName ' Blockname siehe oben FilterType(2) = 8: FilterData(2) = LayName ' Layername siehe oben ' Bereinigen des Selectionsets falls nötig On Error Resume Next Set SSet1 = Nothing ThisDrawing.SelectionSets.Item("SS1").Delete On Error GoTo 0 ' Definieren des Selectionsets Set SSet1 = ThisDrawing.SelectionSets.Add("SS1") ssMode = acSelectionSetAll SSet1.Select ssMode, , , FilterType, FilterData If SSet1.Count > 0 Then ' Gibts es überhaupt Werte ? dAkt = 0 dMax = SSet1.Count - 1 ReDim d(dMax) As Integer For L = 0 To dMax ' If SSet1(L).ObjectName = "AcDbBlockReference" Then ' wäre nicht nötig Set oBlockRef = SSet1(L) vx = oBlockRef.InsertionPoint(0) If L > 0 Then ' Vergleich Einfügepunkt For L2 = L To 1 Step -1 Set oBlockRef = SSet1(d(L2 - 1)) If vx < oBlockRef.InsertionPoint(0) Then ' aktueller Wert ist kleiner wie letzter Vergleichswert ' vorhandene Werte nach hinten schieben d(L2) = d(L2 - 1) Else ' aktuellen Wert einfügen d(L2) = L ' Vergleich beenden Exit For End If ' vx < SSet1 Next L2 If L2 = 0 Then ' einfügen als ersten Wert d(L2) = L End If Else ' ersten Wert setzen d(0) = L End If ' L > 0 Then End If ' SSet1(L).ObjectName Next L ' ' evtl Liste für Kontrolle ausgeben ' For L = 0 To dMax ' Set oBlockRef = SSet1(d(L)) ' Debug.Print oBlockRef.InsertionPoint(0) ' Next L ' Blöcke nummerieren For L = 0 To dMax ' oder SSet1.Count - 1 If SSet1(d(L)).ObjectName = "AcDbBlockReference" Then Set oBlockRef = SSet1(d(L)) If oBlockRef.HasAttributes Then oAttDef = oBlockRef.GetAttributes For L2 = LBound(oAttDef) To UBound(oAttDef) If oAttDef(L2).TagString = AttName Then oAttDef(L2).TextString = L + 1 ' oAttDef(L2).Layer = "MeinLayer" ' << falls das Attribut auf einem anderen Layer liegen soll Exit For End If Next L2 End If ' oBlockRef.HasAttributes End If ' SSet1(d(L)).ObjectName Next L End If ' SSet1.Count > 0 Then MsgBox "Bearbeitung beendet" End Sub
Grüße Klaus Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
usocher Mitglied
 Beiträge: 3 Registriert: 23.05.2020
|
erstellt am: 27. Mai. 2020 13:42 <-- editieren / zitieren --> Unities abgeben:         
|