dxfmakros/Lisp/menu-inventory.lsp

;;; ============================================================
;;; menu-inventory.lsp  –  BricsCAD V25
;;; Inventar: Menuegruppen / BRX-Plugins / LISP-Startdateien
;;; Aufruf:  MenuInventory
;;; ============================================================

(defun c:MenuInventory ( / sep phdr prow
                           acad-obj app-obj groups-coll grp
                           app-list app-name app found f entry
                           i srch pth lisp-name)

  ;; ---- Hilfsfunktionen ----
  (defun sep   () (princ "\n------------------------------------------------------------"))
  (defun phdr  (ttl) (sep) (princ (strcat "\n  " ttl)) (sep))
  (defun prow  (lbl val)
    (princ (strcat "\n  " lbl))
    (princ (strcat "\n    -> " (if (and val (> (strlen val) 0)) val "<unbekannt>"))))

  ;; ---- String-Split (Semikolon-getrennte Pfade) ----
  (defun split-semi (s / result start pos ch)
    (setq result '() start 0 pos 0)
    (while (<= pos (strlen s))
      (setq ch (if (< pos (strlen s)) (substr s (1+ pos) 1) ";"))
      (if (= ch ";")
        (progn
          (if (> pos start)
            (setq result (append result (list (substr s (1+ start) (- pos start))))))
          (setq start (1+ pos))))
      (setq pos (1+ pos)))
    result)

  ;; ============================================================
  (princ "\n")
  (princ "\n============================================================")
  (princ "\n  BricsCAD V25 -- Inventar: Menues / Plugins / LISP-Apps")
  (princ "\n============================================================")

  ;; ==============================================================
  ;; BLOCK 1: Menuegruppen via COM/ActiveX
  ;; ==============================================================
  (phdr "1. GELADENE MENUEGRUPPEN (CUI)")

  (setq i 0)
  (vl-load-com)

  (if (not (setq acad-obj (vlax-get-acad-object)))
    (princ "\n  [COM nicht verfuegbar]")
    (progn
      (setq app-obj     (vla-get-application acad-obj))
      (setq groups-coll (vla-get-menugroups app-obj))
      (if (null groups-coll)
        (princ "\n  [Keine Menuegruppen per COM abrufbar]")
        (progn
          (princ (strcat "\n  Anzahl Gruppen: "
                         (itoa (vla-get-count groups-coll))))
          (vlax-for grp groups-coll
            (setq i (1+ i))
            (prow
              (strcat "[" (itoa i) "] "
                      (vlax-get-property grp 'Name))
              ;; MenuFileName gibt den vollen CUI-Pfad
              (if (vlax-property-available-p grp 'MenuFileName)
                (vlax-get-property grp 'MenuFileName)
                "<MenuFileName nicht verfuegbar>")
            )
          )
        )
      )
    )
  )

  ;; ==============================================================
  ;; BLOCK 2: Geladene Applikationen (BRX/TX-Module)
  ;; ==============================================================
  (phdr "2. GELADENE APPLIKATIONEN (BRX/TX)")

  (setq i 0)

  ;; Versuch 1: COM – LoadedApplications (falls verfuegbar)
  (setq app-list nil)
  (if (and acad-obj
           (not (vl-catch-all-error-p
                  (setq app-list
                    (vl-catch-all-apply
                      'vlax-get-property
                      (list app-obj 'LoadedApplications))))))
    (progn
      (princ "\n  [Quelle: COM LoadedApplications]")
      (princ (strcat "\n  Anzahl: " (itoa (vla-get-count app-list))))
      (vlax-for app app-list
        (setq i (1+ i))
        (prow (strcat "[" (itoa i) "] "
                       (if (vlax-property-available-p app 'Name)
                         (vlax-get-property app 'Name) "?"))
              (if (vlax-property-available-p app 'FullName)
                (vlax-get-property app 'FullName) "<Pfad n/a>"))))
    ;; Versuch 2: ads_arxlist (einige BricsCAD-Builds)
    (if (not (vl-catch-all-error-p
               (setq app-list
                 (vl-catch-all-apply 'ads_arxlist nil))))
      (progn
        (princ "\n  [Quelle: ads_arxlist]")
        (princ (strcat "\n  Anzahl: " (itoa (length app-list))))
        (foreach app-name app-list
          (setq i (1+ i))
          (prow (strcat "[" (itoa i) "] " app-name)
                (cond ((findfile app-name) (findfile app-name))
                      (T app-name)))))
      ;; Versuch 3: Bekannte BRX-Dateien in Support-Pfaden suchen
      (progn
        (princ "\n  [COM/ads_arxlist nicht verfuegbar]")
        (princ "\n  Suche nach .brx/.tx Dateien in Support-Pfaden:")
        (setq srch (getvar "SRCHPATH"))
        (if (and srch (> (strlen srch) 0))
          (foreach pth (split-semi srch)
            (if (and (> (strlen pth) 0) (findfile pth))
              (foreach ext (list "*.brx" "*.tx")
                (setq found (vl-directory-files pth ext 1))
                (foreach f found
                  (setq i (1+ i))
                  (prow (strcat "[" (itoa i) "] " f)
                        (strcat pth "\\" f)))))))
        (if (= i 0)
          (princ "\n  [Keine BRX/TX-Module in Support-Pfaden gefunden]"))
      )
    )
  )

  ;; ==============================================================
  ;; BLOCK 3: LISP-Startdateien
  ;; ==============================================================
  (phdr "3. LISP-STARTDATEIEN")

  (setq i 0)

  ;; Systemvariablen fuer globale / dok-lokale LISP-Dateien
  (foreach entry (list
      (list "ACADLSPASAPP" (getvar "ACADLSPASAPP"))
      (list "ACADLSPASDOC" (getvar "ACADLSPASDOC")))
    (setq lisp-name (cadr entry))
    (if (and lisp-name (= (type lisp-name) 'STR) (> (strlen lisp-name) 0))
      (progn
        (setq i (1+ i))
        (prow (strcat "[" (itoa i) "] " (car entry) ": " lisp-name)
              (findfile lisp-name)))))

  ;; Bekannte BricsCAD-Startup-Hooks in den Support-Pfaden
  (foreach f (list "on_start.lsp" "on_doc_load.lsp" "on_doc_save.lsp"
                   "on_quit.lsp"  "acad.lsp"         "acaddoc.lsp")
    (setq lisp-name (findfile f))
    (if lisp-name
      (progn
        (setq i (1+ i))
        (prow (strcat "[" (itoa i) "] Startup-Hook: " f) lisp-name))))

  (if (= i 0)
    (princ "\n  [Keine LISP-Startdateien gefunden]"))

  ;; ==============================================================
  ;; BLOCK 4: Systeminformationen
  ;; ==============================================================
  (phdr "4. SYSTEMINFORMATIONEN")

  (princ (strcat "\n  Haupt-CUI  (MENUNAME):  "
                 (if (= (type (getvar "MENUNAME")) 'STR) (getvar "MENUNAME") "<n/a>")))
  (princ (strcat "\n  Profil     (CPROFILE):  "
                 (if (= (type (getvar "CPROFILE")) 'STR) (getvar "CPROFILE") "<n/a>")))
  (princ "\n  Support-Pfade (SRCHPATH):")
  (setq srch (getvar "SRCHPATH"))
  (if (and srch (= (type srch) 'STR) (> (strlen srch) 0))
    (foreach pth (split-semi srch)
      (if (> (strlen pth) 0)
        (princ (strcat "\n    " pth))))
    (princ "\n    <leer>"))

  ;; ==============================================================
  (sep)
  (princ "\n  Ende des Inventars.")
  (princ "\n============================================================\n")
  (princ)
)

(princ "\n[menu-inventory.lsp geladen]  Befehl: MenuInventory")
(princ)