;| acmTextSwapper

Textinhalt von zwei Texten vertauschen.
Unterstützt Texte, MTexte, Attribute, Attributdefinitionen, Multiführungen, Bemaßungstexte und Texte in Blöcken und Tabellen

Plattform: ab AutoCAD 2024

Copyright
Markus Hoffmann, www.CADmaro.de

März 2025
|;
(defun c:acmTextSwapper (/ o1 o2 lObject&Props1 lObject&Props2 sText1)
  (mx:Init)
  (not
    (vl-catch-all-error-p
      (vl-catch-all-apply
        (function
          vla-GetSubEntity
        )
        (list
          oADUtils
          'o1
          nil
          nil
          nil
          "\nErsten Text wählen: "
         )
      )
    )
  )
  (if
    (and
      o1
      (setq lObject&Props1 (mx:Object&TProp o1))
    )
     (progn
       (vla-Highlight
         (car lObject&Props1)
         :vlax-true
       )
       (not
         (vl-catch-all-error-p
           (vl-catch-all-apply
             (function
               vla-GetSubEntity
             )
             (list
               oADUtils         'o2              nil
               nil              nil
               "\nZweiten Text wählen: "
              )
           )
         )
       )
       (if
         (and
           o2
           (setq lObject&Props2 (mx:Object&TProp o2))
         )
          (progn
            (vla-Highlight
              (car lObject&Props2)
              :vlax-true
            )
            (setq sText1
                   (if
                     (mx:IsField? (car lObject&Props1))
                      (mx:GetFieldcode
                        (vlax-vla-object->ename
                          (car lObject&Props1)
                        )
                      )
                      (progn
                        (vl-princ-to-string
                          (vlax-get-property
                            (car lObject&Props1)
                            (if
                              (and
                                (= "TextOverride" (last lObject&Props1))
                                (= 0
                                   (strlen
                                     (vlax-get-property
                                       (car lObject&Props1)
                                       (last lObject&Props1)
                                     )
                                   )
                                )
                              )
                               "Measurement"
                               (last lObject&Props1)
                            )
                          )
                        )
                      )
                   )
            )
            (vlax-put-property
              (car lObject&Props1)
              (last lObject&Props1)
              (if
                (mx:IsField? (car lObject&Props2))
                 (mx:GetFieldcode
                   (vlax-vla-object->ename
                     (car lObject&Props2)
                   )
                 )
                 (progn
                   (vl-princ-to-string
                     (vlax-get-property
                       (car lObject&Props2)
                       (if
                         (and
                           (= "TextOverride" (last lObject&Props2))
                           (= 0
                              (strlen (vlax-get-property
                                        (car lObject&Props2)
                                        (last lObject&Props2)
                                      )
                              )
                           )
                         )
                          "Measurement"
                          (last lObject&Props2)
                       )
                     )
                   )
                 )
              )
            )
            (vlax-put-property
              (car lObject&Props2)
              (last lObject&Props2)
                 sText1
            )
            (vla-Highlight (car lObject&Props1) :vlax-false)
            (vla-Highlight (car lObject&Props2) :vlax-false)
            (vla-regen oAD acActiveViewport)
          )
          (princ "\nKein Text gewählt!")
       )
     )
     (princ "\nKein Text gewählt!")
  )
  (mx:Reset)
  (princ)
)

 ;| mx:Object&TProp

Untersucht das übergebene Objekt und gibt das korrekte Objekt und die Eigenschaft zurück,
die für Textänderungen genutzt werden muss.
|;
(defun mx:Object&TProp (o / ss l)
  (cond
    ;;
    ;; Attdef
    (
     (=
       "AcDbAttributeDefinition"
       (vla-get-ObjectName o)
     )
     (list o "TagString")
    )
    ;;
    ;; Bemaßung
    (
     (and
       (=
         "AcDbMText"
         (vla-get-ObjectName o)
       )
       (=
         "AcDbBlockTableRecord"
         (vla-get-ObjectName
           (vla-objectidtoobject
             oAD
             (vla-get-ownerid o)
           )
         )
       )
       (setq ss
              (ssget
                "_X"
                (list
                  '(0 . "DIMENSION")
                  (cons
                    2
                    (strcat
                      "`"
                      (vla-get-Name
                        (vla-objectidtoobject
                          oAD
                          (vla-get-ownerid o)
                        )
                      )
                    )
                  )
                )
              )
       )
     )
     (list (vlax-ename->vla-object (ssname ss 0)) "TextOverride")
    )
    ;;
    ;; alle anderen
    (
     (member
       (vla-get-ObjectName o)
       '("AcDbAttribute"
         "AcDbMText"
         "AcDbText"
         "AcDbLeader"
         "AcDbMLeader"
         )
     )
     (list o "TextString")
    )
  )
)

 ;|
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
         (vlax-get-property
           o
           'HasExtensionDictionary
         )
      )
      (not
        (vl-catch-all-error-p
          (setq
            result
             (vl-catch-all-apply
               'vlax-invoke-method
               (list
                 (vlax-invoke-method
                   o
                   'GetExtensionDictionary
                 )
                 'Item
                 "Acad_field"
               )
             )
          )
        )
      )
    )
     (vla-item result 0)
  )
)

 ;|
mx:GetFieldcode

Gibt die Schriftfeld-Definition als String zurück
bzw. NIL, wenn das Objekt kein Schriftfeld ist.
|;
(defun mx:GetFieldcode (ent / str)
  (if
    (member
      (cdr (assoc 0 (entget ent)))
      '("ATTRIB" "ATTDEF")
    )
     (setq attprinc
            "\nUnterstützt keine Schriftfelder in Attributen."
     )
     (vl-catch-all-error-p
       (setq str
              (vl-catch-all-apply
                'vlax-invoke-method
                (list
                  (vlax-ename->vla-object ent)
                  'FieldCode
                )
              )
       )
     )
  )
  str
)

 ;| mx:Init

Initialisierung
|;
(defun mx:Init ()
  (vl-load-com)
  (setq oAD
         (vlax-get-property
           (vlax-get-acad-object)
           'ActiveDocument
         )
  )
  (setq oADUtils
         (vlax-get-property
           oAD
           'Utility
         )
  )
  (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
      'oADUtils
      'oAD
    )
  )
)

 ;| mx:Error

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

(defun c:acmTeswa () (c:acmTextSwapper))

;; Feedback beim Laden
(princ
  "\nacmTextSwapper.lsp wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
Start mit \"acmTextSwapper\" oder \"acmTeswa\"."
)
(princ)