;********************************************************************************************* ; Dateiname : AM_Test_1.lsp ; Autor : Stephan Wörz ; Erstellt : 28.05.2008 ; geändert : ;********************************************************************************************* ; Beschreibung : - Erzeugen der Toleranzen für die Fertigung unter Berücksichtigung des ; Materialauftrags der Oberflächenbehandlung ; - Oberfläche wird vom Ansichtenbesitzer (Attribut) abgegriffen ;********************************************************************************************* ; -------------------------------------------------------------------------------------------- ; ä Ì Ä Ø ö Î Ö Ú ü Ï Ü Û ß Þ ° ³ ØÖ ; -------------------------------------------------------------------------------------------- ;RGB-Farben weiß 1,1,1 rot: 1,0,0 grün: 0,1,0 blau: 0,0,1 ; gelb 1,1,0 cyan: 0,1,1 magenda: 1,0,1 schwarz 0,0,0 ; -------------------------------------------------------------------------------------------- (in-package :my-tools) (use-package :oli) (use-package :MEI) (sd-hide-console-window) ;(sd-show-console-window) (setf si::*enter-break-handler* t) ;;(display (f2::dde-services)) ;; informationen ;;================================================================================================ ;;=========== G R U N D E I N S T E L L U N G E N =============================================== ;;================================================================================================ ;(setq DATEI (sd-convert-filename-to-platform "S:/COCREATE/Schiller_OSDM_Ressourcen_V15.50/SchillerMacros//Bohrungstabelle.xls")) ; (setq DATEI (format nil "~a\\Bohrungstabelle.xls" (MEI::GETENV "SCHILLERMACRODIR"))) ;(setq DATEI (sd-convert-filename-from-platform (format nil "~a/Bohrungstabelle.xls" (MEI::GETENV "SCHILLERMACRODIR")))) ;(display (format nil "DATEI : ~A" DATEI)) ;(display (format nil "open(\"~A\")" Datei)) (setq DATEI "D:Bohrungstabelle.xls" ) (setq workbook "Bohrungstabelle" ) (setq Sheet "MainSheet" ) (setq TolStellen 3 ) ;;Nachkommastellen der Toleranzen (setq DIAMETER 8 ) (setq Passungsart nil ) ;;============================================================= ;;=========== B O H R U N G S P A S S U N G ================= ;;============================================================= ;; hier die "Eingabezellen" im Arbeitsblatt definieren (setq B_DestRowSurface 10 ) (setq B_DestColSurface 3 ) (setq B_DestRowDiameter 6 ) (setq B_DestColDiameter 3 ) (setq B_DestRowTolerance 8 ) (setq B_DestColTolerance 3 ) ;; Ergebnisszellen für oberen/unteren Grenzwert "nach Oberflächenbehandlung" (setq B_ResultRowOGrenze_OF 18 ) (setq B_ResultColOGrenze_OF 4 ) (setq B_ResultRowUGrenze_OF 19 ) (setq B_ResultColUGrenze_OF 4 ) ;; Ergebnisszellen für obere/untere Toleranz "nach Oberflächenbehandlung" (setq B_ResultRowOTol_OF 14 ) (setq B_ResultColOTol_OF 4 ) (setq B_ResultRowUTol_OF 15 ) (setq B_ResultColUTol_OF 4 ) ;; Ergebnisszellen für oberen/unteren Grenzwert "nach Fertigung" (setq B_ResultRowOGrenze_F 18 ) (setq B_ResultColOGrenze_F 8 ) (setq B_ResultRowUGrenze_F 19 ) (setq B_ResultColUGrenze_F 8 ) ;; Ergebnisszellen für obere/untere Toleranz "nach Fertigung" (setq B_ResultRowOTol_F 14 ) (setq B_ResultColOTol_F 8 ) (setq B_ResultRowUTol_F 15 ) (setq B_ResultColUTol_F 8 ) ;; sonstige Definitionen ;;============================================================= ;;============= W E L L E N P A S S U N G =================== ;;============================================================= ;; hier die "Eingabezellen" im Arbeitsblatt definieren (setq W_DestRowSurface 31 ) (setq W_DestColSurface 3 ) (setq W_DestRowDiameter 27 ) (setq W_DestColDiameter 3 ) (setq W_DestRowTolerance 29 ) (setq W_DestColTolerance 3 ) ;; Ergebnisszellen für oberen/unteren Grenzwert "nach Oberflächenbehandlung" (setq W_ResultRowOGrenze_OF 39 ) (setq W_ResultColOGrenze_OF 4 ) (setq W_ResultRowUGrenze_OF 40 ) (setq W_ResultColUGrenze_OF 4 ) ;; Ergebnisszellen für obere/untere Toleranz "nach Oberflächenbehandlung" (setq W_ResultRowOTol_OF 35 ) (setq W_ResultColOTol_OF 4 ) (setq W_ResultRowUTol_OF 36 ) (setq W_ResultColUTol_OF 4 ) ;; Ergebnisszellen für oberen/unteren Grenzwert "nach Fertigung" (setq W_ResultRowOGrenze_F 39 ) (setq W_ResultColOGrenze_F 8 ) (setq W_ResultRowUGrenze_F 40 ) (setq W_ResultColUGrenze_F 8 ) ;; Ergebnisszellen für obere/untere Toleranz "nach Fertigung" (setq W_ResultRowOTol_F 35 ) (setq W_ResultColOTol_F 8 ) (setq W_ResultRowUTol_F 36 ) (setq W_ResultColUTol_F 8 ) ;; sonstige Definitionen ;;================================================================================================ ;;=========== D I A L O G ======================================================================= ;;================================================================================================ (sd-defdialog 'AM_Test_1 :dialog-title "Fertigungsbemassung" :precondition '(if (sd-am-inq-curr-sheet-name) :ok :error) :dialog-control :parallel :variables '( (ansicht-massstab :initial-value 1) (oGrenze_OF :initial-value "0.000") (uGrenze_OF :initial-value "0.000") (oGrenze_F :initial-value "0.000") (uGrenze_F :initial-value "0.000") ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (ansicht :selection *sd-anno-view-seltype* ; nur Ansichten wählbar :title "Ansicht" :prompt-text "Ansicht angeben" :after-input (prog (setq ansicht-massstab (/ 1 (sd-am-view-struct-scale (sd-am-inq-view ansicht)))) (openfile DATEI) (GetSurface) (send-value-to-excel Oberflaeche B_DestRowSurface B_DestColSurface) (send-value-to-excel Oberflaeche W_DestRowSurface W_DestColSurface) (sd-set-variable-status 'Bohrung :enable t) (sd-set-variable-status 'SELDimension :enable t) (sd-set-variable-status 'Oberflaeche :enable t) );;progn );;ansicht ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ("") ;;Neuer Abschnitt im UI ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Oberflächenbehandlung [nur Anzeige - wird aus 3D-Modell geholt!] (Oberflaeche :value-type :display-only :initial-enable nil :title (sd-multi-lang-string "Surface" :german "OberflÌche") :initial-value "OberflÌche" );;Oberflaeche ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ("") ;;Neuer Abschnitt im UI ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ; ;; Auslessen von Eigenschaften eines Maßes (SELDimension :selection (*sd-anno-dimension-seltype*) :title (sd-multi-lang-string "Dimension" :german "BemaÞung") :initial-enable nil :after-input (progn (setf Prefix (sd-am-dim-fix-texts-struct-prefix (sd-am-inq-dim-fix-texts SELDimension ))) (setf UpperTolTxt (sd-am-inq-dim-main-upper-tol-text SELDimension )) (setf LowerToltxt (sd-am-inq-dim-main-lower-tol-text SELDimension )) (setf UpperTolVal (sd-am-inq-dim-upper-tol-value SELDimension )) (setf LowerTolVal (sd-am-inq-dim-lower-tol-value SELDimension )) (setq oGrenze_OF nil) (setq uGrenze_OF nil) (setq oGrenze_F nil) (setq uGrenze_F nil) (setq OTol_F nil) (setq UTol_F nil) (setq Passungsart nil) ;; RADIUS ist unglückliche Variablenbezeichnung (setf DimValue (sd-am-inq-dim-value SELDimension )) ;;wenn oberer-/unterer Toleranztext <> "" und oberer-/unterer Toleranzwert <> 0 dann prüfen ob Passmass (if (not(and (= UpperTolVal 0) (= LowerTolVal 0) (equal UpperTolTxt "") (equal LowerTolTxt "") ));;not and (if (and (= UpperTolVal 0) (= LowerTolVal 0) );;and (if (equal UpperTolTxt "") ;; WELLENPASSUNG (progn (send-value-to-excel DimValue W_DestRowDiameter W_DestColDiameter) (sd-set-variable-status 'Wellenpassung :enable t ) (sd-set-variable-status 'Bohrungpassung :enable nil ) (sd-set-variable-status 'DoIt :enable t ) (setq Passungsart "Welle" ) (setq Wellenpassung LowerToltxt) (send-value-to-excel Wellenpassung W_DestRowTolerance W_DestColTolerance) (Get_W_TolValues) ; (ModifyDimension SELDimension DimValue Prefix OTol_F UTol_F) );;progn ;;BOHRUNGPASSUNG (progn (send-value-to-excel DimValue B_DestRowDiameter B_DestColDiameter) (sd-set-variable-status 'Bohrungpassung :enable t) (sd-set-variable-status 'Wellenpassung :enable nil) (sd-set-variable-status 'DoIt :enable t) (setq Passungsart "Bohrung" ) (setf Bohrungpassung UpperTolTxt) (send-value-to-excel Bohrungpassung B_DestRowTolerance B_DestColTolerance) (Get_B_TolValues) ; (ModifyDimension SELDimension DimValue Prefix OTol_F UTol_F) );;progn );;if );;if ;;else >> wenn es KEIN PASSMASS ist (progn (setf Wellenpassung "KEINE PASSUNG!!!") (setf Bohrungpassung "KEINE PASSUNG!!!") );;progn );;if (sd-set-variable-status 'DimValue :enable t) );;progn );;SELDimension ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Bemassungswert (DimValue :value-type :display-only :title (sd-multi-lang-string "Dimension" :german "Bemassungswert") :initial-enable nil :initial-value nil );; DimValue ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;;Text für Tabellenspalte "Toleranz" (Wellenpassung :value-type :string :title "Wellenpassung" :initial-enable nil :initial-value "TOL" :proposals ("a12" "a13" "c13" "d6" "e6" "e13" "f5" "f6" "f7" "g5" "g6" "g7" "h4" "h5" "h6" "h7" "h8" "h10" "h11" "h12" "j5" "j6" "j7" "js5" "js6" "js7" "k5" "k6" "k7" "m5" "m6" "m7" "n5" "n6" "n7" "p5" "p6" "r6") :after-input (progn (send-value-to-excel Bohrungpassung W_DestRowTolerance W_DestColTolerance) (Get_W_TolValues) );;progn );;Wellenpassung ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;;Text für Tabellenspalte "Toleranz" (Bohrungpassung :value-type :string :title "Bohrungpassung" :initial-enable nil :initial-value "TOL" :proposals ("E6" "E7" "E11" "E12" "E13" "F6" "F7" "F8" "G6" "G7" "G8" "H6" "H7" "H8" "H9" "H10" "H11" "J6" "J7" "J8" "JS6" "JS7" "JS8" "K6" "K7" "K8" "M6" "M7" "M8" "N6" "N7" "N8" "P6" "P7" "P8" "R6" "R7") :after-input (progn (send-value-to-excel Bohrungpassung B_DestRowTolerance B_DestColTolerance) (Get_B_TolValues) );;progn );;Bohrungpassung ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ("") ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (DoIt :toggle-type :wide-toggle :title "erzeuge FertigungsbemaÞung" :initial-enable nil :push-action (progn (ModifyDimension SELDimension DimValue Prefix OTol_F UTol_F) );;progn :next-variable 'SELDimension );;DoIt );;variables :local-functions '( ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;Funktion zum auslesen der Ansichtseigenschaften (GetSurface () (progn ;Struktur mit Daten zur "Ansicht" wird ViewProbs zugewiesen (setq ViewProbs (sd-am-inq-view ansicht)) ;die in der Ansicht enthaltenen 3D-Teile auslesen (Achtung! Ist eine Liste) (setq Teile_3d (sd-am-view-struct-parts-3d ViewProbs)) ;;prüfen ob nur 1 Teil in Ansicht! (if (= (length Teile_3d) 1) (progn ;von dem ersten Teil (First) der Liste das Attribute "LESATECH_BOM_ATTR" :LESA_OBERFLAECHE auslesen (setq Oberflaeche (sd-inq-item-attribute (first Teile_3d) "LESATECH_BOM_ATTR" :LESA_OBERFLAECHE :attachment :contents)) ; ;;OF_Offset in Abhängigkeit der Oberflächenbehandlung setzen! ; (if (string= Oberflaeche "Chem. Nickel 0.010 mm") ; (setf OF_Offset 0.020) ; );;if ; (if (string= Oberflaeche "Chem. Nickel 0.030 mm") ; (setf OF_Offset 0.060) ; );;if ; (if (string= Oberflaeche "Hart elox. 0.030 mm") ; (setf OF_Offset 0.060) ; );;if ; (if (string= Oberflaeche "Hart elox. 0.050 mm") ; (setf OF_Offset 0.1) ; );;if ; (if (string= Oberflaeche "Hartchrom 0.010 mm") ; (setq OF_Offset 0.020) ; ; );;if ; ; ;;!!!!! Das mit dem CASE habe ich nicht gebacken bekommen!!!! );;progn (if (= (length Teile_3d) 0) (progn (sd-display-message "Achtung! Das zur Zeichnung gehÎrende 3D-Modell ist nicht geladen!" :title "HINWEIS" :push "TschÏss" );;sd-display-message (cancel) );;progn (progn (sd-display-message "Achtung! Dieses Tool unterstÏtzt nur Einzelteilzeichnungen!" :title "HINWEIS" :push "TschÏss" );;sd-display-message (closefile "CLOSE(FALSE)" ) ;; FALSE = nicht speichern! (cancel) );;progn );;if );;if );;progn );;GetSurface ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Toleranzwerte für Bohrungspassung (Get_B_TolValues () (progn ;; Result aus Excel ist String !! --> mir den Ergebnissen kann man nicht weiterrechnen (setq oGrenze_OF (get-value-from-excel B_ResultRowOGrenze_OF B_ResultColOGrenze_OF )) (setq uGrenze_OF (get-value-from-excel B_ResultRowUGrenze_OF B_ResultColUGrenze_OF )) (setq oGrenze_F (get-value-from-excel B_ResultRowOGrenze_F B_ResultColOGrenze_F )) (setq uGrenze_F (get-value-from-excel B_ResultRowUGrenze_F B_ResultColUGrenze_F )) (setq OTol_F (get-value-from-excel B_ResultRowOTol_F B_ResultColOTol_F )) (setq UTol_F (get-value-from-excel B_ResultRowUTol_F B_ResultColUTol_F )) );;progn );;Get_B_TolValues ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;; Toleranzwerte für Wellenpassung (Get_W_TolValues () (progn ;; Result aus Excel ist String !! --> mir den Ergebnissen kann man nicht weiterrechnen (setq oGrenze_OF (get-value-from-excel W_ResultRowOGrenze_OF W_ResultColOGrenze_OF )) (setq uGrenze_OF (get-value-from-excel W_ResultRowUGrenze_OF W_ResultColUGrenze_OF )) (setq oGrenze_F (get-value-from-excel W_ResultRowOGrenze_F W_ResultColOGrenze_F )) (setq uGrenze_F (get-value-from-excel W_ResultRowUGrenze_F W_ResultColUGrenze_F )) (setq OTol_F (get-value-from-excel W_ResultRowOTol_F W_ResultColOTol_F )) (setq UTol_F (get-value-from-excel W_ResultRowUTol_F W_ResultColUTol_F )) );;progn );;Get_W_TolValues ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ) ;; end local functions :after-initialization '() ;; ---------------------------------------------------- ------------------------------------------------------------------------------------------------ :ok-action '(progn (cancel) );;progn ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- :cleanup-action '(progn (closefile "CLOSE(FALSE)" ) ;; FALSE = nicht speichern! ; (sd-execute-annotator-command :cmd "CANCEL") ;; abort / cancel all feedback stuff etc. ; ;; ++ eventuell noch: / to be on the save side.. ; (sd-call-cmds (am_current_sheet (sd-am-inq-curr-sheet-name))) ; (closefile "CLOSE(FALSE)" ) ;; FALSE = nicht speichern! ; (modify_default_setting_current_style "Annotation" :SCHILLER) );;progn ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- :cancel-action '(progn );;progn ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- :help-action '(progn (helptext) );;progn ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- );;defdialog ;;================================================================================================ ;;=========== F U N K T I O N S D E F I N I T I O N E N F Ü R E X C E L Z U G R I F F ========= ;;================================================================================================ (defun create-workbook() (setq dde (connect-to-excel)) (unless dde (display "Cannot connect to Excel.") (return-from send-objects-to-excel nil) );;unless ;; open new sheet (send-excel-command dde "NEW()") );; create-workbook ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun openfile (Datei) (setq dde (connect-to-excel)) (unless dde ;wenn dde keinen Wert hat dann (display "Cannot connect to Excel.") );;unless ;; open File (send-excel-command dde (format nil "OPEN(~S)" Datei)) ;; (display (f2::dde-services)) );;openfile ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun closefile (COMMAND) (setq dde (connect-to-excel)) ;dde definieren (unless dde ;wenn dde keinen Wert hat dann (display "Cannot connect to Excel.") );;unless ;; close File (send-excel-command dde (format nil "~A" COMMAND)) (disconnect-from-excel dde) ; DDE-Verbindung zu Excel trennen! );;closefile ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun send-value-to-excel (VALUE row column) (setq dde (connect-to-excel)) ;dde definieren (unless dde ;wenn dde keinen Wert hat dann (display "Cannot connect to Excel.") );;unless ;; write VALUE to Excel (set-cell dde (format nil"R~AC~A" row column) VALUE) ;r=Zeile 1 c=Spalte 1 );;send-value-to-excel ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun get-value-from-excel (row column) (setq Sheethandle (oli:sd-dde-initiate "Excel" "[Bohrungstabelle.xls]MainSheet")) ; (print (format nil "Sheethandle : ~A" Sheethandle )) ;das tut erst mal!!!! ;; get value (print (oli:sd-dde-request Sheethandle (format nil "Z~AS~A" row column))) );;get-value-from-excel ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun connect-to-excel() (let ((dde (oli:sd-dde-initiate "Excel" "System"))) (if (eq :error dde) nil dde) );;let );;connect-to-excel ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun disconnect-from-excel(dde) (oli:sd-dde-close dde) );;disconnect-from-excel ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun set-cell(dde cell formula) (sd-dde-execute dde (format nil "[Formula(~S, ~S)]" formula cell)) );;set-cell ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (defun send-excel-command(dde cmd) ; (display (format nil "SEND-EXCEL-COMMAND : [~A]" cmd)) (oli:sd-dde-execute dde (format nil "[~A]" cmd)) );;send-excel-command ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- ;;================================================================================================ ;;=============== S O N S T I G E F U N K T I O N S D E F I N I T I O N E N ================ ;;================================================================================================ (defun ModifyDimension (SELDimension DimValue Prefix OTol_F UTol_F) (progn ;; Präfix ran (AM_DIM_ADD_FIXTEXT :DIM_LIST SELDimension :PREFIX (format nil "Fertigungsmass: ~A" Prefix)) ;; Grenzabmessungen dran (AM_DIM_ADD_TOLERANCE :DIM_LIST SELDimension :TOL_UL :UPPER OTol_F :LOWER UTol_F) ;;Nachkommastellen setzen (AM_DIM_PROPS :DIM_LIST SELDimension :PAGE :FORMAT :MAIN_TOL_PRECISION 3) );;progn );;ModifyDimension ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- (trace set-cell) (trace closefile) (trace send-excel-command) (trace get-value-from-excel)