---

Beispiel.dwg

Hallo!

Ich versuche zur Zeit mittels Lisp ein kleines Programm zu erstellen, mit welchem ich dynamische Blöcke selektieren kann, welche alle das gleiche Attribut besitzen.
Das Attribut - bei uns "PROFILNAME" - baut sich aus dem Namen des Grundblocks und einer Bemaßung zusammen. BSP.: 58HD

Um die Blöcke optisch unterscheiden zu können, wir wir jedoch mit den Attributen, die sichtbar im Block stehen.
Die dynamischen Blöcke kommen oft in unseren Zeichnungen vor, deshalb bräuchten wir die Funktion, diese zu selektieren.
Wir benutzen bereits eine ähnliche Funktion, diese selektiert jedoch nur "nicht dynamische Blöcke".

Ich habe die aktuelle Funktion bereits umgebaut, bekomme es jedoch nicht hin, dass in den Blöcken nur nach dem Attribut mit gewissem Inhalt gesucht wird. (Dieser Code ist nur mal Versuchsweise aufgebaut, also bitte nicht wegen test Variablen erschrecken)

Hier der Code:

Code:

---

(defun BlockSelektieren_neu ( / test test1 ent BlockName ss nAnz)
  (setvar "CMDECHO" 0)
  (if (setq ent (entsel "\nBlock wählen: ")) ;; Block wählen
    (progn
      (setq test (car ent))
      (setq ent (entget (car ent)))
      (if (= (cdr (assoc 0 ent)) "INSERT")
        (progn
          (setq BlockName (get_attribute test))
  (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 66 1))))       
          ;; mir ist bewusst, dass hier nur die dynamischen Blöcke an ss übergeben werden, jedoch komm ich nicht drauf,
          ;; wie ich nur nach dem in BlockName stehenden Wert suchen kann.
          ;; muss auch dazusagen, dass ich ein Neuling bin, was lisp programmieren angeht :)
          (sssetfirst nil ss)
          (setq nAnz (sslength ss))
          (princ "\nBlockname : ") (princ BlockName) (princ "  ") (princ nAnz) (princ " x gefunden")
        )
        (alert "\nKeine Blockreferenz gewählt.Abbruch")
      )
    )
  )
  (princ)
)
(princ)

;; attribut auslesen
(defun get_attribute (test / acadObject acadDocument mSpace vlaobj e)
  (setq acadObject (vlax-get-acad-object))
  (setq acadDocument (vlax-get-property acadObject 'ActiveDocument))
  (setq mSpace (vlax-get-property acadDocument 'Modelspace))
  (setq vlaobj (vlax-ename->vla-object test))
    (setq test1(mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att)))
      (vlax-invoke vlaobj 'getattributes)    
    ))
)

---

Habe mir dann auch noch überlegt, dass es ja eigentlich egal wäre, wie das Attribut heißt.
Eigentlich würde es ja reichen, wenn man die selben dynamischen Blöcke selektiert. Also z.b. *U10.
Würde das funktionieren?
Ich glaube, dass ich schon auf dem richtigen Weg bin, jedoch finde ich nicht ganz ans Ziel. Vielleicht kann mir ja jemand von euch helfen. Wäre echt super!

Schöne Grüße
Florian

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

---

BLOCKSEARCH.zip

im Anhang mal was zum Testen ....

vielleicht hilf dir auch folgender Codeschnipsel zur Ermittlung des Blocknamens:

(or(and(vlax-property-available-p OWNER "IsDynamicBlock")
      (=(vla-get-IsDynamicBlock OWNER):vlax-true)
      (setq BLOCKNAME (vla-get-effectivename OWNER))
  )   
  (setq BLOCKNAME (vla-get-Name OWNER))
)

------------------
Also ich finde Unities gut ... und andere sicher auch
---------------------------------------
  - 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

---

Hy

schau mal ob da was dabei ist was dir hilft.

cu cw

------------------
Also ich finde Unities gut ... und andere sicher auch
------------------------------------------------
cadwomen™
Plant ist wie Öl suchen, je tiefer man bohrt desto mehr kommt ans Tageslicht

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

---

Hallo Florian,
hier ein kleiner Testcode, der entsprechend der Codeschnipsel von CADmium zusammengebaut ist.

Folgender Code selektiert alle Blockreferenzen mit dem übergebenden Blocknamen UND alle Blockreferenzen, die dynamisch sind.

Code:

---

(defun BlockSelektieren_neu:SS (BlockName / SS)
  (if(and(setq ss(ssget "_X"(list (cons 0 "INSERT")
                                  (cons 2 (strcat BlockName",`*U*")))))
        (setq ss(BlockSelektieren_neu:SS:DynamicBlocks ss BlockName)))
    ss))

---

Beim folgende Code wird ein Auswahlsatz von Blockreferenzen durchlaufen, wenn eine dynamische Blockreferenz gefunden wird, dann wird geprüft, ob der "EffectiveName" mit dem Blocknamen übereinstimmt

Code:

---

(defun BlockSelektieren_neu:SS:DynamicBlocks (ss BlockName / N SS1 VLA-OBJ)
  (setq ss1 (ssadd))
  (setq n 0)
  (repeat (sslength ss)
    (setq vla-obj (vlax-ename->vla-object(ssname ss n)))
   
    (if(and(vlax-property-available-p vla-obj 'IsDynamicBlock)
          (=(vla-get-IsDynamicBlock vla-obj):vlax-true)
          (=(strcase BlockName)
            (strcase(vla-get-EffectiveName vla-obj))))
      (ssadd(ssname ss n)ss1))

    (setq n (+ n 1)))

  (if (>(sslength ss1)0)
    ss1)
  )

---

Testfunktion:

Code:

---

(defun c:test ( / BLOCKNAME OBJ SS)
  (if (and (setq obj (car (entsel "\nBlock picken:")))
          (= "INSERT" (cdr(assoc 0(entget obj))))
          (setq BlockName (vla-get-EffectiveName
                            (vlax-ename->vla-object obj))))

    (if(setq ss (BlockSelektieren_neu:SS BlockName))
      (progn
        (alert (strcat
                "Es werden "
                (itoa (sslength ss))
                " Blöcke selektiert."))
        (sssetfirst nil ss))))
  (princ)
  )

---

------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

Liniensignaturen Youtube

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

---

Vielen Dank für den Code und die Hilfe!
Dieser liefert schon fast genau das, wonach ich gesucht habe.
Das Einzige, was ich jetzt noch schaffen muss, ist, dass, entsprechend meinem Anhang von oben nur zb. 78HD ausgewählt wird und nicht alle.

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

---

Hallo Florian,
mit folgenden Funktionen müßte es funktionieren:

Aus einem Auswahlsatz mit Blockreferenzen werden alle Objekte zurückgegeben, die dem übergebenen Attributnamen und dessen Attributwert entsprechen

Code:

---

(defun BlockSelektieren_neu:SS:AttWertPruefung (ss AttName AttWert / ATTLISTSUB N SS1 VLA-OBJ)
  (setq ss1 (ssadd))
  (setq n 0)
  (repeat (sslength ss)
    (setq vla-obj (vlax-ename->vla-object(ssname ss n)))
    (if (and (setq attListSub
                    (assoc AttName
                        (BlockSelektieren_neu:SS:AttWertPruefung:AttList vla-obj)))
            (= (vla-get-TextString(cadr attListSub))AttWert))
      (ssadd(ssname ss n)ss1))

    (setq n (+ n 1)))

  (if (>(sslength ss1)0)
    ss1)
  )

---

Aus einer Blockrefferenz eine Attributliste zurückgeben

Code:

---

(defun BlockSelektieren_neu:SS:AttWertPruefung:AttList (vla-obj / )
  (if (=(vla-get-hasattributes vla-obj):vlax-true)
    (mapcar '(lambda(A)(list(strcase(vlax-get A 'TagString))A))
      (vlax-safearray->list (vlax-variant-value(vla-getattributes vla-obj))))
    )
  )

---

die geänderte Testfunktion, es wird jetzt der Attribuwert aus dem Attribut "PROFILNAME" des gepickten Blocks berücksichtigt

Code:

---

(defun c:test ( / ATTLISTSUB ATTNAME ATTWERT BLOCKNAME OBJ SS VLA-OBJ)
  (setq AttName "PROFILNAME")
  (if (and (setq obj (car (entsel "\nBlock picken:")))
          (= "INSERT" (cdr(assoc 0(entget obj))))
          (setq BlockName (vla-get-EffectiveName
                            (vlax-ename->vla-object obj)))
          (setq vla-obj (vlax-ename->vla-object obj))
          (setq attListSub
                  (assoc AttName
                        (BlockSelektieren_neu:SS:AttWertPruefung:AttList vla-obj)))
          (setq AttWert (vla-get-TextString (cadr attListSub))))
         

    (if(and(setq ss (BlockSelektieren_neu:SS BlockName))
          (setq ss (BlockSelektieren_neu:SS:AttWertPruefung ss AttName AttWert)))
      (progn
        (alert (strcat
                "Es werden "
                (itoa (sslength ss))
                " Blöcke selektiert."))
        (sssetfirst nil ss))))
  (princ)
  )

---

viel Spaß beim ausprobieren    

------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

Liniensignaturen Youtube

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

---

Hallo Jörn,

hab den letzten Schritt aufbauend auf deine Hilfe selber auch gelöst, nur etwas anders als du. 

Auf jeden Fall macht dein Tool auch das, wonach ich gesucht habe.

Möchte dir und den andern noch mal danken, dass ihr mir geholfen habt!

SG Florian

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

---

Hallo Florian,

Zitat:

---

hab den letzten Schritt aufbauend auf deine Hilfe selber auch gelöst, nur etwas anders als du.

---

Finde ich gut, das zeigt auch, daß Du Dir selber einen Kopf machst (Copy'nPaste kann ja jeder, bringt Dich aber nicht wirklich weiter) 

------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

Liniensignaturen Youtube

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

---

Das freut mich zu hören.
Ja ich bin halt noch ziemlich am Anfang meiner Lisp Karriere. 
War mein Weg eigentlich sehr falsch wie ich ihn am Anfang eingeschlagen hatte?

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

---

Hallo Florian,
na so richtig falsch war Dein Code im Prinzip nicht, aber grundsätzlich hast Du viel mit SETQ gearbeitet, macht sicherlich jeder am Anfang (ich eingeschlossen).

Grundsätzlich ersetzt eine Funktion mit einem aussagekräftigem Namen immer eine Variable. Sie sollte im besten Fall so definiert sein, daß im Erfolgsfall der korrekte Wert zurückgegeben wird, andernfalls ein NIL. Dann kann man die Funktion mit einem IF abfragen, wenn ein NIL zurückgegeben wird passiert nichts mehr.

Im folgenden ein Beispielcode zum Linie zeichnen, bestehend aus einer Hauptfunktion, die eigentlich nur weitere Funktionen aufruft:

Code:

---

;;;Hauptfunktion Linien zeichnen
(defun c:Linien ( / PKT PKT1)
  (JB_Ini)
  (while
    (setq pkt(JB_Linie:GetPoint pkt1))
    (if pkt1
      (progn
        (JB_Linie:Entmake pkt pkt1)
        (setq pkt1 pkt)
        )
      (setq pkt1 pkt))
    )
  (JB_Reini)
  (princ))

;;;Funktion Punkte picken
(defun JB_Linie:GetPoint (pkt1 / )
  (if pkt1
    (getpoint pkt1 "\nNächster Punkt:")
    (getpoint "\nErster Punkt:")))

;;;Funktion Linien mit Entmake erstellen
(defun JB_Linie:Entmake (pkt pkt1 / )
  (entmake (list (cons 0 "LINE")
                (cons 10 pkt)
                (cons 11 pkt1))))

;;;Runktion: Initialisierung von Variablen
;;;globale Variable JB$$varis
(defun JB_Ini ( / VARI X)
  (setq JB$$varis
        (mapcar '(lambda(X)
                    (setq vari(getvar (car X)))
                    (setvar (car X)(cadr X))
                    (list (car X)vari))
          '(("OSMODE" 0)
            ("CMDECHO" 0)))))

;;;Funktion Reinitialisierung von Variablen
(defun JB_Reini ( / X)
  (mapcar '(lambda(X)
            (setvar (car X)(cadr X)))
    JB$$varis)
  (setq JB$$varis nil))
 

---

Die Funktion JB_LINIE:GETPOINT ist ein Beispiel für die direkte Auswertung der Rückgabe, in diesem Fall nicht über IF, sondern in einer WHILE-Schleife: die läuft solange, wie ein korrekter Punkt zurückgegeben wird, wenn NIL zurück kommt ist die Schleife am Ende.

Im Ansatz habe ich noch ein Bespiel für die Initiaisierung und Reinitialisierung von Variablen beigepackt, ein Programm sollte seine Umgebung nämlich immer wieder so zurücklassen, wie diese vorgefunden worden ist. Dazu gehört dann noch ein Error-Handling, das habe ich aber ausgelassen.

Zum Thema noch 2 Links:
http://www.tutorial.autolisp.info/stilfragen1.html
http://www.tutorial.autolisp.info/stilfragen2.html

Wenn Du die Stilfragen-Links ernsthaft durchgearbeitet hast, dann bist Du schon einen großen Schritt weiter.

------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

Liniensignaturen Youtube

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

---

Hallo,
also wenn man den Attributnamen kennt kann man sich das ganze durchgehangel bei den Attributen sparen und eine menge schreiberei.
hier mal ein Beispiel:

Code:

---

(setq ATT-Name "PROFILNAME")
(setq ATT-Wert "58HD")

(setq SSBLK (ssadd))
(foreach teil (mapcar 'cadr(ssnameX (ssget "x" (list (cons 0 "INSERT") (cons 66 1)))))
  (and (not (vl-catch-all-error-p (vl-catch-all-apply 'getpropertyvalue (list teil ATT-Name))))
      (= ATT-Wert(getpropertyvalue teil ATT-Name))
      (not(ssadd teil SSBLK))
  )
)
(sssetfirst nil SSBLK)

---

 

------------------
Gruß Wolfgang

Alias: Rabbit007 und Wolli1

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

---

Hallo Wolfgang,
ich erinnere mich an einen Beitrag, da hast Du auch auf die Funktionen get/set-propertyvalue verwiesen (welcher Beitrag weiß ich nicht mehr). Leider sind diese Funktionen wohl erst bei AutoCAD 2012 dazugekommen, ist das richtig? Wenn es so ist, dann "hangel" ich als Kompabilitätsgründen zu älteren AutoCAD-Versionen lieber.

------------------
viele Grüße

Jörn
http://www.bosse-engineering.com

Liniensignaturen Youtube

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

---

@Jörn,
ja die Sachen sind seit 2012 dabei und wie die VLA-* Befehle geschmacksache wie und ob man sie verwendet. Wobei du auf gewisse Weise recht hast es wirkt auch klassischer  

@all
ich hatte den falschen Code gepackt hier nochmal mit Blocknamen.

Code:

---

(setq BLK-Name "HD")
(setq ATT-Name "PROFILNAME")
(setq ATT-Wert "58HD")

(setq SSBLK (ssadd))
(foreach teil (mapcar 'cadr(ssnameX (ssget "x" (list (cons 0 "INSERT") (cons 66 1)))))
  (and (not (vl-catch-all-error-p (vl-catch-all-apply 'getpropertyvalue (list teil ATT-Name))))
      (= BLK-Name (getpropertyvalue (getpropertyvalue teil "DynamicBlockTableRecord") "Name"))
      (= ATT-Wert(getpropertyvalue teil ATT-Name))
      (not(ssadd teil SSBLK))
  )
)
(sssetfirst nil SSBLK)

---

 

------------------
Gruß Wolfgang

Alias: Rabbit007 und Wolli1

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