Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  Lisp zur Übernahme benannter Attribut werte als Schriftfeld in Multiführungslinie

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
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Lisp zur Übernahme benannter Attribut werte als Schriftfeld in Multiführungslinie (1101 mal gelesen)
Kuschelfee
Mitglied
Bauzeichnerin


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

Beiträge: 186
Registriert: 07.05.2007

erstellt am: 11. Apr. 2021 11: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


BILD1-ML_210411.PNG


BILD2-ML_210411.PNG


ML-LispDWG.zip

 
Ich verwende seit Ende 2015 eine angepasste Version "Lee Mac" Lisp zum Beschriften von Blöcken mit Multiführungslinien.

Den Command Befehl hatte ich damals gewählt, weil bei mir in der ursprünglichen Version das Absetzen der Mleader fehlerhaft war und ich dies nicht korrigiert bekam.
(siehe Bild 1 Rote Linie markiert 2. Pkt außerdem ist der Text in der MFührung immer linksbündig...)
Mit 2 Attributen war die kein Problem und hat auch immer funktioniert (Bild 2)

Nun wollte ich gerne anstatt 2 Attribute 5 in die Multiführungslinie übergeben und da will das mit dem command Befehl nicht mehr klappen. Die Multiführungslinie wird erstellt der Text aber nicht übernommen.
Was übersehe ich.


Code:
(defun c:mlba5 ( / at1 at2 at3 at4 at5 ent enx ins lst mld pnt )

      ;;;--------------------Layer
    (setvar "cmdecho" 0)
  (setq cln (getvar "clayer"))
  (command-s "_.-layer" "_make" "T__TEXT" "")
(setvar "cmdecho" 1)
 

    ;;;--------------------Block wählen

     (while
       (progn
           (setvar 'errno 0)
           (setq ent (car (entsel "\nWähle Block <Abbruch>: ")))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nNichts gewählt, Versuch es nochmal.")
               )
               (   (null ent)
                   nil
               )
               (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
                   (princ "\nObject ist kein Block.")
               )
               (   (/= 1 (cdr (assoc 66 enx)))
                   (princ "\nBlock hat keine Attribute.")
               )
               (   (not
                       (and
                           (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                                 lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
                           )
                            (setq at1 (cdr (assoc "NR." lst)))
                            (setq at2 (cdr (assoc "BEZEICHNUNG"  lst)))
    (setq at3 (cdr (assoc "PROFIL"  lst)))
    (setq at4 (cdr (assoc "GÜTE"  lst)))
    (setq at5 (cdr (assoc "ABMESSUNG"  lst)))
                       )
                   )
                   (princ "\
  \nFalscher Block, mind. ein Attribut
  \n( NR. - BEZEICHNUNG - PROFIL - GÜTE )
  \nnicht im Block enthalten.
  ")
               )
               (   (and
                       (= "" (vla-get-textstring at1))
                       (= "" (vla-get-textstring at2))
(= "" (vla-get-textstring at3))
(= "" (vla-get-textstring at4))
(= "" (vla-get-textstring at5))
                   )
                   (princ "\nBeide Attribute sind leer.")
               )
               (  


    ;;;--------------------Punkte wählen
  (setq lpt1 (getpoint "\nPosition für Führungslinienpfeilspitze angeben..: "))
  (setq lpt2 (getpoint lpt1 "\nNächsten Punkt zeigen..: "))

    ;;;--------------------Multiführungslinie erstellen


(setvar "cmdecho" 0)
    (command-s "_mleader" "_options" "_maxpoints" "2" "_exit" lpt1 lpt2

                       (strcat
                           (if (= "" (vla-get-textstring at1))
                               ""
                               (strcat
                                   "%<\\AcObjProp Object(%<\\_ObjId "
                                   (LM:ObjectID at1)
                                   ">%).TextString>%"
                                   (if (= "" (vla-get-textstring at2)) "" "\n")
                               )
                           )
                           (if (= "" (vla-get-textstring at2))
                               ""
                               (strcat
                                   "%<\\AcObjProp Object(%<\\_ObjId "
                                   (LM:ObjectID at2)
                                   ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at3)) "" "\n")
                                )
                            )
    (if (= "" (vla-get-textstring at3))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at3)
                                    ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at4)) "" ", ")
                                )
                            )
    (if (= "" (vla-get-textstring at4))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at4)
                                    ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at5)) "" "\n")
                                )
                            )
                            (if (= "" (vla-get-textstring at5))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at5)
                                    ">%).TextString>%"
                               )
                           )
                       )
                   )
)
               )
           )
       )
   
  (setvar "clayer" cln)
(setvar "cmdecho" 1)
   (princ)
)
 
;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
 
(defun LM:ObjectID ( obj )
   (eval
       (list 'defun 'LM:ObjectID '( obj )
           (if
               (and
                   (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                   (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
               )
               (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
              '(itoa (vla-get-objectid obj))
           )
       )
   )
   (LM:ObjectID obj)
)
 
;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)
 
(vl-load-com) (princ)


in Zip-Datei:
mlba5.lsp = umgearbeitet auf 5 Attribute (CODE)
mlb2.lsp = Lee Mac Version nur auf 5 Attribute ergänzt (Bild 1)
mlba_alt.lsp = Meine alte Lisp für 2 Attribute (Bild 2)
Zeichnung_ML-210411.dwg = Zeichnung mit Testblock der die 5 Attribute enthält

[Diese Nachricht wurde von Kuschelfee am 12. Apr. 2021 editiert.]

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

joern bosse
Ehrenmitglied
Dipl.-Ing. Vermessung


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

Beiträge: 1734
Registriert: 11.10.2004

Window 10
ACAD 2021
CIVIL 2021
BricsCAD V14-V22
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050<P>

erstellt am: 12. Apr. 2021 08:15    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 Kuschelfee 10 Unities + Antwort hilfreich

Hallo Kuschelfee,
ich konnte Deine Schilderung nachvollziehen. Warum der Text nicht angeschrieben wird weiß ich nicht, aber vielleicht erstellst Du die MFührung erstmal mit einem Leerstring und im Nachgang wird dieser mit VLA-PUT-TEXTSTRING gefüllt:

Code:

(setvar "cmdecho" 0)
    (command-s "_mleader" "_options" "_maxpoints" "2" "_exit" lpt1 lpt2 "")
  (vla-put-textstring (vlax-ename->vla-object(entlast))
                       (strcat
                           (if (= "" (vla-get-textstring at1))
                               ""
...



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

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

Bosse_tools-Überblick

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

Kuschelfee
Mitglied
Bauzeichnerin


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

Beiträge: 186
Registriert: 07.05.2007

erstellt am: 12. Apr. 2021 09:41    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


MF_210412.JPG

 
Danke damit funktioniert es schonmal.
Habe noch Regenerieren ergänzt.

Code:

(defun c:mlba5 ( / at1 at2 at3 at4 at5 ent enx ins lst mld pnt )

      ;;;--------------------Layer
    (setvar "cmdecho" 0)
  (setq cln (getvar "clayer"))
  (command-s "_.-layer" "_make" "T__TEXT" "")
(setvar "cmdecho" 1)
 

    ;;;--------------------Block wählen

     (while
       (progn
           (setvar 'errno 0)
           (setq ent (car (entsel "\nWähle Block <Abbruch>: ")))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nNichts gewählt, Versuch es nochmal.")
               )
               (   (null ent)
                   nil
               )
               (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
                   (princ "\nObject ist kein Block.")
               )
               (   (/= 1 (cdr (assoc 66 enx)))
                   (princ "\nBlock hat keine Attribute.")
               )
               (   (not
                       (and
                           (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                                 lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
                           )
                            (setq at1 (cdr (assoc "NR." lst)))
                            (setq at2 (cdr (assoc "BEZEICHNUNG"  lst)))
    (setq at3 (cdr (assoc "PROFIL"  lst)))
    (setq at4 (cdr (assoc "GÜTE"  lst)))
    (setq at5 (cdr (assoc "ABMESSUNG"  lst)))
                       )
                   )
                   (princ "\
  \nFalscher Block, mind. ein Attribut
  \n( NR. - BEZEICHNUNG - PROFIL - GÜTE )
  \nnicht im Block enthalten.
  ")
               )
               (   (and
                       (= "" (vla-get-textstring at1))
                       (= "" (vla-get-textstring at2))
(= "" (vla-get-textstring at3))
(= "" (vla-get-textstring at4))
(= "" (vla-get-textstring at5))
                   )
                   (princ "\nBeide Attribute sind leer.")
               )
               (  


    ;;;--------------------Punkte wählen
  (setq lpt1 (getpoint "\nPosition für Führungslinienpfeilspitze angeben..: "))
  (setq lpt2 (getpoint lpt1 "\nNächsten Punkt zeigen..: "))

    ;;;--------------------Multiführungslinie erstellen


(setvar "cmdecho" 0)
    (command-s "_mleader" "_options" "_maxpoints" "2" "_exit" lpt1 lpt2 "")

(vla-put-textstring (vlax-ename->vla-object(entlast))
                      (strcat
                          (if (= "" (vla-get-textstring at1))
                               ""
                               (strcat
                                   "%<\\AcObjProp Object(%<\\_ObjId "
                                   (LM:ObjectID at1)
                                   ">%).TextString>%"
                                   (if (= "" (vla-get-textstring at2)) "" "\n")
                               )
                           )
                           (if (= "" (vla-get-textstring at2))
                               ""
                               (strcat
                                   "%<\\AcObjProp Object(%<\\_ObjId "
                                   (LM:ObjectID at2)
                                   ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at3)) "" "\n")
                                )
                            )
    (if (= "" (vla-get-textstring at3))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at3)
                                    ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at4)) "" ", ")
                                )
                            )
    (if (= "" (vla-get-textstring at4))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at4)
                                    ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at5)) "" "\n")
                                )
                            )
                            (if (= "" (vla-get-textstring at5))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at5)
                                    ">%).TextString>%"
                               )
                           )
                       )
                   )
)
               )
           )
       )
   (vla-Regen(vla-get-activedocument(vlax-get-acad-object))acAllViewports)
  (setvar "clayer" cln)
(setvar "cmdecho" 1)
   (princ)
)
 
;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
 
(defun LM:ObjectID ( obj )
   (eval
       (list 'defun 'LM:ObjectID '( obj )
           (if
               (and
                   (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                   (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
               )
               (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
              '(itoa (vla-get-objectid obj))
           )
       )
   )
   (LM:ObjectID obj)
)
 
;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)
 
(vl-load-com) (princ)



Leider ist eins der alten Probleme nun wieder da.
Wenn die MFührung links abgesetzt wird verhüpft  nun der Text siehe Bild.
Rechts ist es OK.

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

joern bosse
Ehrenmitglied
Dipl.-Ing. Vermessung


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

Beiträge: 1734
Registriert: 11.10.2004

Window 10
ACAD 2021
CIVIL 2021
BricsCAD V14-V22
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050<P>

erstellt am: 12. Apr. 2021 10:22    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 Kuschelfee 10 Unities + Antwort hilfreich

Hallo Kuschelfee,
das Problem ist wohl, dass die Größe des MTextes aus der Multiführung durch die Zeichenfolge bestimmt wird, nach dem Regenieren wird mehr Platz benötigt, wenn die Textfeld-Makros ausgewertet werden.

Daher folgender Vorschlag:
1. temporären MText erstellen mit Deiner Zeichenfolge
2. Regenerieren, dadurch werden die Textfeld-Makros ausgewertet und der Text wird in seiner ganzen Größe dargestellt
3. Command MultiLeader, den Textwert aus dem temporären MText verwenden
4. temporären MText löschen

Bei mir hatte es funktioniert, habe jetzt aber keine Zeit mehr, bau mal Folgendes in Deinen Code, müßte funktionieren:

Code:

  ;;;--------------------Multiführungslinie erstellen


  ;;;1. temporären MText erstellen mit den Schriftfelder-Anweisungen
  (setq vla-obj(vla-addMtext(vla-get-modelspace
      (vla-get-activedocument
(vlax-get-acad-object)))
  (vlax-3D-Point '(0 0 0))
  1.0
  (strcat
                           (if (= "" (vla-get-textstring at1))
                               ""
                               (strcat
                                   "%<\\AcObjProp Object(%<\\_ObjId "
                                   (LM:ObjectID at1)
                                   ">%).TextString>%"
                                   (if (= "" (vla-get-textstring at2)) "" "\n")
                               )
                           )
                           (if (= "" (vla-get-textstring at2))
                               ""
                               (strcat
                                   "%<\\AcObjProp Object(%<\\_ObjId "
                                   (LM:ObjectID at2)
                                   ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at3)) "" "\n")
                                )
                            )
    (if (= "" (vla-get-textstring at3))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at3)
                                    ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at4)) "" ", ")
                                )
                            )
    (if (= "" (vla-get-textstring at4))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at4)
                                    ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at5)) "" "\n")
                                )
                            )
                            (if (= "" (vla-get-textstring at5))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at5)
                                    ">%).TextString>%"
                               )
                           )
                       )
  )
)

    ;;;2. Regenerieren, die Schriftfeld-Makros "werden zu Texten"
    (vla-regen (vla-get-activedocument
  (vlax-get-acad-object))acActiveViewport)
(setvar "cmdecho" 0)
    ;;;3. Command mit dem Textinhalt des temporären MTextes
    (command-s "_mleader" "_options" "_maxpoints" "2" "_exit" lpt1 lpt2 (vla-get-TextString vla-obj))

    ;;;4. Temporären MText wieder löschen
(vla-delete vla-obj)


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

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

Bosse_tools-Überblick

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

Kuschelfee
Mitglied
Bauzeichnerin


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

Beiträge: 186
Registriert: 07.05.2007

erstellt am: 12. Apr. 2021 10:51    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

Schöne Idee, nur leider verliert man bei dieser Variante die Schriftfelder.

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

joern bosse
Ehrenmitglied
Dipl.-Ing. Vermessung


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

Beiträge: 1734
Registriert: 11.10.2004

Window 10
ACAD 2021
CIVIL 2021
BricsCAD V14-V22
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050<P>

erstellt am: 12. Apr. 2021 15:33    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 Kuschelfee 10 Unities + Antwort hilfreich

Hallo Kuschelfee,
einen Versuch habe ich noch. Folgender Grundgedanke: der Textfeld-String wird auf den temporären Text angebracht, mit REGEN aktualisiert. Dieser Textwert wird beim Command-Multileader verwendet, damit sind dann die Größenverhältnisse durch den Text vorgegeben. Dann wird die Koordiante aus dem Gruppencode 10 in einer Variablen gespeichert.
Jetzt wird der Textfeld-String direkt auf den Multileader angebracht, dann mit REGEN aktualisiert. Weil bei der Aktualisierung die Positionierung kaputt geht wird abschließend die Koordinate des Gruppencodes 10 wieder angebracht, d.h. die verschobende Position nachträglich wieder korrigiert.
Ziemlich von hinten durch die Brust ins Auge würde ich sagen, bei mir hat es funktioniert.

Code:

;*************************************************************************************
;  mlba5.lsp K. A. Kubat / 04.2021
;  erstellt eine Multiführungslinie mit Schriftfeldbezug
;  zu folgenden Attributen eines Blockes
;  NR.
;  BEZEICHNUNG
;  PROFIL, GÜTE
;  ABMESSUNG
;  Layer: T__TEXT
;*************************************************************************************

(defun c:mlba5 ( / at1 at2 at3 at4 at5 ent enx ins lst mld pnt )

      ;;;--------------------Layer
    (setvar "cmdecho" 0)
  (setq cln (getvar "clayer"))
  (command-s "_.-layer" "_make" "T__TEXT" "")
(setvar "cmdecho" 1)
 

    ;;;--------------------Block wählen

     (while
       (progn
           (setvar 'errno 0)
           (setq ent (car (entsel "\nWähle Block <Abbruch>: ")))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nNichts gewählt, Versuch es nochmal.")
               )
               (   (null ent)
                   nil
               )
               (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
                   (princ "\nObject ist kein Block.")
               )
               (   (/= 1 (cdr (assoc 66 enx)))
                   (princ "\nBlock hat keine Attribute.")
               )
               (   (not
                       (and
                           (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                                 lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
                           )
                            (setq at1 (cdr (assoc "NR." lst)))
                            (setq at2 (cdr (assoc "BEZEICHNUNG"  lst)))
    (setq at3 (cdr (assoc "PROFIL"  lst)))
    (setq at4 (cdr (assoc "GÜTE"  lst)))
    (setq at5 (cdr (assoc "ABMESSUNG"  lst)))
                       )
                   )
                   (princ "\
  \nFalscher Block, mind. ein Attribut
  \n( NR. - BEZEICHNUNG - PROFIL - GÜTE )
  \nnicht im Block enthalten.
  ")
               )
               (   (and
                       (= "" (vla-get-textstring at1))
                       (= "" (vla-get-textstring at2))
(= "" (vla-get-textstring at3))
(= "" (vla-get-textstring at4))
(= "" (vla-get-textstring at5))
                   )
                   (princ "\nBeide Attribute sind leer.")
               )
               (  


    ;;;--------------------Punkte wählen
  (setq lpt1 (getpoint "\nPosition für Führungslinienpfeilspitze angeben..: "))
  (setq lpt2 (getpoint lpt1 "\nNächsten Punkt zeigen..: "))

    ;;;--------------------Multiführungslinie erstellen

  ;;;1. temporären vla-Text erstellen mit Schriftfeld-STring
  (setq vla-obj(vla-addMtext(vla-get-modelspace
      (vla-get-activedocument
(vlax-get-acad-object)))
  (vlax-3D-Point '(0 0 0))
  1.0
(mlba5:TextString AT1 AT2 AT3 AT4 AT5)
  )
)

   
    ;;;2. Schriftfelder in vla-Text mit REGEN aktualisieren
    (vla-regen (vla-get-activedocument
  (vlax-get-acad-object))acActiveViewport)
(setvar "cmdecho" 0)
    ;;;3. Command-Mleader mit Textwert aus temporären vl-Text
    (command-s "_mleader" "_options" "_maxpoints" "2" "_exit" lpt1 lpt2

      (vla-get-TextString vla-obj))

    ;;;;4. GruppencodeListe für spätere Wiederherstellung GC 10
    (setq liste (entget(entlast)))
      ;;;5. vla-Multileader: Schriftfeld-String einfügen
      (vla-put-Textstring (vlax-ename->vla-object (entlast))(mlba5:TextString AT1 AT2 AT3 AT4 AT5))


;;;6. Schriftfelder in vla-Multilaeder mit REGEN aktualisieren
(vla-regen (vla-get-activedocument
  (vlax-get-acad-object))acActiveViewport)
   
                ;;;7. Gruppencodeliste, Koordinate in GC 10 wieder auf alten Wert setzen
(entmod(subst (assoc 10 Liste)(assoc 10 (entget (entlast)))(entget(entlast))))


                ;;;8. temporären vla-Text löschen
(vla-delete vla-obj)

 
)
               )
           )
       )
   
  (setvar "clayer" cln)
(setvar "cmdecho" 1)
   (princ)
)


;;;TextString
(defun mlba5:TextString (AT1 AT2 AT3 AT4 AT5 / )
  (strcat
                           (if (= "" (vla-get-textstring at1))
                               ""
                               (strcat
                                   "%<\\AcObjProp Object(%<\\_ObjId "
                                   (LM:ObjectID at1)
                                   ">%).TextString>%"
                                   (if (= "" (vla-get-textstring at2)) "" "\n")
                               )
                           )
                           (if (= "" (vla-get-textstring at2))
                               ""
                               (strcat
                                   "%<\\AcObjProp Object(%<\\_ObjId "
                                   (LM:ObjectID at2)
                                   ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at3)) "" "\n")
                                )
                            )
    (if (= "" (vla-get-textstring at3))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at3)
                                    ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at4)) "" ", ")
                                )
                            )
    (if (= "" (vla-get-textstring at4))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at4)
                                    ">%).TextString>%"
                                    (if (= "" (vla-get-textstring at5)) "" "\n")
                                )
                            )
                            (if (= "" (vla-get-textstring at5))
                                ""
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (LM:ObjectID at5)
                                    ">%).TextString>%"
                               )
                           )
                       )
  )
 
;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
 
(defun LM:ObjectID ( obj )
   (eval
       (list 'defun 'LM:ObjectID '( obj )
           (if
               (and
                   (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                   (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
               )
               (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
              '(itoa (vla-get-objectid obj))
           )
       )
   )
   (LM:ObjectID obj)
)
 
;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)
 
(vl-load-com) (princ)


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

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

Bosse_tools-Überblick

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

Kuschelfee
Mitglied
Bauzeichnerin


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

Beiträge: 186
Registriert: 07.05.2007

erstellt am: 13. Apr. 2021 08:34    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

Super so scheint es zu funktionieren, obwohl das ja wirklich viele Umwege zum Ziel sind.
Damit kann ich aber erstmal leben und weiterarbeiten.

Danke

Verwunderlich finde ich nur, dass bei der Version mit 2 Attributen die länge des Attributwertes egal ist, dieser hüpft beim links absetzen nicht.

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

joern bosse
Ehrenmitglied
Dipl.-Ing. Vermessung


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

Beiträge: 1734
Registriert: 11.10.2004

Window 10
ACAD 2021
CIVIL 2021
BricsCAD V14-V22
Intel(R) Core(TM)i5-8250U CPU @ 1.60GHz 1.80 GHz
16.0GB RAM
NVIDIA GeForce GTX 1050<P>

erstellt am: 13. Apr. 2021 09:18    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 Kuschelfee 10 Unities + Antwort hilfreich

Hallo Kuschelfee,


Verwunderlich finde ich nur, dass bei der Version mit 2 Attributen die länge des Attributwertes egal ist, dieser hüpft beim links absetzen nicht.

Ja, das ist mir auch nicht ganz klar, was ich da zurecht gebastelt habe ist mit Sicherheit nicht der beste Weg. Aber vielleicht hat ja noch irgendwer anders hier im Forum eine Erklärung dafür.

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

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

Bosse_tools-Überblick

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)2023 CAD.de | Impressum | Datenschutz