;| acmImportLFilter

Importiert benannte Eigenschaftenfilter/Layerfilter
aus einer ASCII-Textdatei, einer DWG- oder DWT-Datei


Copyright
Markus Hoffmann, www.CADmaro.de

April, 2024
|;
(defun c:acmImportLFilter (/ fName LaFlag f lFltrData sFltrName oDBX dbx oLyrDic oLyrFltrs lFltrs)
  (mx:Init)
  (if (setq fName (getfiled "Filter importieren" "" "cfg;dwg;dwt" 0))
    (progn
      (if (= 1 (getvar "LAYERMANAGERSTATE"))
        (progn
          (setq LaFlag 't)
          (command "_layerclose")
        )
      )
      (cond
        (
         (= (strcase (vl-filename-extension fName)) ".CFG")
         (setq f (open fName "r"))
         (read-line f)
         (repeat 4
           (setq lFltrData
                  (cons
                    (read (read-line f))
                    lFltrData
                  )
           )
         )
         (close f)
         (setq lFltrData (reverse lFltrData)
               sFltrName (caadr lFltrData)
         )
         (if
           (not
             (mx:AddLyrFltr acdoc lFltrData)
           )
            (alert
              (strcat "\nLayerfilter \""
                      sFltrName
                      "\" ist schon vorhanden."
              )
            )
         )
        )
        (
         (member
           (strcase (vl-filename-extension fName))
           '(".DWG" ".DWT")
         )
         (if
           (not
             (and
               (setq
                 oDBX
                  (mx:CatchVlaItem
                    (vla-get-Documents (vlax-get-acad-object))
                    (strcat (vl-filename-base fName) ".dwg")
                  )
               )
               (= fName (vla-get-FullName oDBX))
             )
           )
            (setq oDBX
                   (mx:OpenDBXDWG fName)
                  dbx 't
            )
         )
         (if
           (and
             (setq oLyrDic
                    (vla-getExtensionDictionary
                      (vla-get-Layers oDBX)
                    )
             )
             (setq
               oLyrFltrs (mx:CatchVlaItem oLyrDic "ACAD_LAYERFILTERS")
             )
             (vlax-for i oLyrFltrs
               (setq lFltrs (cons (vla-get-Name i) lFltrs))
             )
           )
            (if
              (setq sFltrName (mx:DiaSelectFromListbox lFltrs 0))
               (if
                 (not
                   (mx:AddLyrFltr
                     acdoc
                     (mx:GetLyrfltrData oDBX sFltrName)
                   )
                 )
                  (alert
                    (strcat
                      "nLayerfilter \""
                      sFltrName
                      "\" ist schon vorhanden."
                    )
                  )
               )
            )
            (alert
              "Keine Eigenschaftenfilter in der Quelldatei vorhanden"
            )
         )
         (and dbx (vlax-release-object oDBX))
        )
        (T (alert "Die ausgewählte Datei ist ungültig."))
      )
      (if LaFlag
        (command "_layerpalette")
      )
    )
  )
  (mx:Reset)
  (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:AddLyrFltr

Einen Eigenschaftslayerfilter einfügen

oDoc - Zieldokument
lFltrData - Liste der XRecorddaten des Filters

Rückgabe True bzw. Nil, wenn der Eigenschaftsfilter schon existiert
|;
(defun mx:AddLyrFltr (oDoc lFltrData / sFltrName oLyrDic oLyrFltrs oLyDict lyrFltr n aclyName aclyXRec)
  (setq
    sFltrName (caadr lFltrData)
    oLyrDic   (vla-getExtensionDictionary (vla-get-Layers oDoc))
  )
  (or
    (setq oLyrFltrs (mx:CatchVlaItem oLyrDic "ACAD_LAYERFILTERS"))
    (and
      (vla-addObject
        oLyrDic
        "ACAD_LAYERFILTERS"
        "AcDbDictionary"
      )
      (setq oLyrFltrs (vla-item oLyrDic "ACAD_LAYERFILTERS"))
    )
  )
  (or
    (setq oLyDict (mx:CatchVlaItem oLyrDic "ACLYDICTIONARY"))
    (and
      (vla-addObject oLyrDic "ACLYDICTIONARY" "AcDbDictionary")
      (setq oLyDict (vla-item oLyrDic "ACLYDICTIONARY"))
    )
  )
  (if
    (not
      (mx:CatchVlaItem oLyrFltrs sFltrName)
    )
     (progn
       (setq lyrFltr
              (vla-addXRecord oLyrFltrs sFltrName)
       )
       (setq n 1)
       (not
         (while
           (mx:CatchVlaItem
             oLyDict
             (setq aclyName (strcat "*A" (itoa n)))
           )
            (setq n (1+ n))
         )
       )
       (setq aclyXRec (vla-addXRecord oLyDict aclyName))
       (vla-SetXRecordData
         lyrFltr
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbInteger
               (cons 0 (1- (length (car lFltrData))))
             )
             (car lFltrData)
           )
         )
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbVariant
               (cons 0 (1- (length (cadr lFltrData))))
             )
             (mapcar
               'vlax-make-variant
               (cadr lFltrData)
             )
           )
         )
       )
       (vla-SetXRecordData
         aclyXRec
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbInteger
               (cons 0 (1- (length (caddr lFltrData))))
             )
             (caddr lFltrData)
           )
         )
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbVariant
               (cons 0 (1- (length (cadddr lFltrData))))
             )
             (mapcar
               'vlax-make-variant
               (cadddr lFltrData)
             )
           )
         )
       )
       T
     )
  )
)

 ;| 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:OpenDBXDWG

Datei per DBX öffnen und Objekt zurückgeben
|;
(defun mx:OpenDBXDWG (fName / objDBX)
  (setq objDBX
         (vlax-create-object
           (strcat
             "ObjectDBX.AxDbDocument."
             (itoa (atoi (getvar "ACADVER")))
           )
         )
  )
  (vla-open objDBX fName)
  objDBX
)

 ;| 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:acmImLF ()
  (c:acmImportLFilter)
)

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