;| acmFields2Text

Löst alle ausgewählten Schriftfelder in normale Texte auf

Plattform: ab AutoCAD 2024

Copyright
Markus Hoffmann, www.CADmaro.de

Juni 2025
|;
(defun c:acm-Fields2Text (/ ss lObjects)
  (mx:Init)
  (prompt "\nSchriftfelder wählen: ")
  (if
    (setq ss (ssget '((0 . "ATT*,DIM*,INSERT,*LEADER,*TEXT"))))
     (progn
       (setq lObjects
              (mapcar
                'vlax-ename->vla-object
                (mx:SelectionSet->EList ss)
              )
       )
       (mapcar
         '(lambda (o / oBlk)
            (if
              (mx:IsField? o)
               (mx:Object2Text o)
               (if
                 ;; wenn es ein Insert ist
                 (and
                   (= "AcDbBlockReference" (vla-get-ObjectName o))
                   (not (vlax-property-available-p o 'Path))
                 )
                  (progn
                    ;; Attribute
                    (if (= :vlax-true (vla-get-HasAttributes o))
                      (mapcar
                        'mx:Object2Text
                        (vlax-safearray->list
                          (vlax-variant-value
                            (vla-GetAttributes o)
                          )
                        )
                      )
                    )
                    ;; Blockdefinition
                    (setq oBlk (mx:GetBlockFromInsert (vla-get-Name o)))
                    (vlax-for i oBlk
                      (if
                        (mx:IsField? i)
                         (mx:Object2Text i)
                      )
                    )
                  )
               )
            )
          )
         lObjects
       )
       (vla-regen oAD acActiveViewport)
     )
  )
  (mx:Reset)
  (princ)
)

 ;|
mx:IsField?

enthält das übergebene Objekt ein Schriftfeld,
wird das Schriftfeldobjekt zurückgegeben, sonst NIL
|;
(defun mx:IsField? (o / result)
  (if
    (and
      (= :vlax-true (vla-get-HasExtensionDictionary o))
      (not
        (vl-catch-all-error-p
          (setq
            result
             (vl-catch-all-apply
               'vlax-invoke-method
               (list
                 (vla-GetExtensionDictionary o)
                 'Item
                 "Acad_field"
               )
             )
          )
        )
      )
    )
     (vla-item result 0)
  )
)

 ;| mx:Object2Text

Schriftfeld eines VLA-Objekts in Text umwandeln
|;
(defun mx:Object2Text (o / s)
  (if
    (and
      (setq s
             (cond
               ((vlax-property-available-p o 'TextString)
                (vla-get-TextString o)
               )
               ((vlax-property-available-p o 'TextOverride)
                (vla-get-TextOverride o)
               )
               ('T nil)
             )
      )
      (= :vlax-true (vla-get-HasExtensionDictionary o))
    )
     (cond
       ((vlax-property-available-p o 'TextString)
        (vla-put-TextString o " ")
        (vla-put-TextString o s)
       )
       ((vlax-property-available-p o 'TextOverride)
        (vla-put-TextOverride o " ")
        (vla-put-TextOverride o s)
       )
       ('T nil)
     )
  )
)

 ;| mx:GetBlockFromInsert

Gibt den Block eines gewählten Inserts aus
|;
(defun mx:GetBlockFromInsert (s / oBlk)
  (if
    (not
      (vl-catch-all-error-p
        (setq oBlk
               (vl-catch-all-apply
                 'vla-item
                 (list
                   (vla-get-Blocks
                     oAD
                   )
                   s
                 )
               )
        )
      )
    )
     s
  )
  oBlk
)

 ;| mx:SelectionSet->EList

Auswahlsatz in Liste umwandeln
|;
(defun mx:SelectionSet->EList (ss / c lst)
  (repeat
    (setq c (sslength ss))
     (setq lst
            (cons
              (ssname ss (setq c (1- c)))
              lst
            )
     )
  )
)

 ;| mx:Init

Initialisierung
|;
(defun mx:Init ()
  (vl-load-com)
  (setq oAD
         (vlax-get-property
           (vlax-get-acad-object)
           'ActiveDocument
         )
  )
  (setq oBlx
         (vlax-get-property
           oAD
           'Blocks
         )
  )
  (setq oLyts
         (vlax-get-property
           oAD
           'Layouts
         )
  )
  (setq iECHO (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq errorMX *error*
        *error* mx:Error
  )
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-invoke-method oAD 'StartUndomark)
)

 ;| mx:Reset

Zurücksetzen
|;
(defun mx:Reset ()
  (setvar "CMDECHO" iECHO)
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-release-object oAD)
  (setq *error* errorMX)
  (mapcar
    '(lambda (arg)
       (set
         arg
         'nil
       )
     )
    (list
      'errorMX 'iECHO 'oBlx 'oLyts 'oAD)
  )
)

 ;| mx:Error

Errorfunktion
|;
(defun mx:Error (s)
  (print (strcat "Fehler " s))
  (command-s)
  (command-s "_.undo" "_back")
  (mx:Reset)
  (princ)
)

;;; Kurzbefehl
(defun c:acmF2T () (c:acm-Fields2Text))

;; Feedback beim Laden
(princ
  "\nacm-Fields2Text.lsp wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
Start mit \"acmF2T\" oder \"acm-Fields2Text\"."
)
(princ)