;| acmDAuswechseln

Ersetzt mehrere Elemente einer Zeichnung durch ein anderes.
Die gewählten Objektarten sind unerheblich.
Steuerung ist dialoggestützt.

Plattform: ab AutoCAD 2022

Copyright
Markus Hoffmann, www.CADmaro.de

Januar, 2024
|;
(defun c:acmDAuswechseln (/ ss ent ptPtofTarget ptPtofSource)
  (mx:Init)
  (if
    (setq l (DCLAuswechseln))
     (progn
       (setq ss (car l))
       (setq ent (cadr l))
       (setq ptPtofTarget (substr (last (caddr l)) 3))
       (setq ptPtofSource (substr (last (cadddr l)) 3))
       (mapcar
         '(lambda (arg / x)
            (command-s
              "_.copy"
              ent
              ""
              (mx:PtOfObj
                ptPtofSource
                (vlax-ename->vla-object ent)
              )
              (mx:PtOfObj
                ptPtofTarget
                (vlax-ename->vla-object (setq x arg))
              )
            )
            (entdel x)
          )
         (mx:SelectionSet->EList ss)
       )
     )
  )
  (mx:Reset)
  (princ)
)

 ;| 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
            )
     )
  )
  lst
)

 ;| mx:BoundBoxPoints

Punkte der rechteckigen Umgrenzung eines Objekts
|;
(defun mx:BoundBoxPoints (obj / ll ur)
  (vlax-invoke-method obj 'GetBoundingBox 'll 'ur)
  (setq ll (vlax-safearray->list ll)
        ur (vlax-safearray->list ur)
  )
  (list
    ll
    (list
      (car ur)
      (cadr ll)
      (caddr ll)
    )
    ur
    (list
      (car ll)
      (cadr ur)
      (caddr ur)
    )
  )
)

 ;| mx:m2p

Mitte zwischen zwei Punkten
|;
(defun m2p (p1 p2)
  (mapcar
    '(lambda (x)
       (/ x 2.0)
     )
    (mapcar '+ p1 p2)
  )
)

 ;| mx:Descr2Pt

Punktentsprechung eines Zeichenkette zurückgeben
|;
(defun mx:PtOfObj (s o / lstBBpts)
  (setq lstBBpts (mx:BoundBoxPoints o))
  (if
    (member s
            '("Basispunkt" "OL" "OZ" "OR" "ML" "MZ" "MR" "UL" "UZ" "UR")
    )
     (cdr
       (assoc
         s
         (list
           (cons "Basispunkt"
                 (cdr (assoc 10 (entget (vlax-vla-object->ename o))))
           )
           (cons "OL"
                 (cadddr lstBBpts)
           )
           (cons "OZ"
                 (m2p (cadddr lstBBpts) (caddr lstBBpts))
           )
           (cons "OR"
                 (caddr lstBBpts)
           )
           (cons "ML"
                 (m2p (car lstBBpts) (cadddr lstBBpts))
           )
           (cons "MZ"
                 (m2p (car lstBBpts) (caddr lstBBpts))
           )
           (cons "MR"
                 (m2p (cadr lstBBpts) (caddr lstBBpts))
           )
           (cons "UL"
                 (car lstBBpts)
           )
           (cons "UZ"
                 (m2p (car lstBBpts) (cadr lstBBpts))
           )
           (cons "UR"
                 (cadr lstBBpts)
           )
         )
       )
     )
  )
)

;| DCLAuswechseln

Dialogsteuerung für Auswechseln
|;
(defun DCLAuswechseln (/ sDCLfile DCL_Id ss ssLen flag iReturn sInfo11 sInfo21 f lTiles e eList eType)
  (if (not *mxPresetSelectInfo1*)
    (setq *mxPresetSelectInfo1* (list nil "" ""))
  )
  (if (not *mxPresetSelectInfo2*)
    (setq *mxPresetSelectInfo2* (list nil "" ""))
  )
  (MakeDCL:DAuswechseln
    (setq sDCLfile
           (strcat
             (getvar "TEMPPREFIX")
             "DCLfürAuswechseln.dcl"
           )
    )
  )
  (setq DCL_Id (load_dialog sDCLfile))
  (setq iReturn 2)
  (while (/= iReturn 1)
    (new_dialog "Auswechseln" DCL_Id)
    (setq sInfo11 (nth 1 *mxPresetSelectInfo1*))
    (setq sInfo21 (nth 1 *mxPresetSelectInfo2*))
    (set_tile "Title" "Auswechseln")
    (mx:DCLImage4SelectButton "select_pick1")
    (mx:DCLImage4SelectButton "select_pick2")
    (set_tile "Prompt1" "Objekte auswählen, die ersetzt werden sollen")
    (set_tile "Prompt2" "Objekt auswählen, das ersetzen soll")
    (set_tile "Text11" sInfo11)
    (set_tile "Text21" sInfo21)
    (action_tile "select_pick1" "(done_dialog 2)")
    (action_tile "select_pick2" "(done_dialog 3)")
    (action_tile "accept" "(setq lTiles (mx:GetTiles))(done_dialog 1)")
    (setq iReturn (start_dialog))
    (if (= iReturn 2)
      (if (setq ss (ssget))
        (progn
          (setq ssLen (sslength ss))
          (setq *mxPresetSelectInfo1*
                 (list flag
                       (strcat "Objektanzahl: " (itoa ssLen))
                 )
          )
        )
        (progn
          (setq flag (nth 0 *mxPresetSelectInfo1*))
          (setq *mxPresetSelectInfo1*
                 (list flag
                       ""
                       "\t    Nichts ausgewählt"
                       ""
                 )
          )
        )
      )
    )
    ;; Objekt zum Ersetzen
    (if (= iReturn 3)
      (if (setq e (entsel))
        (progn
          (setq
            eList (entget (car e))
            eType (cdr (assoc 0 eList))
            flag  t
          )
          (setq *mxPresetSelectInfo2*
                 (list
                   flag
                   (strcat "Objekttyp: " eType)
                 )
          )
        )
        (progn
          (setq flag (nth 0 *mxPresetSelectInfo2*))
          (setq *mxPresetSelectInfo2*
                 (list flag
                       ""
                       "\t    Nichts ausgewählt"
                       ""
                 )
          )
          (setq eList nil)
        )
      )
    )
  )
  (unload_dialog DCL_Id)
  (mapcar '(lambda (x)
             (if (member 'nil x)
               (setq f 't)
             )
           )
          lTiles
  )
  (setq *mxPresetSelectInfo1* (list nil "" ""))
  (setq *mxPresetSelectInfo2* (list nil "" ""))
  (if
    (not f)
     (setq lTiles (append (list ss (car e)) lTiles))
  )
  lTiles
)

 ;| mx:GetTiles

liest Dialogfeldbuttons aus
|;
(defun mx:GetTiles (/ l)
  (mapcar
    '(lambda (s)
       (setq l
              (cons
                (list
                  s
                  (get_tile s)
                )
                l
              )
       )
     )
    '("basispunkt" "einfuegepunkt")
  )
  l
)

 ;| MakeDCL:DeDuSo

Erzeugt ein Dialog für die Einstellungen des LAYISO-Dialogs
|;
(defun MakeDCL:DAuswechseln (sDCLfile / f)
  (setq f (open sDCLfile "w"))
  (mapcar
    '(lambda (s)
       (write-line s f)
     )
    (list
      "Auswechseln : dialog {"
      "key = \"Title\";"
      "label = \"\";"
      "spacer;"
      ": row {"
      ": column {"
      ": column {"
      "fixed_width = true;"
      ": row {"
      ": column {"
      "spacer;"
      ": image_button {"
      "key = \"select_pick1\";"
      "width = 4;"
      "height = 2;"
      "fixed_width = true;"
      "fixed_height = true;"
      "aspect_ratio = 1;"
      "color = -15;"
      "}"
      "spacer;"
      "}"
      ": column {"
      "spacer;"
      ": text {"
      "key = \"Prompt1\";"
      "label = \"\";"
      "width = 40;"
      "fixed_width = true;"
      "vertical_margin = none;"
      "}"
      "spacer;"
      "}}}"
      ": boxed_column {"
      "label = \"Objektinformationen\";"
      "width = 45;"
      "fixed_width = true;"
      ": paragraph {"
      ": text_part {"
      "key = \"Text11\";"
      "label = \"\";"
      "}"
      ": text_part {"
      "key = \"Text12\";"
      "label = \"\";"
      "}}"
      "spacer;"
      "}"
      ": boxed_column {"
      ": text {"
      "key = \"basispunkt_label1\";"
      "label = \"Basispunkt des Objekts\";"
      "}"
      ": text {"
      "key = \"basispunkt_label2\";"
      "label = \"an dem die Ersetzung\";"
      "}"
      ": text {"
      "key = \"basispunkt_label3\";"
      "label = \"eingefügt werden soll\";"
      "}"
      "spacer;"
      ": radio_column {"
      "key = \"basispunkt\";"
      ": radio_button {"
      "key = \"T_OL\";"
      "label = \"Oben Links\";"
      "}"
      ": radio_button {"
      "key = \"T_OZ\";"
      "label = \"Oben Mitte\";"
      "}"
      ": radio_button {"
      "key = \"T_OR\";"
      "label = \"Oben Rechts\";"
      "}"
      ": radio_button {"
      "key = \"T_ML\";"
      "label = \"Mitte Links\";"
      "}"
      ": radio_button {"
      "key = \"T_MZ\";"
      "label = \"Mitte Zentrum\";"
      "}"
      ": radio_button {"
      "key = \"T_MR\";"
      "label = \"Mitte Rechts\";"
      "}"
      ": radio_button {"
      "key = \"T_UL\";"
      "label = \"Unten Links\";"
      "}"
      ": radio_button {"
      "key = \"T_UZ\";"
      "label = \"Unten Mitte\";"
      "}"
      ": radio_button {"
      "key = \"T_UR\";"
      "label = \"Unten Rechts\";"
      "}}}}"
      "spacer;"
      ": column {"
      ": column {"
      "fixed_width = true;"
      ": row {"
      ": column {"
      "spacer;"
      ": image_button {"
      "key = \"select_pick2\";"
      "width = 4;"
      "height = 2;"
      "fixed_width = true;"
      "fixed_height = true;"
      "aspect_ratio = 1;"
      "color = -15;"
      "}"
      "spacer;"
      "}"
      ": column {"
      "spacer;"
      ": text {"
      "key = \"Prompt2\";"
      "label = \"\";"
      "width = 40;"
      "fixed_width = true;"
      "vertical_margin = none;"
      "}"
      "spacer;"
      "}}}"
      ": boxed_column {"
      "label = \"Objektinformationen\";"
      "width = 45;"
      "fixed_width = true;"
      ": paragraph {"
      ": text_part {"
      "key = \"Text21\";"
      "label = \"\";"
      "}"
      ": text_part {"
      "key = \"Text22\";"
      "label = \"\";"
      "}}"
      "spacer;"
      "}"
      ": boxed_column {"
      ": text {"
      "key = \"einfuegepunkt_label1\";"
      "label = \"Basispunkt am ersetzenden Objekt\";"
      "}"
      ": text {"
      "key = \"einfuegepunkt_label2\";"
      "label = \"über den es\";"
      "}"
      ": text {"
      "key = \"einfuegepunkt_label3\";"
      "label = \"eingefügt wird\";"
      "}"
      "spacer;"
      ": radio_column {"
      "key = \"einfuegepunkt\";"
      ": radio_button {"
      "key = \"S_OL\";"
      "label = \"Oben Links\";"
      "}"
      ": radio_button {"
      "key = \"S_OZ\";"
      "label = \"Oben Mitte\";"
      "}"
      ": radio_button {"
      "key = \"S_OR\";"
      "label = \"Oben Rechts\";"
      "}"
      ": radio_button {"
      "key = \"S_ML\";"
      "label = \"Mitte Links\";"
      "}"
      ": radio_button {"
      "key = \"S_MZ\";"
      "label = \"Mitte Zentrum\";"
      "}"
      ": radio_button {"
      "key = \"S_MR\";"
      "label = \"Mitte Rechts\";"
      "}"
      ": radio_button {"
      "key = \"S_UL\";"
      "label = \"Unten Links\";"
      "}"
      ": radio_button {"
      "key = \"S_UZ\";"
      "label = \"Unten Mitte\";"
      "}"
      ": radio_button {"
      "key = \"S_UR\";"
      "label = \"Unten Rechts\";"
      "}}}}}"
      "spacer;"
      "ok_only;"
      "}"
     )
  )
  (close f)
)

;| mx:DCLImage4SelectButton

Vektorbild für AuswahlButton in DCL-Box
DCL Specs: image_button width = 3.59; height = 1.66;
|;
(defun mx:DCLImage4SelectButton (s)
  (start_image s)
  (fill_image 4 4 36 37 255)            ; Fill image from 4,4 across 36 and down 37 with color 255 white
  (vector_image 9 5 33 29 1)            ; Draw a X from 9,5 to 33,29 and 9,9 to 33,25 with color 1 red
  (vector_image 9 9 33 25 1)
  (mapcar 'vector_image
          (list 3 3 3 15 13 14 15 16 17 17 12 12 13 16 14 16 16) ; X1
          (list 3 3 14 3 8 9 10 11 12 16 7 7 15 14 15 18 14) ; Y1
          (list 35 23 35 35 33 34 35 36 37 37 32 38 34 37 36 37 38) ; X2
          (list 23 34 34 34 35 35 36 37 33 37 36 33 35 33 38 38 37) ; Y2
          (list 9 9 8 8 2 2 2 2 2 2 250 250 250 250 250 250 250) ; Color
  )                                     ; Use mapcar function to reduce the amount of code for vector_image
  (end_image)
)

 ;| mx:Init

Initialisierung
|;
(defun mx:Init ()
  (vl-load-com)
  (setq acdoc
         (vlax-get-property
           (vlax-get-acad-object)
           'ActiveDocument
         )
  )
  (setq mx-echo (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq mx-err  *error*
        *error* mx:Error
  )
  (vlax-invoke-method acdoc 'EndUndomark)
  (vlax-invoke-method acdoc 'StartUndomark)
)

 ;| mx:Reset

Zurücksetzen
|;
(defun mx:Reset ()
  (setvar "CMDECHO" mx-echo)
  (vlax-invoke-method acdoc 'EndUndomark)
  (vlax-release-object acdoc)
  (setq *error* mx-err)
  (mapcar
    '(lambda (arg)
       (set
         arg
         'nil
       )
     )
    (list 'mx-err 'mx-echo 'acdoc)
  )
)

 ;| mx:Error

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

(defun c:AWE ()
  (c:acmDAuswechseln)
)

;;; Feedback beim Laden
(princ
  "\n\"acmDAuswechseln.lsp\" zum Ersetzen von Objekten wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
  Start mit \"acmDAuswechseln\" oder \"AWE\"."
)
(princ)