;| acmExportLFilter

Exportiert benannte Eigenschaftenfilter/Layerfilter
aus der aktuellen Datei in eine ASCII-Textdatei


Copyright
Markus Hoffmann, www.CADmaro.de

Februar, 2024
|;
(defun c:acmExportLFilter (/ oLyrDic oLyrFltrs lFltrs sFltrName fName f)
  (mx:Init)
  (if
    (and
      (setq oLyrDic
             (vla-getExtensionDictionary
               (vla-get-Layers acdoc)
             )
      )
      (setq oLyrFltrs
             (mx:CatchVlaItem oLyrDic "ACAD_LAYERFILTERS")
      )
    )
     (if
       (and
         (vlax-for i oLyrFltrs
           (setq lFltrs (cons (vla-get-Name i) lFltrs))
         )
         (setq sFltrName (mx:DiaSelectFromListbox lfltrs 0))
       )
        (if
          (setq
            fName
             (getfiled
               "Exportdatei erstellen"
                       sFltrName
                       "cfg"
                       1
             )
          )
           (progn
             (setq f (open fName "w"))
             (write-line
               "//Layerfilter Export-Datei von acmExportLFilter, BITTE NICHT AENDERN."
               f
             )
             (mapcar
               '(lambda (x)
                  (write-line (vl-prin1-to-string x) f)
                )
               (mx:GetLyrfltrData acdoc sFltrName)
             )
             (close f)
           )
        )
     )
     (alert "Keine Layerfilter gefunden")
  )
  (mx:Reset)
  (princ "\nFertig")
  (princ)
)

;| mx:GetLyrfltrData

Daten eines Layerfilters im übergebenen Dokument auslesen
|;
(defun mx:GetLyrfltrData (oDoc sFltrName / oLyrDic oLyrFltrs oLyDict lyrFltr xDType xDValue tempT tempV return)
  (setq
    oLyrDic
     (vla-getExtensionDictionary
       (vla-get-Layers oDoc)
     )
  )
  (if
    (and
      (setq oLyrFltrs (mx:CatchVlaItem oLyrDic "ACAD_LAYERFILTERS"))
      (setq oLyDict (mx:CatchVlaItem oLyrDic "ACLYDICTIONARY"))
      (setq lyrFltr (mx:CatchVlaItem oLyrFltrs sFltrName))
    )
     (progn
       (vlax-for i oLyDict
         (vla-GetXRecordData i 'xDType 'xDValue)
         (setq tempT (vlax-safearray->list xDType))
         (if
           (= 290 (car tempT))
            (setq tempV
                        (mapcar
                          'vlax-variant-value
                          (cdr (vlax-safearray->list xDValue))
                        )
                  tempT (cdr tempT)
            )
            (setq tempV
                   (mapcar
                     'vlax-variant-value
                     (vlax-safearray->list xDValue)
                   )
            )
         )
         (if
           (and
             (= (car tempV) "AcLyLayerFilter")
             (member sFltrName tempV)
           )
            (setq return (list tempT tempV))
         )
       )
       (vla-GetXRecordData lyrFltr 'xDType 'xDValue)
       (setq
         return
          (cons
            (vlax-safearray->list xDType)
            (cons
              (mapcar
                'vlax-variant-value
                (vlax-safearray->list xDValue)
              )
              return
            )
          )
       )
     )
  )
)

;| 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: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:CatchVlaItem
Durch vl-catch-all-apply gesichertes vla-Item

|;
(defun mx:CatchVlaItem (col name / o)
  (vl-catch-all-apply
    (function
      (lambda ()
        (setq o (vla-Item col name))
      )
    )
  )
  o
)

 ;| 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:acmExLF ()
  (c:acmExportLFilter)
)

;;; Feedback beim Laden
(princ
  "\n\"acmLayerfilterExport.lsp\" zum Exportieren von benannten Eigenschaftenfiltern wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
  Start mit \"acmExportLFilter\" oder \"acmExLF\"."
)
(princ)