---

Hallo zusammen,
Ich möchte von einer Zeichnung eine Linenfarbe filtern (RGB:0,154,205).
Nun möchte ich die Linienstärke dieser Auswahl ändern.
Ich möchte das mit VBA-Code lösen, da es mehrere Zeichnung betrifft.
Kann mir dabei jemand helfen?

mfg
Bernhard

------------------
Gruß, Bernhard F.

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

---

Ich habs geschaft, dass ich die auswahl funktioniert und das die Liniestärke geändert wird.
Nur bräuchte ich eine RGB Farbe.

Code:

    Dim Code(0 To 0) As Integer
    Dim Daten(0 To 0) As Variant

    On Error Resume Next
    acDoc.SelectionSets("select01").Delete
    On Error GoTo 0
    Set ss = acDoc.SelectionSets.Add("select01")
 
    Code(0) = 0
    Daten(0) = "LINE"
    Code(0) = 62
    Daten(0) = 1    Hier bräuchte ich diesen Farbcode '  Farbe = "0,154,205"

    ss.Select acSelectionSetAll, , , Code, Daten
   
    acDoc.SendCommand ("(setq ssetLine (ssget ""_p""))") & vbCr
   
    acDoc.SendCommand "ÄNDERN !ssetLine " & vbCr & "E" & vbCr & "LS" & vbCr & "0.1" & vbCr & vbCr

Kann mir da vielleich jemand weiterhelfen?

------------------
Gruß, Bernhard F.

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

---

Hallo Bernhard,

Farbauswahl mit Truecolor ist ein wenig tricky, da der DXF-Code 62 nur Indexfarben verwendet. D.h. Du mußt für die gewünschte RGB-Farbe erst die Indexfarbe bestimmen.
Aber so sollte es gehen:

Code:

---

Sub Farbauswahl()
    ' Dim Daten(0 To 0) As Variant
    Dim SS As AcadSelectionSet
    Dim Daten(0 To 1) As Variant
    Dim Code(0 To 1) As Integer
    Dim Farbe As AcadAcCmColor
    Dim Ent As AcadObject
    Dim oLine As AcadLine

    On Error Resume Next
    ' acDoc.SelectionSets("select01").Delete
    ThisDrawing.SelectionSets("select01").Delete
    On Error GoTo 0
    ' Set ss = acDoc.SelectionSets.Add("select01")
    Set SS = ThisDrawing.SelectionSets.Add("select01")
    ' Festlegen der Farbe
      ' Üblicherweise würde man das über das GetInterfaceObject machen aber da kann sich
      ' je nach Autocad Version die letzte Nummer ändern, deshalb mach ich das einfach mit new
    ' Set Farbe = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16") ' Standardaufruf
    Set Farbe = New AcadAcCmColor   ' vereinfachter Aufruf
    Call Farbe.SetRGB(0, 154, 205)  ' <= Hier die RGB-Farben eintragen
    Code(0) = 0
    Daten(0) = "LINE"
    Code(1) = 62
    ' Daten(1) = Farbe.EntityColor   ' Hier bräuchte ich diesen Farbcode '  Farbe = "0,154,205"
    Daten(1) = Farbe.ColorIndex   ' Filter verwendet nur Indexfarben

    SS.Select acSelectionSetAll, , , Code, Daten
    ' Warum hier Code mischen (Lisp, Befehlszeile)? Wenn man einfach VBA verwenden kann ...
    ' acDoc.SendCommand ("(setq ssetLine (ssget ""_p""))") & vbCr
    ' acDoc.SendCommand "ÄNDERN !ssetLine " & vbCr & "E" & vbCr & "LS" & vbCr & "0.1" & vbCr & vbCr
    ' => Hat das funktioniert? Linienstärke 0.1 ist eigentlich nicht definiert und müßte auf 0.09 geändert worden sein ...
    If SS.Count > 0 Then
      For Each Ent In SS
        If Ent.ObjectName = "AcDbLine" Then  ' Müßte man nicht so kompliziert machen, aber
                                             ' falls man unterschiedliche Objekte verwendet / sucht ist das manchmal nötig
          Set oLine = Ent
          ' oLine.Lineweight = acLnWt200  ' Hier entweder Konstante eintragen (sicherer) oder Wert 200 (2.00[mm])
          oLine.Lineweight = acLnWt009   ' für Wert 0.09 mm, 0.1 ist nicht definiert
          oLine.Update
        End If
      Next Ent
    End If
    SS.Clear
    SS.Delete
End Sub

---

Grüße
Klaus  

[Diese Nachricht wurde von KlaK am 02. Dez. 2020 editiert.]

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

---

Da wir hier ja von der DXF-ähnlichen Struktur sprechen und der Filter (dessen Kriterien)
dann sicher mit meinen Kenntnissen über DXF/Lisp übereinstimmen:

Farbbuch und TrueColor Informationen sind wie auch die ACI-Farbwerte direkt am Objekt gespeichert im DXF
und können auch über einen SelectionSet gefiltert werden, im Fall von Truecolor liegt der Farbwert allerdings
nicht in der Form r,g,b vor, sondern als Integer.
Und wenn man noch bedenkt dass es auch Farbbuch-Farben mit dem gleichen rgb Wert geben kann,
dann muß ausschließen dass Objekte mit Farbbuch-Farb Information haben.

Es geht um DXF Code 420 und (und Farbbuch ist in 430 gespeichert)
Wen es genauer interessiert kann die Suche bemühen oder die Hilfe,
ich zeige hier einfach nur einen "dummen" Weg auf die Schnelle.

Erstelle eine Objekt mit der gewünschten TC Farbe, Frage den TC-Wert ab: (cdr(assoc 420 (entget(car(entsel)))))
dies ist der Integer für deinen RGB-Wert und zugleich der Wert in der Filterlist für DXF Code 420.

Dazu filtert man noch nach DXF Code 430 mit dem (string)Wert "", also kein Zeilen lang.

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

---

Integer für RGB-Wert dürfte nicht ausreichen 
Größtmöglicher Wert (255,255,255) = 16.777.215
In VBA geht der Integerbereich nur bis 32.767, da muß man schon Long verwenden

Aber klar kann man das auch mit DXF Code 420 machen, auch ohne vorher das Objekt abzufragen.

Code:

---

    LRed = 0
    LGreen = 154
    LBlue = 205
    FarbNr = LRed * 256 * 256 + LGreen * 256 + LBlue
    Code(1) = 420
    Daten(1) = FarbNr

---

Grüße
Klaus 

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

---

Auch ein Long ist ein Integer,
in DXF(Format) gibt es keinen Unterschied zwischen 16 und 32bit Integer.
[EDIT: für VBA-Neulinge die sich Versuchen wollen aber bestimmt ein guter Hinweis, U's sind unterwegs]

Daher fühle ich mich weiterhin wohl mit meiner Antwort  

(und wie angesprochen, den 430er würde ich noch mit in den Filter nehmen mit "")

 

[Diese Nachricht wurde von cadffm am 03. Dez. 2020 editiert.]

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

---

Hallo Klaus,
Danke für die Lösung.
Gibt es beim Update der Linien ev. eine schnellere Lösung. Bei vielen Linien dauert der durchlauf sehr lange?
----------------------------------------------------------------
    SS.Select acSelectionSetAll, , , Code, Daten
    ' Warum hier Code mischen (Lisp, Befehlszeile)? Wenn man einfach VBA verwenden kann ...
    ' acDoc.SendCommand ("(setq ssetLine (ssget ""_p""))") & vbCr
    ' acDoc.SendCommand "ÄNDERN !ssetLine " & vbCr & "E" & vbCr & "LS" & vbCr & "0.1" & vbCr & vbCr
    ' => Hat das funktioniert? Linienstärke 0.1 ist eigentlich nicht definiert und müßte auf 0.09 geändert worden sein ...
    If SS.Count > 0 Then
      For Each Ent In SS
        If Ent.ObjectName = "AcDbLine" Then  ' Müßte man nicht so kompliziert machen, aber
                                            ' falls man unterschiedliche Objekte verwendet / sucht ist das manchmal nötig
          Set oLine = Ent
          ' oLine.Lineweight = acLnWt200  ' Hier entweder Konstante eintragen (sicherer) oder Wert 200 (2.00[mm])
          oLine.Lineweight = acLnWt009  ' für Wert 0.09 mm, 0.1 ist nicht definiert
          oLine.Update
        End If
      Next Ent
    End If
----------------------------------------------------------------

------------------
Gruß, Bernhard F.

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

---

Wozu hast du denn noch die If- Schleife darin, werf raus das Ding, oder aber den ändern-Sendcommand.
Entscheid dich (oder lasse die Stopuhr entscheiden

Und nimm einen gültigen Linienstärken-Wert.

If SS.Count > 0 Then
      For Each Ent In SS
        If Ent.ObjectName = "AcDbLine" Then  ' Müßte man nicht so kompliziert machen, aber
                                            ' falls man unterschiedliche Objekte verwendet / sucht ist das manchmal nötig
          Set oLine = Ent
          ' oLine.Lineweight = acLnWt200  ' Hier entweder Konstante eintragen (sicherer) oder Wert 200 (2.00[mm])
          oLine.Lineweight = acLnWt009  ' für Wert 0.09 mm, 0.1 ist nicht definiert
          oLine.Update
        End If
      Next Ent
    End If

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

---

Hallo Bernhard,

Was heißt bei vielen Linien dauert es sehr lange? Wie viele Elemente hast du denn?

Und wie schon geschrieben, die zweite IF Ent.ObjectName - Abfrage braucht man eigentlich nicht, wenn nur Standardwerte geändert werden.
Aber wenn Du z.B. Koordinaten änderst (z.B. Z-Werte) hat eine LW-Polyline einen anderen Aufbau als die 3D-Polyline oder ein Kreis, Linie, ...

Und das sofortige Update kann man am Ende durch ein regen ersetzen

Code:

---

    SS.Select acSelectionSetAll, , , Code, Daten
    If SS.Count > 0 Then
      For Each Ent In SS
          Ent.Lineweight = acLnWt009  ' für Wert 0.09 mm, 0.1 ist nicht definiert
      Next Ent
    End If

---

@cadffm: Der Apostrophe am Zeilenanfang ist das Kommentarzeichen, der ändern-Sendcommand wird gar nicht ausgeführt. Hatte ihn nur stehenlassen damit man sieht was verändert wurde.

Grüße
Klaus   

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

---

Hallo Klaus,

Naja, es können schon bis zu 5000 und mehr Linen sein und wenn ich dann 10 bis 20 Pläne durchlaufen lasse dann nimmt das ziemlich viel Zeit in anspruch. Wenn es keine andere Lösung gibt, dann muss ich mich damit abfinden weil es ja eh funktioniert.
Ich hab die IF Ent.ObjectName - Abfrage raus genommen, weil wirklich nur Standardwerte geändert werden.

Nochmals danke für deine Lösungsansätze.

------------------
Gruß, Bernhard F.

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

---

5000 Linie allein sind lächerlich, da solltest du prüfen was wirklich so lange dauert.

Die nativen AutoCAD Befehle Änderung und EigÄndr schaffen so grob um die 100000 Linien pro Sekunde,
oder anders, benötigen nur 0.05sec für 5000 Linien
Eine einfache Zeile Lisp verarbeitet 5000 Linien in 0.3sec, 100000 in 6sec

Bedeutet: Der eigentlich (Zeit)Aufwand sollte beim Öffnen und speichern der Dateien liegen, nicht beim ändern der Objekte.

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

---

Wie cadffm schon schrieb, 5000 Linien sind gar nichts. Das sollte schon flott gehen.
Ist natürlich auch die Frage wie Dein restlicher Code aussieht. Wenn Du dort auch viel über SendCommand arbeitest könnte das natürlich die Bremse sein.
Ich hab Programme bei denen erzeuge ich einzelne Zeichnungen neu incl. Layout und pdf-Plot, wenn die bei 700 Zeichnungen dann mal eine Stunde brauchen - ok aber so kleine Projekte ...
Welche Größe haben denn die dwg selber? (wegen Öffnen und Speichern)
Oft hilft es auch wenn man gelegentlich den PC (oder zumindest Autocad) neu startet. Oder Du machst das in Bricscad (hat nicht so einen großen Überhang wie Autocad   )

Grüße
Klaus  

[Edit] Habe gerade einen Plan bearbeitet mit 257.000 Elementen, Farben ändern und Layer verschieben. Hat gerade mal 2,7 sec. gedauert (Bricscad V21)

[Diese Nachricht wurde von KlaK am 04. Dez. 2020 editiert.]

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

---

Hallo
habe das mit diesem Code ausgeführt
Testweise bei 8214 Elementen dauert das bei mir 42sec.
Code:
Sub Farbauswahl()

  Dim oBriCad As AcadApplication
  Dim ThisDrawing As Object
 
  Set oBriCad = GetObject(, "BricscadApp.AcadApplication")
  Set ThisDrawing = oBriCad.ActiveDocument

    Dim ss As AcadSelectionSet
    Dim Daten(0 To 0) As Variant  '    Dim Daten(0 To 1) As Variant

    Dim Code(0 To 0) As Integer    '  Dim Code(0 To 1) As Integer

    Dim Farbe As AcadAcCmColor
    Dim Ent As AcadObject
    Dim oLine As AcadLine

    On Error Resume Next
    ThisDrawing.SelectionSets("select01").Delete
    On Error GoTo 0
    Set ss = ThisDrawing.SelectionSets.Add("select01")
    Set Farbe = oBriCad.GetInterfaceObject("BricscadDb.AcadAcCmColor.20.0") ' Standardaufruf
    Call Farbe.SetRGB(0, 154, 205)  ' <= Hier die RGB-Farben eintragen
    Code(0) = 0
    Daten(0) = "LINE"
    Code(0) = 62
    Daten(0) = Farbe.ColorIndex  ' Filter verwendet nur Indexfarben

    ss.Select acSelectionSetAll, , , Code, Daten
  Debug.Print "Entities: " & str(ss.Count)
    If ss.Count > 0 Then
      For Each Ent In ss
        If Ent.ObjectName = "AcDbLine" Then  ' Müßte man nicht so kompliziert machen, aber
                                            ' falls man unterschiedliche Objekte verwendet / sucht ist das manchmal nötig
          Set oLine = Ent
          oLine.LineWeight = acLnWt200  ' Hier entweder Konstante eintragen (sicherer) oder Wert 200 (2.00[mm])
          oLine.Update
        End If
      Next Ent
    End If
    ss.Clear
    ss.Delete
  Debug.Print "Fertig!"
End Sub

------------------
Gruß, Bernhard F.

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

---

Beispiel-DWG mit Zeitangabe für diesen geposteten Code?

Und wie lange dauer der sendcommand Weg?

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

---

Habe es mit Sendcommand probiert und mit folgenden Code.
Da hat bei 12708 Elementen das ganze mal 0.2sec gedauert.

Code:

---

Sub Farbauswahl_Sendcommand()

  Dim oBriCad As AcadApplication
  Dim ThisDrawing As Object
  Dim Farbe As AcadAcCmColor
 
  Set oBriCad = GetObject(, "BricscadApp.AcadApplication")
  Set ThisDrawing = oBriCad.ActiveDocument
 
  Set Farbe = oBriCad.GetInterfaceObject("BricscadDb.AcadAcCmColor.20.0") ' Standardaufruf
  Call Farbe.SetRGB(0, 154, 205)  ' <= Hier die RGB-Farben eintragen
 
  ThisDrawing.SendCommand "_SELECT EIG f " & Farbe.ColorIndex & "  "
 
  ThisDrawing.SendCommand "ÄNDERN _p E LS 1.00  "
 
  Debug.Print "Fertig!"
End Sub

---

------------------
Gruß, Bernhard F.

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

---

Dann mache daraus jetzt noch 0.9 statt 1.0 daraus und das Ziel ist zunächst errecht.

Unabhängig davon könntest du nun auf die Suche nach dem PerformanceProblems bei
der Änderung per API gehen.

Da zu würde ich mit eine neuen leeren Datei testen (in der du einfach mal 1000-10000 Linien erstellst).
Das ganze vielleicht auch mal als Admin ohne Virenscanner und Co.

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

---

Hallo Bernhard,

Was mich an Deinem Code wundert:
- Warum definierst Du oBriCad as AcadApplication?

- Warum definierst Du ThisDrawing as Object?
ThisDrawing ist bereits vordefiniert (die aktuelle Zeichnung)

- Hast Du mal ohne dem Linienobjekt und ohne oLine.update getestet?
Welches Ergebnis?

Grüße
Klaus 

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

---

Zitat:

---

Original erstellt von Bernhard F.:
Habe es mit Sendcommand probiert und mit folgenden Code.
Da hat bei 12708 Elementen das ganze mal 0.2sec gedauert.

---

Und wie viele Elemente waren in der Auswahl / wurden geändert?

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

---

Habe "Option Explicit" entfernt jetzt muss oBricad und ThisDrawing nicht mehr definiert werden.
Habe auch Linienobjekt und oLine.update entfernt.
Ich habs nochmal mit 86796 Elementen probiert. Die waren Ausgewählt und wurden auch geändert.

Bei diesem Code wird ja alles auf einmal ausgewählt und geändert.
hier hat es 17sec gedauert

Code:

---

  ThisDrawing.SendCommand "_SELECT EIG f " & Farbe.ColorIndex & "  "

  ThisDrawing.SendCommand "ÄNDERN _p LS 0.9  "

---

Bei diesem Code wird jedes einzelne Eelement durchlaufen und geändert.
hier hat es über eine halbe Stunde.

Code:

---

  For Each Ent In ss
    Ent.LineWeight = acLnWt200
  Next Ent

---

------------------
Gruß, Bernhard F.

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

---

Hallo Bernhard,

Danke für die Info, werde das am Montag mal testen.
Du verwendest Bricscad V20? Mein letzter Test war mit V21, die ja angeblicher schneller sein soll.

Grüße
Klaus 

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