(in-package :custom) (use-package :OLI) (sd-defdialog 'dc4-anno-unsichtbare-teile-umfaerben-dialog :dialog-title "Unsichtbar umfaerben." ;;:dialog-control :sequential :variables '( (owner) (teil_bgr :selection (*sd-object-seltype*) :multiple-items t :show-select-menu t :prompt-text "Teil oder Baugruppe angeben" :title "Teil" ;;:initial-value nil ) (ansicht :selection *sd-anno-view-seltype* :title "Ansicht" :prompt-text "Ansicht angeben, in welcher die Teile/Baugruppen umgefaerbt werden soll" :multiple-items nil :initial-optional nil :after-input (ansicht-action) :check-function #'(lambda (ans) (let () (if (sd-am-view-struct-view-3d (sd-am-inq-view ans)) :ok (values :error "Diese Ansicht hat keine 3D-Repraesentation!") );;if );;let );;lambda ) (farbe :range (("BLACK" :label "Schwarz") ("WHITE" :label "Weiss") ("RED" :label "Rot") ("GREEN" :label "Gruen") ("BLUE" :label "Blau") ("YELLOW" :label "Gelb") ("CYAN" :label "Cyan") ("MAGENTA" :label "Magenta")) :title "Farbe" :initial-value "YELLOW" ) (linart :range (("SOLID" :label "Solid") ("DASHED" :label "Strichliert") ("LONG_DASHED" :label "Lang Strichl.") ("DOT_CENTER" :label "Strichpunkt") ("DASH_CENTER" :label "Lang Strichp.") ("PHANTOM" :label "___ _ _ __") ("CENTER_DASH_DASH" :label "__..__") ("DOTTED" :label "Punktiert")) :title "Linienart" :initial-value "LONG_DASHED" ) (next :push-action (sd-call-cmds (next-action)) ) ) :local-functions '( (ansicht-action () (let () (setf owner (sd-am-view-set-struct-owner (sd-am-inq-view-set (sd-am-view-struct-view-set (sd-am-inq-view ansicht )))) );;setf );;let ) (next-action () (sd-call-cmds (dc4-anno-faerbe-unsichtbare-teile-um teil_bgr ansicht farbe linart owner)) ) ) :ok-action '(next-action) :help-action '() ) ;;--------------------------------------------------------------------------* ;;--------------------------------------------------------------------------* ;; Faerbt die unsichtbaren Linien alle Teile ;; in der ausgewaehlten Baugruppe "teil_bgr" um (funktioniert nur mit Annotation) ;; (defun dc4-anno-faerbe-unsichtbare-teile-um (teil_bgr_list ansicht farbe linart owner) (let (teil_bgr) (docu::docu-enable-update-view-warning nil) (dolist (teil_bgr teil_bgr_list) (dc4-anno-faerbe-unsichtbare-teile-um-in-unterbgr teil_bgr ansicht farbe linart owner) );;dolist );;let ) (defun dc4-anno-faerbe-unsichtbare-teile-um-in-unterbgr (teil_bgr ansicht farbe linart owner) (let (kind kinder ppath opath olist ostr ansname shname me10path comstring) (if (sd-inq-part-p teil_bgr) (progn (setf ppath (sd-inq-obj-pathname teil_bgr)) (setf opath (sd-inq-obj-pathname owner)) (setf olist (sd-string-split opath "/")) (setf olist (butlast olist)) (setf opath "") (dolist (ostr olist) (setf opath (format nil "~a/~a" opath ostr)) );;dolist (setf ppath (subseq ppath (- (length opath) 1))) (setf ansname (sd-am-view-struct-name (sd-am-inq-view ansicht))) (setf shname (sd-am-sheet-struct-name (sd-am-inq-sheet (sd-am-view-struct-sheet (sd-am-inq-view ansicht))))) (setf me10path (format nil "/~a/~a~a" shname ansname ppath)) (setf comstring (format nil "~a '~a'~%~a ~a ~a~%~a ~a ~a~%~a~%~a" "EDIT_PART" me10path "CHANGE_COLOR" farbe "SELECT GEO ALL AND INFOS 'SD_H' CONFIRM END" "CHANGE_LINETYPE" linart "SELECT GEO ALL AND INFOS 'SD_H' CONFIRM END" "ADD_ELEM_INFO 'GEOMETRY_ATTRIBUTES_CHANGED_IN_MEXX' SELECT GEO ALL AND INFOS 'SD_H' CONFIRM END" "EDIT_PART TOP" )) (sd-execute-annotator-command :cmd comstring) );;progn (when (or (sd-inq-assembly-p teil_bgr) (sd-inq-container-p teil_bgr)) (progn (setf kinder (sd-inq-obj-children teil_bgr)) (dolist (kind kinder) (dc4-anno-faerbe-unsichtbare-teile-um-in-unterbgr kind ansicht farbe linart owner) ) ;; dolist ) ;; progn ) ;; when );;if );;let )