---

Hallo,

ist es eigentlich schwierig nach bestimmten Textteilen in einem Layernamen zu suchen.
Ich würde ein Programm benötigen welches z.b: alle Objekte in der Zeichnung markiert welche im Layernamen z.B. F30 stehen haben.
Muss ich dafür jeden Layernamen in unterschiedlichste Teile zerlegen und immer wieder mit dem gesuchten Textteil vergleichen?
Oder gibts für sowas schon eine fertige Funktion?

Grüsse Marco

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

---

Hi,

dafür wurde der LIKE -Vergleich eingeführt. 

"ABCD" LIKE "*BC*" ==> TRUE

Und wenn Du ein SelectionSet baust, dann kannst Du auch Sterne (und Fragezeichen) als Platzhalter verwenden.

Code:

---

Public Sub test()
  Dim tSSet As AcadSelectionSet
  On Error Resume Next
  Set tSSet = ThisDrawing.SelectionSets.Add("mySelSet")
  if Err.Number <> 0 then
    Set tSSet = ThisDrawing.SelectionSets("mySelSet")
    tSSet.Clear
  end if
  Dim tDxfCodes(0) As Integer: tDxfCodes(0) = 8            '8 für DXFCode-Layername
  Dim tDxfValues(0) As Variant: tDxfValues(0) = "*F30*"    'nur Layer mit F30 als Teil des Layernamens suchen
  tSSet.Select acSelectionSetAll, , , tDxfCodes, tDxfValues
  'und da hast Du alle Elemente im SelectionSet
End Sub

---

- alfred -

------------------
www.hollaus.at

---

In de Expresstools befände sich z.B. der Befehl SSX, der auch eine Auswahl nach Layer mit Platzhaltersuche bietet.

Code:

---

Befehl: SSX
Select object <None>:
Enter filter option [Blockname/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector]: La
>>Enter layer name to add <RETURN to remove>: *F30*
Current filter: ((8 . "*F30*"))
Enter filter option [Blockname/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector]:
3 found.

---

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

[Diese Nachricht wurde von CAD-Huebner am 22. Feb. 2011 editiert.]

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

---

die Zeile in der Befehlzeile oder auf einen Button macht das auch ... ist aber Lisp   

(sssetfirst nil (ssget "_x" (list(cons 410 (getvar "CTAB"))(cons 8 "*F30*"))))

------------------
       - Thomas -          
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

@CADmium
Perfekt, hat sofort funktioniert

@CAD-Huebner
Danke!

@Alfred
Danke, ich wollte das 1:1 übernehmen und habs im VBA in ein neues Modul eingefügt. Dann im ACAD unter Makro ausführen gestartet.
Es passiert aber leider nichts. Habe ich ev. schon wieder die selben Probleme wie vorher ???

Danke

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

---

Hi,

meines macht nur ein SelectionSet, also holt sich alle Objekte in die Variable tSSet.
Ich habe im obigen Code ja dann nichts damit gemacht, also siehst Du auch keine Auswirkung.

Welche Auswirkung hättest Du gerne? Nur markieren? Dann bist Du mit CADmiums LISP-Zeile am schnellsten (wobei vorsicht, dieses filtert nur im [EDIT] im aktuellen Layout/Modellbereich [/EDIT]! Nicht in allen Bereichen (Modellbereich und Layouts), musst Du bei Bedarf umbauen, siehe Code 410).

Wenn Du die Objekte auf andere Layer legen willst, löschen willst, umfärben willst, .... dann geht das mit

Code:

---

Dim tEnt as AcadEntity
For Each tEnt in tSSet
  'hier hast Du dann das Element in der Hand, um was damit zu machen
  'z.B. auf Layer 0 legen (gaaaanz böse ;) ):
  tEnt.Layer = "0"
Next

---

- alfred -

------------------
www.hollaus.at

[Diese Nachricht wurde von a.n. am 22. Feb. 2011 editiert.]

---

@Cadmium
Hallo,
wie müsste ich den das in eine LSP speichern damit ich das als Befehl verwenden kann (LAden mit APPLOAD)
und er mich zuvor nach dem gesuchten Text abfragt?

Ist das aufwendig?

Danke und Grüsse Marco

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

---

@alfred.
Achso ist das.
Ich würd gern beide Varianten verwenden.
Deine Variante ist Ausbaufähig, damit kann ich später noch weiterarbeiten.
Was müsst ich noch schreiben das er in deiner Variante die Objekte im ACAD markiert?

Danke und Grüsse Marco

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

---

(defun C:LAYSEARCH(/ PATTERN)
  (setq PATTERN (getstring "\nSuchtext: "))
  (sssetfirst nil (ssget "_x" (list(cons 410 (getvar "CTAB"))(cons 8 (strcat "*"SUCHTEXT"*")))))
)

in eine Textdatei mit Endung lsp  stellt dir nach dem Laden den Befehl LAYSEARCH zur Verfügung ...

------------------
  - Thomas -          
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Hallo,

es kommt leider die Meldung

Code:

---

; Fehler: Fehlerhafter Argumenttyp: stringp nil

---

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

---

Hi,

>> Was müsst ich noch schreiben das er in deiner Variante die Objekte im ACAD markiert?

Markieren (so wie anklicken, sprich die Griffe sind da) geht im VBA nicht, da kannst Du eigentlich nur von VBA aus das LISP zusammensetzen und per SendCommand schicken.

Wenn jedoch ein Highlight reichtm dann:

Code:

---

Call tEnt.Highlight(True)

---

- alfred -

PS: oben hab ich Blödsinn geschrieben (wegen 'nur Modellbereich'..., sorry CADmium ), hab's schon editiert

------------------
www.hollaus.at

---

ja sorry ..muss heißen

(defun C:LAYSEARCH(/ PATTERN)
  (setq PATTERN (getstring "\nSuchtext: "))
  (sssetfirst nil (ssget "_x" (list(cons 410 (getvar "CTAB"))(cons 8 (strcat "*" PATTERN "*")))))
)

------------------
  - Thomas -          
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Das Ist echt spitze. Danke!!

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

---

$Hallo,
$ich möchte folgendes Programm erstellen:
$Von in der Zeichnung gewählten Objekten (mittels Fenster vorab markiert) soll er diejenigen heraussuchen die im Layer einen
$bestimmten Textstring aufweisen. Wenn nichts gewählt wurde nimmt er die gesamte Zeichnung.
$Die gefilterten Objekte soll er dann Kopieren. Die Entfernung soll man per Mausklick bestimmen.
$Und zu Beginn müsste die Abfrage kommen nach welchen Textstring er suchen soll.

$Ich möchte hier Schritt für Schritt im Code ergänzen.
$Zur Zeit habe ich das Problem das er die gefundenen Objekte nicht um die voreingestellten 2 Einheiten kopiert.
$Sieht jemand meinen Fehler?

Code:

---

Public Sub Lay_copy()
  Dim tSSet As AcadSelectionSet
  On Error Resume Next
  Set tSSet = ThisDrawing.SelectionSets.Add("mySelSet")
  If Err.Number <> 0 Then
    Set tSSet = ThisDrawing.SelectionSets("mySelSet")
    tSSet.Clear
  End If
  Dim tDxfCodes(0) As Integer: tDxfCodes(0) = 8            '8 für DXFCode-Layername
  Dim tDxfValues(0) As Variant: tDxfValues(0) = "*AAA*"    'nur Layer mit AAA als Teil des Layernamens suchen
  tSSet.Select acSelectionSetAll, , , tDxfCodes, tDxfValues
  'und da hast Du alle Elemente im SelectionSet

'  Call tEnt.Highlight(True)
    Dim copytSSet As AcadSelectionSet
    Set copytSSet = tSSet.Copy()

    Dim point1(0 To 2) As Double
    Dim point2(0 To 2) As Double
    point1(0) = 0: point1(1) = 0: point1(2) = 0
    point2(0) = 2: point2(1) = 0: point2(2) = 0
    copytSSet.Move point1, point2

End Sub

---

$Grüsse Marco

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