;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Filename: sd_structure_browser_interrogator_test.lsp ;; Project: privat ;; Description: test dialog for browser interrogators ;; Version: 90.0x ;; Languages UI: english, german ;; ;; Customer: --cadde-- ;; Author: der_Wolfgang@forum@cad.de ;; Created: Mon Sep 29 13:23:59 CEST 2025 ;; Modified: Tue Sep 30 10:03:47 CEST 2025 der_Wolfgang@forum@cad.de ;; SD-Version: developed with PE90, ;; should work in older versions as well as in big Modeling ;; should work in newer versions, too, PE and big Modeling ;; reference: https://ww3.cad.de/foren/ubb/Forum92/HTML/000325.shtml ;; https://ww3.cad.de/foren/ubb/Forum92/HTML/000503.shtml ;; https://ww3.cad.de/foren/ubb/Forum92/HTML/000624.shtml ;; https://ww3.cad.de/foren/ubb/Forum92/HTML/000650.shtml ;; https://ww3.cad.de/foren/ubb/Forum92/HTML/001029.shtml ;; https://ww3.cad.de/foren/ubb/Forum29/HTML/004580.shtml ;; https://ww3.cad.de/foren/ubb/Forum29/HTML/004868.shtml#000005 ;; .. and some other threads ;; ;; Language: Lisp ;; Package: :cadde ;; ;; (C) Copyright 2025 der_Wolfgang@forum@cad.de, all rights reserved. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 20240930: finalize version 1.0 - der_Wolfgang@forum@cad ;; 20240929: adding second example to cover assembly mass calculation - der_Wolfgang@forum@cad ;; 20240929: initial version ~3h - der_Wolfgang@forum@cad ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package :cadde-wt) (use-package :oli) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (sd-defdialog 'sd_structure_browser_interrogator_test :dialog-title '(sd-multi-lang-string "Interrogator Test") :toolbox-button :force :variables '( (objects ;:selection (*sd-assembly-seltype* *sd-part-seltype*) :selection (*sd-3d-object-seltype*) ;; ganz generisch :title (sd-multi-lang-string "Objects(s)" :german "Objekt(e)") :modifies NIL :multiple-items T :after-input (dolist (a-item objects) (call-interrogator a-item)) :next-variable 'objects ) (duration-output :value-type :boolean :toggle-type :wide-toggle :title " " :title-alignment :center :initial-enable nil :indicator-type :none ) (repeat_call :value-type :positive-number :title (sd-multi-lang-string "Repeat X Times" :german "Wiederhole Aufruf") :check-function (lambda(n)(if(zerop n):error :ok)) :initial-value 1 :auto-add-proposal t :proposals-order :sorted :proposals '(1 10 20 50 100 200 500 1000 2000 5000) :persistent-data-storage T :next-variable 'objects ) (show_result :value-type :boolean :title (sd-multi-lang-string "Show Every Interrogator Result" :german "Zeige Jedes Abfrage Ergebnis") :toggle-type :wide-toggle :persistent-data-storage T :next-variable 'objects ) ) ;; end variables :local-functions '( (call-interrogator (item) (let* (t1 t2 td g1 g2 (obj-pathname (sd-inq-obj-pathname item)) (browser-node (g-browser::make-browsernode :objpath obj-pathname)) ;; all others are nil res ) (setq t1 (frame2::SECONDS-SINCE-1970) g1 (system::gbc-count)) (dotimes (i repeat_call) ;; We invoke the interrogator function directly using a dummy browser node and capture the result, which would normally be displayed in a browser column. ;; (setq column-display-string (browser-interrogator-function-name the-browser-node)) (sd-call-cmds (setq res ( ;; browser-inq-part-type ;; your Interrogator function to test ;; browser-display-contents-density ;; deine zu testende Abfrage Funktion ;; browser-display-obj-volume ;; deine zu testende Abfrage Funktion browser-display-obj-mass ;; deine zu testende Abfrage Funktion browser-node)) :failure (let ((problem-is (sd-inq-error-obj :all))) (setq res :error) (format T "~&#### INTERROGATOR problem with ~S~%~{~S~^ ~}~%" obj-pathname problem-is) ) ) (when show_result (format T "~&### Interrogator: [~S] for ~S~%" res (or obj-pathname "???"))) ) (unless show_result (format T "~&### Interrogator: [~S] for ~S (result of last call)~%" res (or obj-pathname "???"))) (setq t2 (frame2::SECONDS-SINCE-1970) g2 (system::gbc-count)) (setq td (- t2 t1)) (setq td (/ td repeat_call)) (format T "~&### Interrogator: duration ~10,5F sec and took ~3D GBC~:p ~%" td (- g2 g1)) (sd-set-variable-status 'duration-output :title (if (< td 0.002) (sd-multi-lang-string "Interrogator was fast." :german "Abfrage ging fix.") (format nil "~A ~8,3F sec." (sd-multi-lang-string "Interrogator took:" :german "Abfrage brauchte:") td) )) )) ;; end let+defun ) ;; end :local-functions ;after-initialization '(nix) ) ;; end dialog ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; just one test example: ;; see https://ww3.cad.de/foren/ubb/upl/M/Michael318/custom_browser_views.lsp for the original ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun browser-inq-part-type (node) (let ((ret-val "") (obj-item (sd-pathname-to-obj (BrowserNode-objPath node))) ) (when (and obj-item (sd-inq-part-p obj-item)) (cond ((sd-inq-empty-part-p obj-item) (setq ret-val (sd-multi-lang-string "empty part" :german "leeres Teil"))) ((sd-inq-face-part-p obj-item) (setq ret-val (sd-multi-lang-string "face part" :german "Flächenteil"))) ((sd-inq-wire-part-p obj-item) (setq ret-val (sd-multi-lang-string "wire part" :german "Drahtteil"))) (t (setq ret-val (sd-multi-lang-string "solid part" :german "Volumenteil"))) );cond ) ret-val )) ;; end let+defun ;; just one MORE test example (a bad one): (defun browser-display-obj-mass-with-ERROR-with-workplane (node) (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) ;; (if (or (sd-inq-part-p node-item) (sd-inq-assembly-p node-item)) (sd-num-to-string (sd-sys-to-user-units :mass (frame2::getres (get_vol_prop :for_part :part_asmb node-item :mass)))) ;; teuer! ;; "n/a" ;; ) ;; part or assembly? )) ;; end let+defun ;; just one MORE test example (a good one): (defun browser-display-obj-mass (node) ;; WITHOUT-ERROR-with-workplane (let ((node-item (sd-pathname-to-obj (BrowserNode-objPath node)))) (if (or (sd-inq-part-p node-item) (sd-inq-assembly-p node-item)) (let ((res (frame2::getres (get_vol_prop :for_part :part_asmb node-item :mass)))) ;; teuer! (if (numberp res) (format nil "~10,3F" (sd-sys-to-user-units :mass res)) "??" ;; fehler bei Masse Berechung ) ) "-" ;; Objekt hat keine Masse! ) ;; part or assembly? )) ;; end let+defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;