Hot News aus dem CAD.de-Newsletter:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  Blöcke nummerieren

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   Blöcke nummerieren (120 mal gelesen)
usocher
Mitglied


Sehen Sie sich das Profil von usocher an!   Senden Sie eine Private Message an usocher  Schreiben Sie einen Gästebucheintrag für usocher

Beiträge: 3
Registriert: 23.05.2020

erstellt am: 23. Mai. 2020 17:32    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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.
良い精神



Sehen Sie sich das Profil von cadffm an!   Senden Sie eine Private Message an cadffm  Schreiben Sie einen Gästebucheintrag für cadffm

Beiträge: 19860
Registriert: 03.06.2002

System: F1
und Google

erstellt am: 23. Mai. 2020 19:23    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für usocher 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2213
Registriert: 02.05.2006

AutoCAD LandDesktop R2 bis 2004
Civil 3D 2005 - 2019
Plateia, Canalis
Visual Basic

erstellt am: 24. Mai. 2020 17:05    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für usocher 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von usocher an!   Senden Sie eine Private Message an usocher  Schreiben Sie einen Gästebucheintrag für usocher

Beiträge: 3
Registriert: 23.05.2020

erstellt am: 25. Mai. 2020 18:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Danke für die Info,
gibt es ein Beispielprojekt das ich entsprechend abändern könnte,
ich habe leider nur wenig Erfahrung mit VBA

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2213
Registriert: 02.05.2006

AutoCAD LandDesktop R2 bis 2004
Civil 3D 2005 - 2019
Plateia, Canalis
Visual Basic

erstellt am: 26. Mai. 2020 16:16    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für usocher 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von usocher an!   Senden Sie eine Private Message an usocher  Schreiben Sie einen Gästebucheintrag für usocher

Beiträge: 3
Registriert: 23.05.2020

erstellt am: 27. Mai. 2020 13:42    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Vielen herzlichen Dank.

Es funktoniert!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2020 CAD.de | Impressum | Datenschutz