diff --git a/Lisp/menu-inventory.lsp b/Lisp/menu-inventory.lsp new file mode 100644 index 0000000..dbb54c2 --- /dev/null +++ b/Lisp/menu-inventory.lsp @@ -0,0 +1,184 @@ +;;; ============================================================ +;;; 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 "")))) + + ;; ---- 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) + "") + ) + ) + ) + ) + ) + ) + + ;; ============================================================== + ;; 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) "")))) + ;; 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") ""))) + (princ (strcat "\n Profil (CPROFILE): " + (if (= (type (getvar "CPROFILE")) 'STR) (getvar "CPROFILE") ""))) + (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 ")) + + ;; ============================================================== + (sep) + (princ "\n Ende des Inventars.") + (princ "\n============================================================\n") + (princ) +) + +(princ "\n[menu-inventory.lsp geladen] Befehl: MenuInventory") +(princ)