;| acmMatchVPLayersettings

Erstellen des Layerstatus eines ausgewählten Layoutansichtsfensters
und Übertragen dieses Layerstatus auf ein Ansichtsfenster eines anderen Layouts


Plattform: ab AutoCAD 2020

Copyright
Markus Hoffmann, www.CADmaro.de

Februar 2023
|;
(defun c:acmMatchVPLayersettings (/ lSources sTab)
  (mx:Init)
  (setq lSources (mx:CreateSourceVPLayerstate))
  (princ
    "\nLayout wählen mit Ansichtsfenstern auf die der Layerstatus angewandt werden soll: "
  )
  (if
    (setq sTab (mx:SelectLayouts 0))
     (progn
       (setvar 'CTAB sTab)
       (mx:SetVPLayerstate (car lSources))
     )
     (princ "\nEs urde kein Layout gewählt!")
  )
  (layerstate-delete (car lSources))	; Layerstatus löschen
  (vl-file-delete (cadr lSources))	; exportierter Layerstatus löschen
  (mx:Reset)
  (princ)
)

 ;| mx:SelectPViewport

Ansichtsfenster wählen
|;
(defun mx:SelectPViewport (s / eSelected)
  (while
    (or
      (not
        (setq eSelected (entsel s))
      )
      (if eSelected
        (/= "VIEWPORT" (cdr (assoc 0 (entget (car eSelected)))))
      )
    )
  )
  (car eSelected)
)

 ;| mx:CreateSourceVPLayerstate

Layerstatus eines Ansichtsfensters erstellen und exportieren
|;
(defun mx:CreateSourceVPLayerstate (/ e _69 sName sFname)
  (vlax-put-property oAD 'ActiveSpace acPaperSpace)
  (vlax-put-property oAD 'Mspace :vlax-false)
  (setq e
         (mx:SelectPViewport
           "\nAnsichtsfenster für Layereinstellungen wählen: "
         )
  )
  (vlax-put-property oAD 'Mspace :vlax-true)
  (setq _69 (cdr (assoc 69 (entget e))))
  (setvar 'CVPORT _69)
  (setq sName (strcat "acm" (rtos (getvar 'CDATE) 2 8)))
  (layerstate-save sName 2047 e)
  (if
    (findfile
      (setq sFname (strcat (getvar 'TEMPPREFIX) "acmTemp.las"))
    )
     (vl-file-delete sFname)
  )
  (layerstate-export
    sName
    sFname
  )
  (list sName sFname)
)

 ;| mx:SetVPLayerstate

Layerstatus eines Ansichtsfensters setzen
|;
(defun mx:SetVPLayerstate (sName / e _69)
  (vlax-put-property oAD 'Mspace :vlax-false)
  (setq e (mx:SelectPViewport "\nZielansichtsfenster wählen: "))
  (setq _69 (cdr (assoc 69 (entget e))))
  (vlax-put-property oAD 'Mspace :vlax-true)
  (setvar 'CVPORT _69)
  (layerstate-restore sName e 4)
)

 ;| mx:SelectLayouts
Dialogfeld um eins oder mehrere andere Layouts der aktuellen DWG zu wählen
mode:
0 Einzelauswahl
1 Mehrfachauswahl
|;
(defun mx:SelectLayouts (mode / lLayouts)
  (setq lLayouts
         (mx:DiaSelectFromListbox
           (mx:RemoveElementFromList
             (layoutlist)
             (vlax-get-property
               (vlax-get-property oAD 'ActiveLayout)
               'Name
             )
           )
           mode
         )
  )
)

 ;| mx:DiaSelectFromListbox

Auswahldialog mit Listbox

Parameter
lst - Liste, die angeboten wird
mode - 0 für Einzelauswahl, 1 für multiple Auswahl
|;
(defun mx:DiaSelectFromListbox
       (lst mode / dclfile dcl_id tileResult result)
  (MakeDcl:Listbox
    (setq dclfile (strcat (getvar "TEMPPREFIX") "mxListbox.dcl"))
    (if (= 1 mode)
      "multiple_select = true ;"
      ""
    )
  )
  (setq dcl_id (load_dialog dclfile))
  (if (new_dialog "mx_listbox" dcl_id)
    (progn
      (start_list "list1" 3)
      (mapcar 'add_list lst)
      (end_list)
      (action_tile "list1" "(nth (atoi $value) lst)")
      (if (= 1 mode)
        (action_tile
          "button1"
          "(setq tileResult (mx:DCLSelection))"
        )
        (action_tile
          "button1"
          "(setq tileResult (get_tile \"list1\"))(done_dialog)"
        )
      )
      (action_tile "button0" "(done_dialog)")
      (start_dialog)
      (unload_dialog dcl_id)
      (if tileResult
        (if (= 1 mode)
          (mapcar
            '(lambda (arg)
               (setq
                 result
                  (cons
                    (nth arg lst)
                    result
                  )
               )
             )
            tileResult
          )
          (setq
            result
             (nth (atoi tileResult) lst)
          )
        )
        (alert "Nichts gewählt")
      )
    )
  )
  (vl-file-delete dclfile)
  result
)

 ;| mx:DCLSelection

DCL-Auswahl auswerten
|;
(defun mx:DCLSelection (/ result)
  (setq selected (get_tile "list1"))
  (mapcar
    '(lambda (arg)
       (if (/= " " arg)
         (setq result (cons (atoi arg) result))
       )
     )
    (mx:Str2Lst selected " ")
  )
  (done_dialog)
  (reverse result)
)

 ;| MakeDcl:Listbox

DCL-Datei zur Auswahl aus einer Listbox erzeugen
|;
(defun MakeDcl:Listbox (fname mode / fh)
  (setq fh (open fname "w"))
  (mapcar
    '(lambda (arg)
       (write-line arg fh)
     )
    (list
      "mx_listbox : dialog { " "label = \"Bitte wählen\" ;"
      ": list_box {"           "fixed_height = true ;"
      "fixed_width = true ;"   mode
      "height = 20 ;"          "key = \"list1\" ;"
      "width = 30 ;"           "}"
      "spacer ;"               ": row {"
      ": button {"             "fixed_width = true ;"
      "is_default = true ;"    "key = \"button1\" ;"
      "label = \"Auswählen\" ;"
      "width = 12 ;"           "}"
      ": button {"             "fixed_width = true ;"
      "is_default = true ;"    "key = \"button0\" ;"
      "label = \"Abbruch\" ;"  "width = 12 ;"
      "}"                      ": text {"
      "key = \"text1\" ;"      "}"
      "}"                      "}"
     )
  )
  (close fh)
)

 ;| mx:RemoveElementFromList

Element aus Liste entfernen
|;
(defun mx:RemoveElementFromList (lst el)
  (append
    (reverse
      (cdr (member el (reverse lst)))
    )
    (cdr (member el lst))
  )
)

 ;| mx:Str2Lst

String in Liste umwandeln
|;
(defun mx:Str2Lst (str tok / pos)
  (if
    (setq pos (vl-string-search tok str))
     (cons
       (substr str 1 pos)
       (mx:Str2Lst (substr str (+ (strlen tok) pos 1)) tok)
     )
     (list str)
  )
)

 ;| mx:Init

Initialisierung
|;
(defun mx:Init ()
  (vl-load-com)
  (setq oAD
         (vlax-get-property
           (vlax-get-acad-object)
           'ActiveDocument
         )
  )
  (setq iEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq iLight (getvar "HIGHLIGHT"))
  (setvar "HIGHLIGHT" 1)
  (setq errorMX *error*
        *error* mx:Error
  )
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-invoke-method oAD 'StartUndomark)
)

 ;| mx:Reset

Zurücksetzen
|;
(defun mx:Reset ()
  (vla-regen oAD acAllViewports)
  (setvar "CMDECHO" iEcho)
  (setvar "HIGHLIGHT" iLight)
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-release-object oAD)
  (setq *error* errorMX)
  (mapcar
    '(lambda (arg)
       (set
         arg
         'nil
       )
     )
    (list 'errorMX 'iEcho 'iLight 'oAD 'lSelected)
  )
)

 ;| mx:Error

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

;;; Kurzbefehl
(defun c:acmMVPLS () (c:acmMatchVPLayersettings))

;; Feedback beim Laden
(princ
  "\nacmMatchVPLayersettings wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
Start mit \"acmMatchVPLayersettings\" oder \"acmMVPLS\"."
)
(princ)