;********************************************************************************************* ; Dateiname : SD_Schiller_Browserviews.lsp ; Autor : Stephan Wörz ; Erstellt : 16.04.2008 ; geändert : ;********************************************************************************************* ; Beschreibung : - Bereitstellung weiterer Browseransichten ; - ;********************************************************************************************* ; ---------------------------------------------------------------------------------------- ; ä Ì Ä Ø ö Î Ö Ú ü Ï Ü Û ß Þ ° ³ ; ---------------------------------------------------------------------------------------- ;; This file contains definitions of browser views that can be activated ;; via the structure browser "Views" menu button. ;; ;; A browser view can be specified as follows: ;; ;; (oli:sd-create-browser-view ;; {STRING} ;; Unique browser view name ;; :title {STRING} ;; Browser view title that will be displayed in the ;; browser views menu. ;; If not given, the browser view name will be displayed. ;; :tree-config {LIST|STRING} ;; List containing column keywords and padding strings. ;; The value of the specified columns and the padding strings are ;; concatenated together to form the text that will be displayed ;; at each browser node in the browser tree. If a string is passed ;; then this should identify an existing configuration. See ;; sd-create-browser-configuration for details. ;; :detail-config {LIST|STRING} ;; List containing column keywords. Specified columns appear ;; when detail mode of browser is switched on. If a string is passed ;; then this should identify an existing configuration. See ;; sd-create-browser-configuration for details. ;; :activate-detail-configuration [t|nil] ;; If set to t this parameter ensures that the detail part of the ;; browser is displayed otherwise the view shows tree only when ;; activated. Default is nil. ;; :enable {LISP expression} ;; The browser view will be included in the browser view menu ;; if this LISP expression evaluates to a NON-NIL value. ;; If not given, the browser view will be accessible in the browser ;; view menu without restrictions. ;; :derive-virtual-title-from-child [t|nil] ;; This flag determines how virtual folders display their titles within ;; this view. If set to true then the Tree Configuration title of the ;; folder's first child is used along with the total number of children ;; belonging to the folder. If this flag is set to nil then the model ;; name of the first child is used along with the number of children ;; belonging to the folder. In this case if no model name is available ;; then the browser view will again use the Tree Configuration title ;; of the folder's first child, as if the flag had been set to true. ;; ;; This file contains browser configurations which can be called from multiple ;; browser views. ;; ;; sd-create-browser-configuration ;; {STRING} ;; Unique browser configuration name ;; :config {LIST} ;; This list may contain a mixture of column keywords and strings. ;; If a keyword is specified it should refer to either one of the ;; pre-defined column definitions or to a column previously created ;; with one of the column creation functions. ;; Any strings specified are used as separators for display purposes. ;; If the configuration is referenced in a :tree-config parameter of ;; sd-create-browser-view then the contents of the specified columns ;; and any strings specified will be concatenated together to form a ;; single string to be displayed at each browser node in the ;; "Structure Tree" column unless :tree-item-func is specified. ;; If :tree-item-func is specified then the string returned by this ;; user defined function is used for display and any strings in the ;; :config list are ignored. ;; If the configuration is referenced in the detail-config parameter ;; then a separate column will be displayed for each column specified ;; in the configuration and any strings will again be ignored. ;; :tree-item-func {SYMBOL} ;; Function used to display item text ;; This function receives a property list as a parameter corresponding ;; to all columns specified in :config. It returns a string which will ;; be displayed next to the tree item. If the configuration is ;; referenced in a :detail-config parameter of sd-create-browser-view ;; then the function will not be called and therefore has no effect. ;; It is only useful when used in conjunction with the :tree-config ;; parameter of sd-create-browser-view. (in-package :custom) (use-package :oli) ;(sd-hide-console-window) ;(sd-show-console-window) (setf si::*enter-break-handler* t) ;;*************************************************************************** ;; globale definitionen ;;HashTable erzeugen (setq BrowserObjectColorTable (make-hash-table :test 'equal)) ;;globale Variable setzen (defvar *show-browser-entries-with-defined-color* t) ;hier lässt sich das markieren von Objekten einschalten (t) oder ausschalten (nil) ;;*************************************************************************** ;;*************************************************************************** ;; BROWSER-Spaltendefinitionen * ;**************************************************************************** (sd-create-column-definition :contents-density :title "Basisdichte [kg/dm3]" :initial-width 15 :alignment :right :display-fnc 'browser-display-contents-density :applicable-fnc 'applicable-density-p :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :instance-density :title "Expl-Dichte" :alignment :right :display-fnc 'browser-display-instance-density :applicable-fnc 'applicable-density-p :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :contents-mass :title "Masse [g]" :alignment :right :display-fnc 'browser-display-mass :applicable-fnc nil ;'applicable-density-p :edit-fnc nil ;; not editable ) ;============================================ (oli:sd-create-column-definition :geo-resolution :title "Geo AuflÎsung [mm]" :alignment :right :display-fnc 'display-geo-resolution :applicable-fnc 'applicable-geo-resolution-p :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :visible-parts :title "eingeblendete Teile/Baugpuppen" :display-fnc 'browser-display-visible-parts-fnc :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :part-type :title "Teileart" :display-fnc 'browser-detect-part-type-fnc :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_benennung_contents :title "Benennung" :initial-width 80 :ui-accessible nil :display-fnc 'browser-display-basis-ATTR-Benennung ; display-func muß String zurückliefern :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_typ_contents :title "Typ" :display-fnc 'browser-display-basis-ATTR-typ :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_artikelklasse_contents :title "Artikelklasse" :display-fnc 'browser-display-basis-ATTR-Artikelklasse :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_Werkstoff_contents :title "Werkstoff" :display-fnc 'browser-display-basis-ATTR-Werkstoff :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_Hersteller_contents :title "Hersteller" :display-fnc 'browser-display-basis-ATTR-Hersteller :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_Norm_contents :title "Norm" :display-fnc 'browser-display-basis-ATTR-Norm :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_Stammdaten_TeilOberflaeche :title "Teil-OberflÌche" :display-fnc 'browser-display-StammdatenTeilOberflaeche :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_StammdatenOberflaeche :title "OberflÌche" :display-fnc 'browser-display-StammdatenOberflaeche :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_StammdatenWerkstoff :title "Werkstoff" :display-fnc 'browser-display-StammdatenWerkstoff :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_Oberflaeche_contents :title "OberflÌche" :display-fnc 'browser-display-basis-ATTR-Oberflaeche :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_Waerme_contents :title "WÌrme" :display-fnc 'browser-display-basis-ATTR-Waerme :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_Sensor_contents :title "Sensor" :display-fnc 'browser-display-basis-ATTR-Sensor :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :attr_Aktor_contents :title "Aktor" :display-fnc 'browser-display-basis-ATTR-Aktor :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ (sd-create-column-definition :RenderMaterial :title "RenderMaterial" :display-fnc 'browser-display-basis-RenderMaterial :applicable-fnc nil :edit-fnc nil ;; not editable ) ;============================================ ;;*************************************************************************** ;; BROWSER-Views * ;**************************************************************************** ; "DEFAULT" - BrowserView wird von PHOENIX definiert!!! ;(oli:sd-create-browser-view ; "DEFAULT" ; :tree-config '(:instance-name) ; :detail-config '(:contents-name :db-state :shared :selective-instance-context) ; :title "Standard" ; :enable '(and (not (oli:sd-license-free-module-active-p "ModelManager")) ; (not (oli:sd-license-free-module-active-p "PEWMSD"))) ; :derive-virtual-title-from-child t ;steuert die Anzeige von Pseudoordnern T = Ordnerbennung = Benennung des 1. Objekts im Ordner! ;) ;============================================ (oli:sd-create-browser-view "ATTRIBUTES" :tree-config '(:instance-name) :detail-config '( ;: contents-name ; :instance-density :contents-density ; :contents-mass ; :RenderMaterial :geo-resolution :part-type :clip-flag ) :enable t :activate-detail-configuration t ;t = sofort auf Detailansicht umschalten :derive-virtual-title-from-child t ;steuert die Anzeige von Pseudoordnern T = Ordnerbennung = Benennung des 1. Objekts im Ordner! :title "Teileigenschaften" ) ;============================================ (oli:sd-create-browser-view "UserAttributes" :tree-config '(:instance-name) :detail-config '( :attr_benennung_contents :attr_typ_contents :attr_artikelklasse_contents ;:attr_Stammdaten_TeilOberflaeche :attr_StammdatenOberflaeche :attr_StammdatenWerkstoff :attr_Aktor_contents :attr_Sensor_contents :RenderMaterial );;detail-config :activate-detail-configuration t ;t = sofort auf Detailansicht umschalten :derive-virtual-title-from-child t ;steuert die Anzeige von Pseudoordnern T = Ordnerbennung = Benennung des 1. Objekts im Ordner! :title "Stammdatenattribute" ) ;============================================ (oli:sd-create-browser-view "PseudoAttributes" :tree-config '(:instance-name) :detail-config '( :attr_benennung_contents :attr_typ_contents :attr_Werkstoff_contents :attr_Hersteller_contents :attr_Norm_contents :attr_Oberflaeche_contents :attr_Waerme_contents) :activate-detail-configuration t ;t = sofort auf Detailansicht umschalten :derive-virtual-title-from-child t ;steuert die Anzeige von Pseudoordnern T = Ordnerbennung = Benennung des 1. Objekts im Ordner! :title "Pseudoattribute" ) ;============================================ (oli:sd-set-default-browser-view "SolidDesigner" "DEFAULT") ;============================================ (oli:sd-browser-exec-cmd "parcel-gbrowser" :set-browser-mode-order '( :container-mode :configuration-mode :clash_analysis-mode :rel_set-mode :animation-mode :simplification :molddesignadv :taper-feature :sheet-metal :3d-library :study-mode :manufacturing :gdt-dims :gdt-symbols :gdt :3d-annotation :group-mode :grouping-features :open-reference :element-names :generic-texts :hidden-features :user-defined-feature :feature-mode :coord_sys-mode :docu_plane-mode :layout-mode :others-mode) ) ;;*************************************************************************** ;; BROWSER-Such/Filterfunktionen * ;**************************************************************************** (oli::sd-create-browser-search "parcel-gbrowser" :name "sichtbare-Teile" :title "sichtbare Teile/BGR" :case-sensitive nil :match :all :criteria '( (:column :visible-parts :operation :equals :value "JA") );;criteria );;sd-create-browser-search (oli::sd-create-browser-search "parcel-gbrowser" :name "KM4" :title "Bohrung fÏr KÌfigmutter M4" :case-sensitive nil :match :all :criteria '( (:column :instance-name :operation :equals :value "P_Tool_KM-M4*") );;criteria );;sd-create-browser-search (oli::sd-create-browser-search "parcel-gbrowser" :name "KM6" :title "Bohrung fÏr KÌfigmutter M6" :case-sensitive nil :match :all :criteria '( (:column :instance-name :operation :equals :value "P_Tool_KM-M6*") );;criteria );;sd-create-browser-search ;;*************************************************************************** ;; FUNCTIONS * ;**************************************************************************** (defun browser-display-basis-ATTR-Benennung (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_HLZ_BENENNUNG :attachment :contents) (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_HLZ_BENENNUNG :attachment :contents) ;"n/a" );;if );let );;defun browser-display-ATTR-Benennung ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-ATTR-Typ (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (or (sd-inq-assembly-p node-item) (sd-inq-part-p node-item)) ; (if (sd-inq-part-p node-item) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_HLZ_TYP :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Typ ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-ATTR-Werkstoff (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_HLZ_WERKSTOFF :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Werkstoff ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-ATTR-artikelklasse (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (or (sd-inq-assembly-p node-item) (sd-inq-part-p node-item)) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :ARTIKELKLASSE :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Werkstoff ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-ATTR-Hersteller (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_HLZ_HERSTELLER :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-ATTR-Norm (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_HLZ_NORM :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-ATTR-Oberflaeche (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_HLZ_OBERFLAECHE :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-StammdatenTeilOberflaeche (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_OBERFLAECHE :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-StammdatenOberflaeche (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (or (sd-inq-assembly-p node-item) (sd-inq-part-p node-item)) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_OBERFLAECHE :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-StammdatenWerkstoff (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (or (sd-inq-assembly-p node-item) (sd-inq-part-p node-item)) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_HLZ_WERKSTOFF :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-RenderMaterial (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) ;; jetzt die eigenliche Abfrage (sd-inq-part-render-material node-item ) "n/a" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-ATTR-Aktor (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (or (sd-inq-assembly-p node-item) (sd-inq-part-p node-item)) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :Aktor :attachment :contents) "ist keiner" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-ATTR-Sensor (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (or (sd-inq-assembly-p node-item) (sd-inq-part-p node-item)) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :Sensor :attachment :contents) "ist keiner" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-basis-ATTR-Waerme (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) ;; jetzt die eigenliche Abfrage (sd-inq-item-attribute node-item "LESATECH_BOM_ATTR" :LESA_HLZ_WAERME :attachment :contents) "n/a" );;if );let );;defun browser-display-ATTR-Hersteller ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-contents-density (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) ;;Then... (progn (oli:sd-num-to-string (* 1000 (oli::sd-sys-to-user-units :density (sd-inq-part-density node-item :contents)))) );;progn ;;Else... "n/a" );;if );let );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; irgendwas ist hier faul!?!?!?! (defun browser-display-mass (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-part-p node-item) (oli:sd-num-to-string (sd-call-cmds (get_vol_prop :for_part :part node-item :mass))) "n/a" );;if );let );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-instance-density (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (and (sd-inq-part-p node-item) (sd-inq-part-density node-item :instance)) (oli:sd-num-to-string (oli::sd-sys-to-user-units :density (sd-inq-part-density node-item :instance))) "n/a" );;if );let );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun applicable-density-p (node) (let ((sel-item (oli::sd-pathname-to-obj (oli::BrowserNode-objPath node)))) (when sel-item (oli:sd-inq-part-p sel-item)) );;let );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-name (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (sd-inq-obj-contents-name node-item) (sd-inq-obj-contents-name node-item) (sd-inq-obj-basename node-item) ) );let );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun display-geo-resolution (node) (let ((sel-item (oli::sd-pathname-to-obj (oli::BrowserNode-objPath node)))) (if sel-item (if (oli:sd-inq-part-geo-resolution sel-item) ; neue Teile haben noch keine GEO-Auflösung! (oli:sd-num-to-string (oli:sd-inq-part-geo-resolution sel-item)) "n/a" ) "n/a" );;if );;let );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun applicable-geo-resolution-p (node) (let ((sel-item (oli::sd-pathname-to-obj (oli::BrowserNode-objPath node)))) (when sel-item (oli:sd-inq-part-p sel-item)) );;let );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-display-visible-parts-fnc (node) (let (ret_val obj-visible parent-obj-visible) (setf ret_val "") (setf obj-visible (sd-inq-vp-drawlist-member-p (sd-inq-current-vp) (sd-pathname-to-obj (BrowserNode-objPath node))) ) ; Vaterobjekt muss exisiteren (oberste Baugruppe!) (if (sd-inq-parent-obj (sd-pathname-to-obj (BrowserNode-objPath node))) (setf parent-obj-visible (sd-inq-vp-drawlist-member-p (sd-inq-current-vp) (sd-inq-parent-obj (sd-pathname-to-obj (BrowserNode-objPath node)))) ) nil ) ; nur "JA" wenn: Objekt sichtbar, aber Vaterobjekt nicht sichtbar! (if (and obj-visible (not parent-obj-visible)) (setf ret_val "JA") ) ret_val );let );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun browser-detect-part-type-fnc (node) (let (ret_val) (setf ret_val "") (if (sd-inq-part-p (sd-pathname-to-obj (BrowserNode-objPath node))) (cond ((sd-inq-face-part-p (sd-pathname-to-obj (BrowserNode-objPath node))) (setf ret_val "FLAECHENTEIL"));Flächenteil ((sd-inq-wire-part-p (sd-pathname-to-obj (BrowserNode-objPath node))) (setf ret_val "DRAHTTEIL"));Drahtteil (t (setf ret_val "VOLUMENTEIL"));Volumsteil );cond );if ret_val );let );;defun ;;*************************************************************************************************************************************************** ;; Funktionen zu "direkt speichern" ;;*************************************************************************************************************************************************** ; (defun MenuAction_SaveDirect (obj name) ; (sd-put-buffer (format nil "px-resave-model-dlg :selection ~S complete"(BrowserNode-objPath obj))) ; );;MenuAction_SaveDirect ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun IsVisible_ShowDirect (obj name) (if obj (let* ( (node (BrowserNode-objPath obj)) ;;let* ... node muss zuerst gebunden werden (sequentielles binden der vars) (path (sd-pathname-to-obj node))) (if (and node path) (or (sd-inq-assembly-p path) (sd-inq-part-p path)) ;;when obj is a part or a assembly >> show menu item nil );;if );;let nil );;if );;IsVisible_ShowDirect ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun AIsApplicable_SaveDirect(obj name) ;; when obj is NOT read-only then make it to applicable (not (sd-inq-obj-contents-read-only-p(sd-pathname-to-obj(BrowserNode-objPath obj)))) );;AIsApplicable_SaveDirect ;;*************************************************************************************************************************************************** ;; Funktionen zu MarkObject ;;*************************************************************************************************************************************************** ;;in jeder Menuaction auf gleiche Funktion [MenuAction_MarkObject_Color] verweisen, Farbe als Parameter mitgeben (defun MenuAction_MarkObject_RED (obj name) (MenuAction_MarkObject_Color obj "#FF0000")) (defun MenuAction_MarkObject_YELLOW (obj name) (MenuAction_MarkObject_Color obj "#FFFF00")) (defun MenuAction_MarkObject_BLUE (obj name) (MenuAction_MarkObject_Color obj "#4276F0")) (defun MenuAction_MarkObject_GREEN (obj name) (MenuAction_MarkObject_Color obj "#00CD00")) (defun MenuAction_MarkObject_Color (obj color) (progn (setf BrowserObjectSysID (sd-inq-obj-sysid (sd-pathname-to-obj (BrowserNode-objPath obj)))) (when BrowserObjectSysID (setf (gethash BrowserObjectSysID BrowserObjectColorTable) color) );;when );;progn );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Funktion zum entfernen des Markers (gewählter Node wird aus Hashtable entfernt --> 'border-color-fnc findet Eintrag nicht mehr) (defun MenuAction_ResetMarker (obj name) (declare (ignore name)) (setf BrowserObjectSysID (sd-inq-obj-sysid (sd-pathname-to-obj (BrowserNode-objPath obj)))) (remhash BrowserObjectSysID BrowserObjectColorTable) );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Funktion zum löschen aller Markierungen (Hashtable wird leer gemacht --> 'border-color-fnc findet Eintrag nicht mehr) (defun MenuAction_DeleteMarker (obj name) (progn (clrhash BrowserObjectColorTable) ; (sd-browser-exec-cmd "parcel-gbrowser" :REFRESH-TREE) ; (sd-activate-detail-configuration t) ; (sd-activate-detail-configuration nil) );;progn );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Funktion zum auslesen der Hashtable in abhängikeit von *show-browser-entries-with-defined-color* (defun border-color-fnc (node name) (when *show-browser-entries-with-defined-color* (let ((obj (oli:sd-pathname-to-obj (BrowserNode-objPath node)))) (when obj (gethash (sd-inq-obj-sysid obj) BrowserObjectColorTable) ; (display (format nil "HashTableEntries : ~A" (hash-table-count BrowserObjectColorTable ))) ; (pprint (format nil "Objektpfad : ~A" (BrowserNode-objPName obj))) );;when );;let );;when );;defun ;;*************************************************************************** ;; BROWSERABFRAGE !!! wird permanent ausgeführt!!! * ;;*************************************************************************** (sd-browser-add-interrogator "parcel-gbrowser" :interrogator-type :border-color :interrogator-func 'border-color-fnc );;sd-browser-add-interrogator ;;*************************************************************************** ;; BROWSER-Kontextmenueinträge * ;**************************************************************************** ;;direkt speichern ;(sd-browser-add-popup-entry ; "parcel-gbrowser" ; :entry-type :push ; :label "direkt speichern" ; :is-entry-visible 'IsVisible_ShowDirect ; :is-entry-applicable 'AIsApplicable_SaveDirect ; :menu-action 'MenuAction_SaveDirect ; :new-group t ; ;);;sd-browser-add-popup-entry ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;;Marker ; Das Markieren von gewählten Browsereinträgen (Baugruppen und Teilen) läuft wie folgt ab: ; - Browserabfrage erzeugen (sd-browser-add-interrogator...) !!!diese wird dann permanent ausgeführt!!! ; Hier wird laufend geprüft ob eine Objekt via seiner SysID in der Hashtable gefunden wird. ; Wenn ja, dann wird die Farbe aus der Hashtable genommen und das Objekt entsprechend markiert! ; Wenn nein, dann passiert nix! ; - Erzeugen einer Hashtable (BrowserObjectColorTable) um die Browserobjekte mit den dazu gewählten Farben zu speichern --> (setq BrowserObjectColorTable (make-hash-table :test 'equal)) ; - Einbauen der entsprechenden Einträge im Kontextmenu der rechten Maustaste (sd-browser-add-popup-entry ...) ; - Beim anklicken eines entsprechenden Eintrags wird die dazugehörende MenuAction ausgeführt. Hier wird die [BrowserObjectSysID] vom gewählten Objekt geholt ((setf BrowserObjectSysID...) ; und mit der entsprechenden Farbe in die Hashtable geschrieben ((setf (gethash BrowserObjectSysID...) ; - in der Funktion MenuAction_ResetMarker wird lediglich der Eintrag des gewählten Objektes aus der Hashtable gelöscht (sd-browser-add-popup-entry "parcel-gbrowser" :entry-type :push :label "ROT markieren" :is-entry-visible 'IsVisible_ShowDirect ;; -> nur wenn Objekt ein Teil oder eine Baugruppe ist :menu-action 'MenuAction_MarkObject_RED :new-group t );;sd-browser-add-popup-entry (sd-browser-add-popup-entry "parcel-gbrowser" :entry-type :push :label "GELB markieren" :is-entry-visible 'IsVisible_ShowDirect ;; -> nur wenn Objekt ein Teil oder eine Baugruppe ist :menu-action 'MenuAction_MarkObject_YELLOW :new-group nil );;sd-browser-add-popup-entry (sd-browser-add-popup-entry "parcel-gbrowser" :entry-type :push :label "BLAU markieren" :is-entry-visible 'IsVisible_ShowDirect ;; -> nur wenn Objekt ein Teil oder eine Baugruppe ist :menu-action 'MenuAction_MarkObject_BLUE :new-group nil );;sd-browser-add-popup-entry (sd-browser-add-popup-entry "parcel-gbrowser" :entry-type :push :label "GRÛN markieren" :is-entry-visible 'IsVisible_ShowDirect ;; -> nur wenn Objekt ein Teil oder eine Baugruppe ist :menu-action 'MenuAction_MarkObject_GREEN :new-group nil );;sd-browser-add-popup-entry ;Marker zurücksetzen (sd-browser-add-popup-entry "parcel-gbrowser" :entry-type :push :label "entferne Markierung" :is-entry-visible 'IsVisible_ShowDirect ;; --> nur wenn Objekt ein Teil oder eine Baugruppe ist :menu-action 'MenuAction_ResetMarker :new-group nil );;sd-browser-add-popup-entry ;alle Marker löschen (sd-browser-add-popup-entry "parcel-gbrowser" :entry-type :push :label "alle Markierungen lÎsche" ; :is-entry-visible 'IsVisible_ShowDirect ;; --> immer anzeigen :menu-action 'MenuAction_DeleteMarker :new-group t );;sd-browser-add-popup-entry ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;(trace border-color-fnc)