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

(sd-defdialog  'teile_anz
:dialog-title "Teileinfo anzeigen"
  :toolbox-button t
  :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"
		:toggle-type :invisible
		:after-input (progn (Teil_ermitteln) (Exemplare_ermitteln))
	)
	("Stammdaten im MM anzeigen")
	
	(Stamm_Str
				:title					"Struktur"
				:push-action			(do-struktur) 
				:toggle-type			:grouped-toggle
				:initial-visible t
	)
	
	(Stamm_art
				:title					"Attribute"
				:push-action			(do-attribute)
				:toggle-type			:grouped-toggle
				:initial-visible t
	)
	
	("Teile-Info")
	
	(Teile_num	 :value-type :display-only
				 :prompt-text "Nummer"
                 :title "Nummer"
                 :initial-value ""
				 :size :third)
				 
	(Teile_bez	 :value-type :display-only
				 :prompt-text "Bezichnung"
                 :title "Bezeichnung"
                 :initial-value ""
				 :size :third)
	
	(Teile_Bes	 :value-type :display-only
				 :prompt-text "Besitzer"
                 :title "Besitzer"
                 :initial-value ""
				 :size :third)				 

	(Teile_exp	 :value-type :display-only
				 :prompt-text "Exemplare"
                 :title "Exemplare"
                 :initial-value ""
				 :size :third)
	
);end-variables

:prompt-variable 'Element
:ok-action '()

:help-action '(sd-display-message "
2017-06-22 erstellt aus Lisp
SW-PosNum von Wolfgang Seel

Makro zum Anzeigen von
Bezeichnung = Name
Nummer = Modellname
Besitzer = Oberbaugruppe
Anzahl der Exemplare
   
Viel Spaß beim anwenden !!!
               Michael

" :title "teile_anz.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 Nummern_liste (Teileflagge_get_nummernliste Ansicht)) ;Nummernliste erstellen
	(setf Teile_bez (Teileflagge_get_bezeichnungen SYS_ID Teile_liste)) ;Teilebezeichnungen raussuchen
	(setf Teile_num (Teileflagge_get_nummer SYS_ID Teile_liste)) ;Teilenummer raussuchen
	(setq Teileflaggen_Teile_bez Teile_bez)
	
    (setf pfad_liste (Teileflagge_get_pfadliste Ansicht)) ;Teileliste erstellen
	(setf Teile_pfad (Teileflagge_get_nummer SYS_ID pfad_liste)) ;Teilepfad raussuchen
	
	(setf StammObject (SD-PATHNAME-TO-OBJ Teile_pfad))
	(setf Teile_Bes (sd-inq-obj-basename (sd-inq-parent-obj StammObject)))
	
	;;; ab hier nur noch auswerten
);Teil_ermitteln

;(display Teil_ID) (display Teileflaggen_Teil_id) (display SYS_ID) (display Teileflaggen_SYS_ID) (display Ansichten_liste) (display Ansicht) (display Teile_liste)
;(display Teile_bez) (display Teile_num) (display Teileflaggen_Teile_bez) 

(do-attribute ()

	(when StammObject
		(sd-call-cmds (ndm_showeditor_part  :tab-name "attribute" :Objects StammObject))
	)
)

(do-struktur ()

	(when StammObject
		(sd-call-cmds (ndm_showeditor_part  :tab-name "structure" :Objects StammObject))
	)
)


(Exemplare_ermitteln ()
	(setf Nummern_liste (write-to-string Nummern_liste))
	(setf Nummern_liste (sd-string-replace Nummern_liste (Format nil " ") "/"))
	(setf Nummern_liste_kopie Nummern_liste)
	(setf Nummern_liste (sd-string-replace Nummern_liste (Format nil "/(\"~a\")" Teile_num) ""))
	(setf Nummern_liste (sd-string-replace Nummern_liste (Format nil "(\"~a\")/" Teile_num) ""))
	(setf Nummern_liste_kopie (sd-string-split Nummern_liste_kopie "/"))
	(setf Nummern_liste (sd-string-split Nummern_liste "/"))
	(setf Teile_exp (- (length Nummern_liste_kopie) (length Nummern_liste)))

	(if (= Teile_exp 0)
		(progn	(display " ")
				(display "3d Baugruppe ist nicht geladen!!!")
				(display " ")
		)
	)
	
) ;; end Exemplare 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_pfadliste (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-pathname   		(FIRST Teileliste))
			)
			Rl))
		)
		((ENDP Teileliste) Rl)
	)
);end Teileflagge_get_pfadliste

(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_nummernliste (Ansicht)
	(DO
		(
			(Teileliste (sd-am-view-struct-parts-3d (SD-AM-INQ-VIEW Ansicht)) (REST Teileliste))
			(Rl 'NIL    (CONS    
			(LIST
			(sd-inq-obj-contents-name   (FIRST Teileliste))
			)
			Rl))
		)
		((ENDP Teileliste) Rl)
	)
);end Teileflagge_get_nummernliste

(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" (SECOND (FIRST L))))
	(RETURN)
	)
	;else
	(SETQ L (REST L))
	);end_IF
	);end_LOOP
	R
	);end LET
);end Teileflagge_get_bezeichnungen

(Teileflagge_get_nummer (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"  (THIRD (FIRST L))))
	(RETURN)
	)
	;else
	(SETQ L (REST L))
	);end_IF
	);end_LOOP
	R
	);end LET
);end Teileflagge_get_nummer
);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"
))