;********************************************************************************************* ; Dateiname : SD_PrepareForRendering.lsp ; Autor : Stephan Wörz ; Erstellt : 20.01.2017 ; geändert : 02.03.2018 ;********************************************************************************************* ; Beschreibung: - bereitet Baugruppe zum STEP-Export vor ; - ;********************************************************************************************* ;********************************************************************************************* ; ToDo's: - geschützte nicht grundsätzlich löschen ; - ;********************************************************************************************* ; Details : ; : (IO) Benutzer nimmt Schlösschen weg ; : (IO) Attribute aktualisieren ; DEN_Al-01_ Materialzuweisung über Dichte ; MAT_Al-01_ Materialzuweisung über Werkstoff ; SUR_Al-01_ Materialzuweisung über Oberfläche ; NAM_Al-01_ Materialzuweisung über Teilebenennung ; COL_Al-01_ Materialzuweisung über Teilefarbe ; Attribute aktaulisieren? ; Kopie über alles? ; STEP-Export ?? ; Auswahl RAM M / RAL N ;********************************************************************************************* ; ä Ì Ä Ø ö Î Ö Ú ü Ï Ü Û ß Þ ° ³ µ ó ; ;; (Display (format nil "Name~20T: Stephan") ~20T >> Setzt Cursor in Spalte 20!! ; ;; (Display (format nil "Name~%: Stephan") ~% >> Erzeugt Zeilenumbruch!!!!!! ;********************************************************************************************* (in-package :schiller) (use-package :oli) ;; load corresponding data from same directory > Laden der Parameter (load (format nil "~A/SD_PrepareForRendering_StringLists" (directory-namestring *load-truename*))) ;; Schlösser müssen weg!!! >> Phoenix-Admin!! (sd-hide-console-window) ;(sd-show-console-window) ;;Such errors can be debugged in more detail by enabling the built-in Lisp debugger: ;(setf si::*enter-break-handler* t) ;;capture all Lisp input and output to a file: ;(dribble "c:/temp/LISP_Debugger_logfile.txt") ;; (pprint "Diese Datei wurde geladen wie folgt:") ;; (pprint *load-truename*) ;; ;; (pprint "Der aktuelle Dateiname ist:") ;; (pprint (file-namestring *load-truename*)) ;; ;; (pprint "Das Verzeichnis aus dem diese Datei geladen wurde:") ;; (pprint (directory-namestring *load-truename*)) ;; (pprint "als Anwendungsfall:") ;; (trace sd-create-image) ;; (sd-create-image "SchleifFreistich-1" ;; :filename (format nil "~ASchleifFreistich-1" (directory-namestring *load-truename*)) ;; ) ;; (untrace sd-create-image) ;; (defvar *SetPartColor* t) (sd-defdialog 'SD_PrepareForRendering :dialog-title "Prepare for Rendering [1]" :toolbox-button t :variables '( (Quelle :modifies nil :initial-value nil :value-type :assembly :prompt-text "Quelle-Baugruppe angeben" :title "Baugruppe" ); end Quelle ;; ("Optionen") ;; ;; (SetPartColor ;; :title "Teile umfaerben" ;; :value-type :boolean ;; :toggle-type :wide-toggle ;; :initial-value t ;; );;SetPartColor ("lÎeschen") (Normteile :title "Normteile" :value-type :boolean :toggle-type :wide-toggle :initial-value nil );;Normteile (Nutensteine :title "Nutensteine" :value-type :boolean :toggle-type :wide-toggle :initial-value nil );;Nutensteine (DelContainer :title "BehÌlter" :value-type :boolean :toggle-type :wide-toggle :initial-value nil );;Nutensteine (DelFaceColors :title "FlÌchenfarben" :value-type :boolean :toggle-type :wide-toggle :initial-value nil );;DelFaceColors ) ;end variables :ok-action '(progn ;;Optionen verarbeiten (if Normteile ;;then.. (progn (setf Suchstring "N*") (mapcar #'DeleteParts (SelectAllParts Quelle)) );;progn ;;else.. () );;if (if Nutensteine ;;then.. (progn (setf Suchstring "*Nutenstein*") (mapcar #'DeleteParts (SelectAllParts Quelle)) );;progn ;;else.. () );;if (if DelContainer ;;then.. (progn (sd-call-cmds (delete_3d (SelectAllContainers Quelle))) );;progn ;;else.. () );;if ;;ENDE Optionen verarbeiten ;;Objekte der 1. Ebene verarbeiten ;; (dolist (objekt (sd-inq-obj-children Quelle)) ;; (progn ;; (if (sd-inq-assembly-p objekt) ;;wenn es eine Baugruppe ist ;; ;;THEN ;; (ProcessAssy objekt) ;; ;;ELSE ;; (ProcessParts objekt) ;; );;if ;; );;progn ;; );;dolist ;; (Display (format nil "-----------------------------------~%Starte die Verarbeitung von : ~A~%-----------------------------------" (sd-inq-obj-basename Quelle))) (ProcessAssy Quelle) );end progn :local-functions '( ;; Function zum löschen der selektierten Teile (DeleteParts (item) (if (sd-string-match-pattern-p SuchString (sd-inq-obj-basename item)) ;;then... (progn (sd-call-cmds (delete_3d (sd-inq-obj-pathname item))) );;progn ;;else... () );;if );end DeleteParts );;local-functions;; ) ;enddefdialog ;; ------------------------------------------------------------------------------------------------------------------------------------------------- ;; F U N K T I O N E N ;; ------------------------------------------------------------------------------------------------------------------------------------------------- ;; Funktion zum wählen aller Teile rekursiv in Baugruppe (defun SelectAllParts (Assy) (sd-call-cmds (get_selection :focus_type *sd-part-seltype* :allow_face_part :allow_wire_part :select :recursive :in_assembly Assy)) );;SelectAllParts ;; ------------------------------------------------------------------------------------------------------------------------------------------------- ;; Funktion zum wählen aller Baugruppen rekursiv in Baugruppe (defun SelectAllAssies (Assy) (sd-call-cmds (get_selection :focus_type *SD-ASSEMBLY-SELTYPE* :select :recursive :in_assembly Assy)) );;SelectAllAssies ;; ------------------------------------------------------------------------------------------------------------------------------------------------- ;; Funktion zum wählen aller Behälter rekursiv in Baugruppe (defun SelectAllContainers (Assy) (sd-call-cmds (get_selection :focus_type *sd-container-seltype* :select :recursive :in_assembly Assy)) );;SelectAllContainers ;; ------------------------------------------------------------------------------------------------------------------------------------------------- ;; Funktion zum löschen von Flächenfarben (nur: Passung, Gewinde, Hub, Sicherheitsbereich, Fräsen, ...) >> andere Flächenfarben bleiben zum Zwecke der Visualisierung erhalten (defun RemoveFaceColor (Teil) ;;(setf FacesToClear nil) ;; (Display (format nil "RemoveFaceColor ~A" (sd-inq-obj-basename Teil))) ;; (sd-call-cmds (get_selection :focus_type *sd-face-seltype* ;; :check_function #'CheckReserverdFaceColors ;; :select :selected_part Teil :all_3d) ;; :failure (setf FacesToClear nil) ;; :success (setf FacesToClear *SD-ACTION-RESULT*) ;; );;sd-call-cmds ;;(Display (format nil "FacesToClear ~A" FacesToClear)) (dolist (SingleFace (sd-call-cmds (get_selection :focus_type *sd-face-seltype* :check_function #'CheckReserverdFaceColors :select :selected_part Teil :all_3d) :failure (setf FacesToClear nil) :success (setf FacesToClear *SD-ACTION-RESULT*) );;sd-call-cmds ) (face_prop :the_face SingleFace :COLOR :OFF );;face_prop );;dolist );;RemoveFaceColor ;; ------------------------------------------------------------------------------------------------------------------------------------------------- ;; ... das ist die >> :check_function << ;; auf Flächenfarben prüfen (defun CheckReserverdFaceColors (FaceToCheck) (let ((thisFaceColor (sd-inq-face-color FaceToCheck))) (if (and thisFaceColor ;;wenn eine Flächenfarbe existiert (or ;; und wenn dann noch Farbe Passung oder Gewinde oder ... >>> dann wird gelöscht! (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 0.50196081399917603 0.0 0.0 ):resolution 1e-3) ;; Passung (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 0.0 0.0 0.50196081399917603 ):resolution 1e-3) ;; Gewinde (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 0.0 1.0 0.0 ):resolution 1e-3) ;; Hub (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 1.0 0.0 0.0 ):resolution 1e-3) ;; Sicherheitsbereich (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 0.58039218187332153 0.58039218187332153 0.19607844948768616 ):resolution 1e-3) ;; Fräsen (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 0.58823531866073608 0.58823531866073608 0.19607844948768616 ):resolution 1e-3) ;; Fräsen (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 0.0 0.0 1 ):resolution 1e-3) ;; Bedienelemete (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 0.0 0.0 1.0 ):resolution 1e-3) ;; Steckanschlüsse (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 1.0 0.0 1.0 ):resolution 1e-3) ;; Cabeling-Pins (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 0.89803928136825562 0.50196081399917603 0.0 ):resolution 1e-3) ;; Service (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 0.0 1.0 1.0 ):resolution 1e-3) ;; Absteckbohrungen (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 1.0 0.0 1.0 ):resolution 1e-3) ;; Cabling-Steckerdefinitionen (SD-VEC-EQUAL-P thisFaceColor (gpnt3d 1.0 0.63137257099151611 0.60000002384185791 ):resolution 1e-3) ;; alte "rosarote" Gewinde );;or );;and :Ok ;; Rückgabewert wenn ITEM akzeptiert wurde :filter ;; Rückgabewert wenn ITEM abgelehnt wurde - Item kommt nicht in die Liste von "get_selection" );;if );;let );;SelectReserverdFaceColors ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Zuordnen der Materialeigenschaften >> Teil für Teil ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun ProcessAssy (Baugruppe) ;; Wenn eine Baugruppe ein Oberflächenattribut hat dann trifft das auf alle Kinder zu >> Wenn Baugruppe lackiert, dann alles lackiert! ;; Oberfläche aus Attribut ":LESA_OBERFLAECHE" auslesen (let ( (Oberflaeche (sd-inq-item-attribute Baugruppe "LESATECH_BOM_ATTR" :LESA_OBERFLAECHE :attachment :contents)) (Teile (SelectAllParts Baugruppe)) (Kinder (sd-inq-obj-children Baugruppe))) ;;ALLE KINDER >> nur 1. EBENE!! ;; Wenn Attribut [LESA_OBERFLAECHE] gar nicht vorhanden oder Eintrag NULL ist (if (or (not Oberflaeche) (string= Oberflaeche "") );;or ;;THEN 1.1 >> keine Baugruppenoberfläche gesetzt >> ggf. Benennung der Baugruppe zur Definition der Teilefarbe aller Teile verwenden (if (get-MaterialPostfix-by-AssyNamePattern Baugruppe) ;;wenn hier nicht nil zurück kommt ;;THEN 1.2 (progn ;; (Display (format nil "[ProcessAssy] >> THEN 1.2 >> ~A :[AssyNamePattern] liefert Ergebnis ~80T >> Baugruppe und ALLE Teile rekursiv unter der Baugruppe werden umbenannt" (sd-inq-obj-basename Baugruppe) )) ;;Baugruppe umbenennen (Rename Baugruppe (get-MaterialPostfix-by-AssyNamePattern Baugruppe)) ;;Kind-Teile der Baugruppe umbenennen >> Teile in Baugruppe wählen >> Variable "Teile" definieren (dolist (Teil Teile) (Rename Teil (get-MaterialPostfix-by-AssyNamePattern Baugruppe)) );;dolist );;progn ;;ELSE 1.2 >> Keine definierte Baugruppenbenennung >> Über die Baugruppeneigenschaften kommt nichts ;; >> dann die Kinder der Baugruppe untersuchen (progn ;; (Display (format nil "[ProcessAssy] >> ELSE 1.2 >> ~A :Über die Baugruppeneigenschaften kommt nichts ~100T >> die 1. Ebene der Quelle wird untersucht" (sd-inq-obj-basename Baugruppe) )) (dolist (Kind Kinder) ;; Wenn Kind ein Teil ist (if (sd-inq-part-p Kind) ;;THEN (progn ;;- Exemplarfarbe von Teil löschen (sd-call-cmds (set_part_inst_color :parts Kind :clr)) ;;- Teil verarbeiten (ProcessParts Kind) );;progn ;;ELSE ;; Wenn Kind eine Baugruppe ist (if (sd-inq-assembly-p Kind) ;;THEN (ProcessAssy Kind) ;;ELSE () ;nix tun );;if );;if );;dolist );;progn );;if ;;ELSE 1.1 >> wenn Oberfläche gesetzt >> Oberflächenattribut der Baugruppe zur Definition der Teilefarbe ALLER Kindobjekte verwenden (progn ;;Baugruppe zur automatischen Verarbeitung in Keyshot umbenennen ;; (Display (format nil "[ProcessAssy] >> ELSE 1.1 >> OF-Attribut ist vorhanden : ~A ~80T >> Die Baugruppe und alle Teile (~A) werden anhand der Baugruppeneigenschaft umbenannt" (get-MaterialPostfix-by-SurfacePattern Oberflaeche) (length Teile))) (Rename Baugruppe (get-MaterialPostfix-by-SurfacePattern Oberflaeche)) ;;Teile zur automatischen Verarbeitung in Keyshot umbenennen (dolist (Teil Teile) (progn ;; (Display (format nil "[ProcessAssy] >> ELSE 1.1 >> Teil umbenennen: ~A" (sd-inq-obj-basename Teil))) ;(sd-call-cmds (set_part_inst_color :parts Teil :clr)) (if (get-MaterialPostfix-by-SurfacePattern Oberflaeche) ;;THEN (Rename Teil (get-MaterialPostfix-by-SurfacePattern Oberflaeche)) ;;ELSE (Rename Teil "NONE_MAT_") );;if );;progn );;dolist );;progn );;if );;let );;ProcessAssy (defun ProcessParts (Teil) (let ((Oberflaeche (sd-inq-item-attribute Teil "LESATECH_BOM_ATTR" :LESA_OBERFLAECHE :attachment :contents)) (Material (sd-inq-item-attribute Teil "LESATECH_BOM_ATTR" :Lesa_HLZ_Werkstoff :attachment :contents))) (if (or ;;Wenn es das Attribut :LESA_OBERFLAECHE gar nicht gibt, oder (not Oberflaeche) ;;Wenn das Attribut :LESA_OBERFLAECHE existiert aber keinen Wert hat, oder (string= Oberflaeche "") ;;Wenn das Attribut :LESA_OBERFLAECHE den Wert "< keine Oberfläche >" hat, oder (sd-string-match-pattern-p "< keine Oberfl*che >" Oberflaeche) ;;Wenn das Attribut :LESA_OBERFLAECHE den Wert "." hat (sd-string-match-pattern-p ".*" Oberflaeche) );;or ;;THEN >> Oberflächenattribut existiert nicht >> untersuchen auf Werkstoff (if (or ;;Wenn es das Attribut :Lesa_HLZ_Werkstoff gar nicht gibt, oder (not Material) ;;Wenn das Attribut :Lesa_HLZ_Werkstoff existiert aber keinen Wert hat (string= Material ""));;or ;;THEN >> schauen ob es ein Muster für die Benennung gibt (if (not (get-Material-by-PartNamePattern Teil)) ;;wenn hier nil zurückkommt ;;THEN >> schauen ob es eine Entsprechung für die Dichte gibt (if (not (get-MaterialPostfix-by-PartDensity Teil)) ;;wenn hier nil zurückkommt ;;THEN >> Schauen ob wir über die Teilfarbe weiterkommen (if (get-MaterialPostfix-by-PartColor Teil) ;;THEN (Rename Teil (get-MaterialPostfix-by-PartColor Teil)) ;;ELSE (Rename Teil "NONE_COL_") );;if ;;ELSE >> über Teiledichte (Rename Teil (get-MaterialPostfix-by-PartDensity Teil)) );;if ;;ELSE >> über Teilename (Rename Teil (get-Material-by-PartNamePattern Teil)) );;if ;;ELSE >> Materialattribut existiert >> es könnte aber sein dass dieses nicht in der Stringlist zu finden ist!! >> dann kommt nil (if (get-MaterialPostfix-by-MaterialPattern Material) ;;THEN (Rename Teil (get-MaterialPostfix-by-MaterialPattern Material)) ;;ELSE (Rename Teil "NONE_MAT_") );;if );;if ;;ELSE >> Oberflächenattribut existiert (Rename Teil (get-MaterialPostfix-by-SurfacePattern Oberflaeche)) );;if );let );;ProcessParts ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Präfix in Abhängigkeit zur Teiledichte setzen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun get-MaterialPostfix-by-PartDensity (Teil) ;; Dichte des Teils ermitteln (Setq PartDensity (sd-inq-part-density Teil)) ;;Material auswerten und Teilefarbe entsprechend setzen ;;cond prüft bis eine Bedingung = t (letzte Zeile ist t > wird ausgeführt wenn oben nichts passt!) (cond ((equal PartDensity 0.0079000000000000008 ) "__DEN_VA-01" ) ((equal PartDensity 0.0078499999999999993 ) "__DEN_ST-01" ) ((equal PartDensity 0.0027499999999999998 ) "__DEN_AL-01" ) ((equal PartDensity 0.0011299999999999999 ) "__DEN_RUBBER-01" ) ((equal PartDensity 0.0014 ) "__DEN_KUNSTSTOFF-01" ) ((equal PartDensity 0.0011999999999999999 ) "__DEN_PC-KLAR-01" ) ;; (t (get-MaterialPostfix-by-PartColor Teil )) ;;wenn die Dichte kein Ergebnis bringt schauen wir nach der Teilefarbe (t nil ) ;;fallback >> wenn die Dichte kein Ergebnis );;cond );;get-MaterialPostfix-by-PartDensity ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Präfix in Abhängigkeit zur Teilefarbe setzen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun get-MaterialPostfix-by-PartColor (Teil) (setq Teilefarbe (sd-inq-part-color Teil)) (cond ;;mit :resolution 1e-3 kann ein gewisser Toleranzbereich definiert werden >> Vector (Farbe muss NICHT 100%ig stimmen!!) ((SD-VEC-EQUAL-P Teilefarbe (gpnt3d 1.0 1.0 0.20000001788139343 ) :resolution 1e-3 ) "__COL_SENSOR" ) ((SD-VEC-EQUAL-P Teilefarbe (gpnt3d 0.94117653369903564 0.31764706969261169 0.36078432202339172 ) :resolution 1e-3 ) "__COL_HILFSTEIL" ) ((SD-VEC-EQUAL-P Teilefarbe (gpnt3d 0.84705889225006104 0.84705889225006104 0.84705889225006104 ) :resolution 1e-3 ) "__COL_PNEUMATIK-TEIL" ) ((SD-VEC-EQUAL-P Teilefarbe (gpnt3d 0.0 0.60000002384185791 1.0 ) :resolution 1e-3 ) "__COL_PNEUMATIK-AKTOR" ) ((SD-VEC-EQUAL-P Teilefarbe (gpnt3d 0.0 0.0 0.69411766529083252 ) :resolution 1e-3 ) "__COL_VENTIL" ) ((SD-VEC-EQUAL-P Teilefarbe (gpnt3d 0.70196080207824707 0.90196084976196289 1.0 ) :resolution 1e-3 ) "__COL_ST-01" ) ((SD-VEC-EQUAL-P Teilefarbe (gpnt3d 0.84313732385635376 0.54901963472366333 0.15686275064945221 ) :resolution 1e-3 ) "__COL_ORANGE" ) (t nil ) );;cond );;get-MaterialPostfix-by-PartColor ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Präfix in Abhängigkeit zur Baugruppenbenennung setzen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun get-MaterialPostfix-by-AssyNamePattern (Baugruppe) (let ((Baugruppenname (sd-inq-obj-basename Baugruppe))) ;; dolist arbeitet die Liste der Parameter durch >> es kommt jeweils eine Liste 2 Elementen Bsp. ("*Schriftzug_600_mm_blau*" "__NAM_SCHILLER-BLAU") (dolist (a-mat-ANP *material-by-assyname*) ;car = 1. Element einer Liste cadr = letztes Element einer Liste ;wenn (car a-mat-ANP) Bsp. "*Schriftzug_600_mm_blau*" dann (return (cadr a-mat-ANP)) >> "__NAM_SCHILLER-BLAU" (when (sd-string-match-pattern-p (car a-mat-ANP) Baugruppenname) ;;THEN (return (cadr a-mat-ANP)) ;;ELSE (return nil) ;; absolute fallback fallback :-D );;when );;dolist );;let );;get-MaterialPostfix-by-AssyNamePattern ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Präfix in Abhängigkeit zur Teilebenennung setzen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun get-Material-by-PartNamePattern (Teil) (let ((Teilename (sd-inq-obj-basename Teil))) (dolist (a-mat-PNP *material-by-partname*) ;car = 1. Element einer Liste cadr = letztes Element einer Liste (when (sd-string-match-pattern-p (car a-mat-PNP) Teilename) ;;THEN (return (cadr a-mat-PNP)) ;;ELSE (return nil) ;; absolute fallback fallback :-D );;when );;dolist );;let );;get-Material-by-PartNamePattern ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Präfix in Abhängigkeit des Materialattributs setzen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun get-MaterialPostfix-by-MaterialPattern (Material) (dolist (a-mat-PNP *material-by-material*) ;car = 1. Element einer Liste cadr = 2. Element einer Liste (when (sd-string-match-pattern-p (car a-mat-PNP) Material) ;;THEN (return (cadr a-mat-PNP)) ;;ELSE (return nil) ;; absolute fallback fallback :-D );;when );;dolist );;get-MaterialPostfix-by-MaterialPattern ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Präfix in Abhängigkeit des Oberflächenattributs setzen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun get-MaterialPostfix-by-SurfacePattern (Oberflaeche) (dolist (a-mat-PNP *material-by-surface*) ;car = 1. Element einer Liste cadr = 2. Element einer Liste (when (sd-string-match-pattern-p (car a-mat-PNP) Oberflaeche) ;;THEN (return (cadr a-mat-PNP)) ;;ELSE (return nil) ;; absolute fallback fallback :-D );;when );;dolist );;get-MaterialPostfix-by-SurfacePattern ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Objekt zur automatischen Verarbeitung in Keyshot umbenennen und Flächenfarben löschen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun Rename (Objekt Postfix) (display (format nil "Postfix von ~A : ~A" (sd-inq-obj-basename Objekt) Postfix)) ;;wenn Basename schon mit Postfix anfängt >> nix tun, ansonsten umbenennen (if (sd-string-match-pattern-p Postfix (sd-inq-obj-basename Objekt)) ;;(1) then >> nichts tun () ;;(2) else >> umbenennen ;; Prüfen ob Attribut vorhanden (if (sd-inq-item-attribute Objekt "KEYSHOT" :FLAG :attachment :instance) ;;(3) then >> Attribut ist verfügbar >> (progn ;;Postfix aus Attribut lesen und in Variable [StoredPostfix] schreiben (setq StoredPostfix (sd-inq-item-attribute Objekt "KEYSHOT" :FLAG :attachment :instance)) ;;aktueller Objektname in Variable schreiben (setq CurrentName (sd-inq-obj-basename Objekt)) ;;gespeichertes Postfix von Teilenamen entfernen ;;Original (setq NewName (string-left-trim StoredPostfix CurrentName)) (setq NewName (string-right-trim StoredPostfix CurrentName)) ;;aktuelles Postfix an Teilenamen dran (sd-call-cmds (change_name_pa :part_asmb Objekt :name (format nil "~A~A" NewName Postfix))) ;;aktuelles Postfix in Attribut ;(sd-attach-item-attribute Objekt "KEYSHOT" :attachment :contents :values `( :FLAG , Postfix)) (sd-attach-item-attribute Objekt "KEYSHOT" :attachment :instance :values `( :FLAG , Postfix)) ;;wenn Objekt ein Teil >> Flächenfarbe löschen (If (sd-inq-part-p Objekt ) ;;then (progn ;;Flächenfarben entfernen (RemoveFaceColor Objekt) ;;ggf. Teile umfärben (if *SetPartColor* ;;then (set-part-poperties objekt postfix) ;;Else () );;if );;progn ;;else () ;;nix tun );;if );;progn ;;(4) else >> Attribut ist nicht verfügbar >> 1. Verarbeitung des Objektes (progn ;;neues Postfix in Attribut (sd-attach-item-attribute Objekt "KEYSHOT" :attachment :instance :values `( :FLAG , Postfix)) ;;Objekt umbenennen (sd-call-cmds (change_name_pa :part_asmb Objekt :name (format nil "~A~A" (sd-inq-obj-basename Objekt)Postfix))) ;;wenn Objekt ein Teil ist >> Flächenfarbe löschen (If (sd-inq-part-p Objekt ) ;;then (progn (RemoveFaceColor Objekt) (if *SetPartColor* ;;then (set-part-poperties objekt postfix) ;;Else () );;if );;progn ;;else () ;;nix tun );;if );;progn );;if );;if );defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; In Abhängigkeit des PostFix eine Teilefarbe zuordenen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun set-partcolor-from-postfix (Postfix) (dolist (a-col-PBP *partcolor-by-postfix*) ;car = 1. Element einer Liste cadr = 2. Element einer Liste ;;(display (format nil "Variable Postfix: ~A" Postfix)) (when (sd-string-match-pattern-p (car a-col-PBP) (subseq Postfix 5)) ;; "__DEN_ST-01" >> "_ST-01" ;;THEN (return (cadr a-col-PBP)) ;;ELSE (return nil) ;; absolute fallback fallback :-D );;when );;dolist );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; In Abhängigkeit des PostFix eine Teiledichte zuordenen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun set-transparency-from-postfix (Postfix) (dolist (a-col-PBP *partdensity-by-postfix*) ;car = 1. Element einer Liste cadr = 2. Element einer Liste (when (sd-string-match-pattern-p (car a-col-PBP) (subseq Postfix 5)) ;;THEN (return (cadr a-col-PBP)) ;;ELSE (return nil) ;; absolute fallback fallback :-D );;when );;dolist );;defun ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; In Abhängigkeit des PostFix eine Teiledichte zuordenen ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun set-part-poperties (objekt postfix) (let ((farbe (sd-rgb-to-color (read-from-string(set-partcolor-from-postfix postfix)))) (transparenz (set-transparency-from-postfix postfix))) (display (format nil "Variable farbe : ~A" farbe)) (display (format nil "Variable dichte : ~A" transparenz)) ;;Exemplarfarbe löschen (sd-call-cmds (set_part_inst_color :parts Objekt :clr)) (sd-call-cmds (set_part_inst_transparency :parts Objekt :transp 0)) ;;Basisfarbe setzen (sd-call-cmds (set_part_base_color :parts Objekt :color farbe)) ;;Basistransparenz setzen (sd-call-cmds (set_part_base_transparency :parts Objekt :transp transparenz)) ;;Kantenfarbe setzen (part_prop :the_part (sd-inq-obj-pathname Objekt) :BASE_EDGE_COLOR (sd-rgb-to-color 0,0,0) );;part_prop );;let );;defun (trace Rename) ;(trace get-MaterialPostfix-by-SurfacePattern ) ;(trace get-MaterialPostfix-by-MaterialPattern ) ;(trace get-Material-by-PartNamePattern ) ;(trace get-MaterialPostfix-by-AssyNamePattern ) ;(trace get-MaterialPostfix-by-PartColor ) ;(trace get-MaterialPostfix-by-PartDensity ) ;(trace ProcessAssy ) ;(trace ProcessParts ) ;(trace CheckReserverdFaceColors ) ;(trace set-partcolor-from-postfix ) ;(trace set-transparency-from-postfix )