Funktion hinzugefügt um die Quellen der Menüeinträge und Funktionen zu finden. menu-inventory.lsp
This commit is contained in:
@@ -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 "<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)
|
||||
Reference in New Issue
Block a user