;*********************************************************************************************
; Dateiname 	: 	SD_EngraveText.lsp
; Autor         : 	Stephan Wörz
; Erstellt      :	11.11.2013
; geÌndert    	:
;*********************************************************************************************
; Beschreibung	:		Aufbringen der Artikelnummer/Text auf Bauteil
;                     
; Optionen		:		-		
; Bemerkungen   :   	- 
; Beachten      :   	-                    - 
;*********************************************************************************************
; ä Ì	   Ì Ø    ö Î    Ö Ú    ü Ï    Ï Û    ß Þ    ° ³	

(in-package :Teo)
(use-package :OLI)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-hide-console-window)                  
;(sd-show-console-window)                 
(setf si::*enter-break-handler* t) 

;;mode T = fräsen
(setf mode T) 
;;Artikelnummer aus Attributen holen
(setf GetArticle t)


(sd-defdialog 'SD_EngraveText
		:dialog-title "Text auf FlÌche"
		:toolbox-button nil

:variables
  '(
  
(Textflaeche	:value-type 	:face				
				:after-input 	(progn
									;;zur Fläche geörendes Teil
									(setf Part (sd-inq-parent-obj Textflaeche))
									(if GetArticle
										;;then: Artikelnummer aus den Attributen holen
										(progn
											(setf Beschriftungstext (GetAttribute_LESA_HLZ_Artikel Part))
											;; Artikelnummer prüfen
											(when (not Beschriftungstext)
													(progn
														(setf Beschriftungstext "Text eingeben...")
														:next-variable 'Textflaeche
													);;progn															  															  
												);;when
										);;progn
										;;else
										()	
									);;if
									;; Flächennormale ermitteln und Struktur (structure) in Variable schreiben									
									(Setf FaceProbs (sd-inq-geo-props  Textflaeche :dest-space :global))
									;;Zugriff auf den Slot "normal" (die Flächennormale auslesen)
									(setf Normale (sd-plane-normal FaceProbs))
									;; Variable aktivieren		
									(sd-set-variable-status 'Nullpunkt :enable t)
								);;progn
);;Textflaeche			
	
 (Nullpunkt			:value-type :point-3d 							
 						:initial-enable nil
 						:built-in-feedback t
 						:preselection-definition-time :suppress
 						;:modifies NIL
						:prompt-text "Textursprung angeben (unten links vom Text)"
	     				:title "Textursprung"
	     				:initial-value nil
	     				:next-variable 'Textrichtung
	     				:after-input 	(progn
											(sd-set-variable-status 'Textrichtung :enable t)
	     								);;progn		
);;Nullpunkt


(Textrichtung 			:value-type :measure-direction
						:initial-enable nil
						:prompt-text "Textrichtung angeben"
						:built-in-feedback t
						:title "Textrichtung" 
						:after-input 	(progn
											;; Wenn Normale und Textrichtung gleiche oder entgegengesetzte Richtung haben
											(if (sd-vec-colinear-p (first Textrichtung) Normale)
												;;Then...
												(progn
													(sd-display-message "Richtung nicht zulÌssig - Textrichtung neu wÌhlen")
													(setf Textrichtung nil)
													:next-variable 'Textrichtung
												);;progn	
												;;Else...
												(progn
													(CreateUserdefinedWorkplane Nullpunkt Normale Textrichtung Beschriftungstext Fontsize Fonttype)
													(sd-set-variable-status 'Klein 		:enable t)
													(sd-set-variable-status 'Mittel 	:enable t)
													(sd-set-variable-status 'Gross 		:enable t)	
													(sd-set-variable-status 'Fontsize 	:enable t)																																				
												);;progn
											);;if												
										);;progn																				
);;Textrichtung

("SchriftgrÎÞe")			
	
(Klein       :value-type :grouped-boolean 
			 :initial-enable nil
             :initial-value t
             :size :third                                
             :title "4.0 mm"
			 :after-input	(progn
								(if Klein
									;;then...
									(progn
										(setf Fontsize 5)   
										;;AE löschen
										(sd-call-cmds (delete_3d (sd-inq-curr-wp)))
										;;AE neu
										(CreateUserdefinedWorkplane Nullpunkt Normale Textrichtung Beschriftungstext Fontsize Fonttype)
									);;progn
									;;else...
									()
								);;if    
							);;progn
);;Klein
        
(Mittel     :value-type :grouped-boolean
			:initial-enable nil
            :size :third                        
            :title "6.5 mm"
			:after-input    (progn
								(if Mittel
									;;then...
									(progn
											(setf Fontsize 8)   
										;;AE löschen
										(sd-call-cmds (delete_3d (sd-inq-curr-wp)))
										;;AE neu
										(CreateUserdefinedWorkplane Nullpunkt Normale Textrichtung Beschriftungstext Fontsize Fonttype)
									);;progn
									;;else...
									()
								);;if    
							);;progn
);;Mittel
        
(Gross     	:value-type :grouped-boolean
			:initial-enable nil
            :size :third                        
            :title "9.0 mm"
			:after-input    (progn
								(if Gross
									;;then...
									(progn
										(setf Fontsize 11)   
										;;AE löschen
										(sd-call-cmds (delete_3d (sd-inq-curr-wp)))
										;;AE neu
										(CreateUserdefinedWorkplane Nullpunkt Normale Textrichtung Beschriftungstext Fontsize Fonttype)
									);;progn
									;;else...
									()
								);;if    
							);;progn
);;Gross

(Fontsize		:value-type :display-only ;:number
				:initial-value 5
				:initial-enable nil
				:after-input (progn
								;;AE löschen
								(sd-call-cmds (delete_3d (sd-inq-curr-wp)))
								;;AE neu
								(CreateUserdefinedWorkplane Nullpunkt Normale Textrichtung Beschriftungstext Fontsize Fonttype)				
							);;progn
				:title "SchriftgrÎÞe"
);;

("Verfahren")

(Mill     	:value-type :grouped-boolean
			:initial-enable t
            :size :half                        
            :title "gravieren"
			:after-input    (progn
								(setf mode T)
								(sd-set-variable-status 'Fontdepth 	:enable T)
							);;progn
);;Mill

(Engrave    :value-type :grouped-boolean
			:initial-enable t
            :size :half                        
            :title "aufprÌgen"
			:after-input    (progn
								(setf mode nil)
								(sd-set-variable-status 'Fontdepth 	:enable nil)	
							);;progn
);;Engrave

	 
("Beschriftungstext")  
			
(Beschriftungstext		:value-type	:string	;:display-only
				:initial-value "Text eingeben..."
				:after-input (progn
								;;AE löschen
								(sd-call-cmds (delete_3d (sd-inq-curr-wp)))
								;;AE neu
								(CreateUserdefinedWorkplane Nullpunkt Normale Textrichtung Beschriftungstext Fontsize Fonttype)				
							);;progn
				:title "Text"
);;

("INFO")  

(Fonttype		:value-type	:display-only
				:initial-value "arial"
				:title "Schriftart"
);;



(Fontdepth		:value-type :display-only ;:number
				:initial-value 0.1
				:title "Gravurtiefe"
);;
			
);;Variables

:mutual-exclusion '((Klein Mittel Gross)(Mill Engrave))

 :ok-action
   '(progn
		(PutTextToPart Part Fontdepth mode)   
   );;progn
   
);;sd-defdialog


;;;Funktion zum Auslesen der Artikelnummer
(defun GetAttribute_LESA_HLZ_Artikel (selitem)
  (let ((attr (sd-inq-item-attribute selitem "LESATECH_BOM_ATTR"
                                     :values :attachment :contents)))
     (if attr (getf attr :Lesa_HLZ_Artikel) nil)
  );;let
);;defun

;;; Funktion zum Erstellen der Arbeitsebene
(Defun CreateUserdefinedWorkplane (Nullpunkt Normale Textrichtung Beschriftungstext Fontsize Fonttype)
	(progn
		(sd-call-cmds 	(create_workplane 
							:new :pt_dir 
							:origin Nullpunkt
							:normal Normale
							:u_dir  Textrichtung
						)
		)
		;; Geo-Text erstellen
		(sd-call-cmds 	(create_geo_text
							:text Beschriftungstext
							:pos 0,0 
							:angle 0
							:size Fontsize
							:font Fonttype
						)
		);;
	);;progn
);;defun

(Defun PutTextToPart (Part Fontdepth mode)
	;; Text auf AE
		(if mode
			;;Then >> fräsen
			(progn
				(sd-call-cmds (pull 
					;;:init_from_preselect (get-profile-data-from-preselect) 
					:linear_pull 
					:selection_focus_profiles 
					:keep_wp :no
					:sel_part Part
					:distance Fontdepth
					:direction :-W
				));;
			);;progn
			;;Else >> aufprägen
			(progn	
				(sd-call-cmds (imprint_linear 
					:auto_direction :yes
					:imprint_keep_wp :off
					:imprint_part Part
					;;:imprint_wp "/A01"
					:imprint_distance Fontdepth
					:imprint_dir :+W
					:complete
				));;
			);;progn
		);;if
);;defun

; (trace GetAttribute_LESA_HLZ_Artikel)