(in-package  :SW)
(use-package '( :oli :frame2 :elan))


(sd-defdialog  'SW-PosNum
:dialog-title "SW-PosNum"
;  :dialog-control :sequential-loop ;:sequential
  :toolbox-button t ; nil
  :variables '(
                  
(Element
		:selection (*sd-anno-geo-seltype*)
		:select-attribute :docu-calc-geo-only
		:title (sd-multi-lang-string "chambfer" :german "Teilekante")
		:prompt-text "Element für Nummernerkennung wählen"
		:after-input (progn (Teil_ermitteln))
)
			  
(Start_punkt
	:value-type :docupntcnp
	:title (sd-multi-lang-string "Start-Point" :german "Startpunkt")
	:prompt-text "Startpunkt wählen"
	:after-input 	(progn 
					) ; progn	
)
               
(End_punkt
	:value-type :docupntcnp
	:title (sd-multi-lang-string "End-Point" :german "Endpunkt")
	:before-input	(progn 	(sd-execute-annotator-command :cmd
							(format nil "LINE  TWO_PTS ~A,~A"
							(docu::gpntdocu_x Start_punkt)
							(docu::gpntdocu_y Start_punkt) ) )
					) ; progn	
	:prompt-text "Endpunkt wählen"
	:after-input (SW-Teileflagge-zeichnen)
)


("Teilename-komplett, ....")   
  (Teilename_komplett
          :value-type :boolean
          :toggle-type :wide-toggle
          :title (sd-multi-lang-string "complete Name" :german "kompletter Teilename")
          :initial-value t
	) ; Teilename_komplett


);end-variables
  
  
:ok-action '()
;:ok-action '(sd-execute-annotator-command :cmd "end")

:cancel-action '(progn   (sd-execute-annotator-command :cmd "end")(am_set_show :adu-colors :off))

:help-action '(sd-display-message "
2017-06-20 erstellt von Wolfgang Seel

Makro zur automatischen Positions-Nummern-Erstellung
Nummern werden aus dem Modellnamen generiert.
Nummernname = Modellname bis zum ersten -
   
Viel Spaß beim anwenden !!!

" :title "SW-PosNum.lsp" :push "Weiter")

:local-functions '(

(Teil_ermitteln ()

	(setf Teil_ID (sd-execute-annotator-function :fnc (format nil "SW_send_teile_id_of_geo_objekt ~A" (sd-get-annotator-reference :object Element))))
	(setq Teileflaggen_Teil_id Teil_ID)
	(setf SYS_ID (sd-execute-annotator-function	:fnc (format nil "SW_send_sys_id_of_geo_objekt '~A'"   Teil_id)))
	(setq Teileflaggen_SYS_ID SYS_ID)
	(setf Ansichten_liste (sd-am-sheet-struct-views (sd-am-inq-sheet (sd-am-inq-curr-sheet)))) ;Ansichtenliste erstellen
	(setf Ansicht (Teileflagge_get_ansicht_aus_ansichtenliste (sd-am-inq-name Element) Ansichten_liste) )	;Aus der Liste die betroffene Ansicht rausholen
    (setf Teile_liste (Teileflagge_get_teileliste Ansicht)) ;Teileliste erstellen
	(setf Teile_bez (Teileflagge_get_bezeichnungen SYS_ID Teile_liste)) ;Teilebezeichnungen raussuchen
	(setq Teileflaggen_Teile_bez Teile_bez)
;;; ab hier nur noch auswerten

	(setq STRICHSUCH (search "-" Teile_bez :start2 0))
		(if (equal STRICHSUCH nil)
			(setq Sketchname (subseq Teile_bez 0 (search "|" Teile_bez :start2 0)) ) ;;
			(setq Sketchname (subseq Teile_bez 0 (search "-" Teile_bez :start2 0) )) ;; Nur Positionsnummer von vorne bis zum -	
		) ; endif

	(setq Sketchname2 (subseq Teile_bez 0 (search "|" Teile_bez :start2 0) )) ;; kompletter Teile-Name
	(setq Sketchname3  (format nil "~a/~a/~a" (sd-am-inq-curr-sheet-name) (sd-am-inq-name Ansicht) Sketchname)) ;; kompletter Sketchname
	(setq Sketchname4 (format nil "~a/~a" (sd-am-inq-curr-sheet-name) Sketchname)) ;; vorläufiger Sketchname


	
	(if Teilename_komplett ;; Auswahl zwischen Positionsnummer und komplettem Namen
		(setq Hinweistext Sketchname2) ;; Hinweistext der geschrieben wird		
		(setq Hinweistext Sketchname) ;; Hinweistext der geschrieben wird
	) ; endif
;	(DISPLAY Sketchname) (DISPLAY Sketchname2) (DISPLAY (sd-am-inq-name Ansicht)) (DISPLAY sketchname3) (DISPLAY sketchname4)

);Teil_ermitteln
	
	

(Teileflagge_get_ansicht_aus_ansichtenliste (A_name L) ;Aus der Liste die betroffene Ansicht rausholen
	(COND
		((ENDP L) NIL)
		((sd-string= A_name
		(sd-am-view-struct-name   (sd-am-inq-view (FIRST L)))) (FIRST L))
		(T (Teileflagge_get_ansicht_aus_ansichtenliste A_name (REST L)))
	);end COND
);end Teileflagge_get_ansicht_aus_ansichtenliste



(Teileflagge_get_teileliste (Ansicht)
	(DO
		(
			(Teileliste (sd-am-view-struct-parts-3d (SD-AM-INQ-VIEW Ansicht)) (REST Teileliste))
			(Rl 'NIL        (CONS
			(LIST
			(sd-inq-obj-sysid           (FIRST Teileliste))
			(sd-inq-obj-basename        (FIRST Teileliste))
			(sd-inq-obj-contents-name   (FIRST Teileliste))
			)
			Rl))
		)
		((ENDP Teileliste) Rl)
	)
);end Teileflagge_get_teileliste



(Teileflagge_get_bezeichnungen (ID L)
	(LET (
	(SuchSTR)
	(R)
	)
	(LOOP
	(WHEN (ENDP L) (PROGN (SETQ R  NIL) (RETURN)))
	(IF (sd-string= ID
	(SECOND (sd-string-split (FIRST (FIRST L)) " ")) )
	;then
	(PROGN
	(SETQ R (format nil "~A|~A" (SECOND (FIRST L)) (THIRD (FIRST L))))
	(RETURN)
	)
	;else
	(SETQ L (REST L))
	);end_IF
	);end_LOOP
	R
	);end LET
);end Teileflagge_get_bezeichnungen



(SW-Teileflagge-zeichnen ()
	
  (sd-call-cmds (oli::sd-am-create-sketch :name Sketchname :position Start_punkt :owner_type :current-sheet)) ;; Sketch-Ebene erzeugen
 
  (sd-call-cmds(oli::modify_default_setting :path "Annotation/Geometry/Standard" :a_range :standard )) ;; Strichfarbe und Strichart auf Standard setzen
 
  (sd-call-cmds(oli::am_geo_circle :owner Sketchname4 Start_punkt 0.25)) ;; Kreis im Startpunkt erzeugen
 

(if (< (docu::gpntdocu_x Start_punkt) (docu::gpntdocu_x End_punkt)) ;; Unterscheidung Flagge Links oder Rechts
	(progn  (sd-call-cmds (oli::am_create_text :owner Sketchname4 
				:docu-text :abs_angle 0 :docu-text :size 4.5 :docu-text :ratio 1 :docu-text :slant 0 :docu-text :linesp 1 :docu-text :font1b "Arial" :docu-text :filled "ON" :docu-text :frame "BOX" :docu-text :color 0 :done :docu-text :adjust 4 
				:docu-text Hinweistext  End_punkt :yes))
			 (sd-call-cmds(oli::am_geo_line_2pos :owner Sketchname4 Start_punkt (make-gpnt2d :x (- (oli::gpntdocu_x End_punkt) 5.2) :y (oli::gpntdocu_y End_punkt)) ))
			 (sd-call-cmds(oli::am_geo_line_2pos :owner Sketchname4 (make-gpnt2d :x (- (oli::gpntdocu_x End_punkt) 2.2) :y (oli::gpntdocu_y End_punkt)) (make-gpnt2d :x (- (oli::gpntdocu_x End_punkt) 5.2) :y (oli::gpntdocu_y End_punkt)) ))			
	);progn
 
	(progn	 (sd-call-cmds(oli::am_create_text :owner Sketchname4 
				:docu-text :abs_angle 0 :docu-text :size 4.5 :docu-text :ratio 1 :docu-text :slant 0 :docu-text :linesp 1 :docu-text :font1b "Arial" :docu-text :filled "ON" :docu-text :frame "BOX" :docu-text :color 0 :done :docu-text :adjust 6
				:docu-text Hinweistext  End_punkt :yes))
			 (sd-call-cmds(oli::am_geo_line_2pos :owner Sketchname4 Start_punkt (make-gpnt2d :x (+ (oli::gpntdocu_x End_punkt) 5.2) :y (oli::gpntdocu_y End_punkt)) ))
			 (sd-call-cmds(oli::am_geo_line_2pos :owner Sketchname4 (make-gpnt2d :x (+ (oli::gpntdocu_x End_punkt) 2.2) :y (oli::gpntdocu_y End_punkt)) (make-gpnt2d :x (+ (oli::gpntdocu_x End_punkt) 5.2) :y (oli::gpntdocu_y End_punkt)) ))			
	);progn
) ; endif

(sd-call-cmds (am_sketch_owner :sketch Sketchname4 :owner_view Ansicht)) ;; Skizze in Ansicht verschieben

(setf Start_punkt nil) ;; Startpunkt zurücksetzen
(setf End_punkt nil) ;; Endpunkt zurücksetzen
(setf Element nil) ;; Endpunkt zurücksetzen

) ;; SW-Teileflagge-zeichnen						



);end Local-Functions
);end sd-defdialog

#| benötigte ME10-Makro´s um Teilenummern im Annotation zu ermitteln |#


(sd-execute-annotator-command :cmd
 (format nil "~a~a~a~a~a~a~a~a~a~a~a~a"
"DEFINE SW_send_teile_id_of_geo_objekt"
"  PARAMETER Pn {*Pointernummer*}"
"  LOCAL Pid"
"  LOCAL I"
"  LOCAL D"
"  LOCAL C"
"  INQ_SELECTED_ELEM SELECT GLOBAL POINTER Pn CONFIRM END"
"  LET Pid  (DOCU_CSTRING_TO_LSTRING (INQ 309))"
"  LET I (DOCU_OPEN_CONNECTION_TO_SD)"
"  LET D (DOCU_ADD_LINE_TO_SD  Pid)"
"  LET C (DOCU_CLOSE_CONNECTION_TO_SD)"
"END_DEFINE"
))

(sd-execute-annotator-command :cmd
 (format nil "~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a"
"DEFINE SW_send_sys_id_of_geo_objekt"
"  PARAMETER T"
"  LOCAL Istr"
"  LOCAL R"
"  LOCAL I"
"  LOCAL D"
"  LOCAL C"
"  INQ_SELECTED_ELEM GLOBAL T"
"  LET Istr (INQ 900)"
"  LOOP"
"  EXIT_IF (Istr = 'END-OF-LIST')"
"    IF (POS Istr 'SD_ID:')"
"      LET R (SUBSTR Istr ((POS Istr ' ')+1) (LEN Istr))"
"      LET R (SUBSTR R ((POS R ';')+1) (LEN R))"
"    END_IF"
"  EXIT_IF (POS Istr 'SD_ID:')"
"    LET Istr (INQ 901)"
"  END_LOOP"
"  IF (Istr = 'END-OF-LIST')"
"    LET R 'NONE'"
"  END_IF"
"  LET I (DOCU_OPEN_CONNECTION_TO_SD)"
"  LET D (DOCU_ADD_LINE_TO_SD  (DOCU_CSTRING_TO_LSTRING R))"
"  LET C (DOCU_CLOSE_CONNECTION_TO_SD)"
"END_DEFINE"
))