;;--------------------------------------------------------------------------* ;; Copyright 2002 TECHSOFT Rand * ;; * ;;--------------------------------------------------------------------------* ;; Dateiname: kurven.lsp ;; Version : 11.601 ;; Datum : ;; Author : Schaumberger G. ;;--------------------------------------------------------------------------* ;; Modulbeschreibung: Makro, welches eine Datei mit X,Y,Z Werten liest * ;; und 3D-Kurven erzeugt * ;; * ;; * ;;--------------------------------------------------------------------------* ;; Hilfsmittel: * ;; * ;;--------------------------------------------------------------------------* ;; Zugehoerige Moduln: * ;; Name | Kurzbeschreibung * ;; | * ;; | * ;;--------------------------------------------------------------------------* ;; Wichtige Informationen: * ;;--------------------------------------------------------------------------* ;; Anderungsverzeichnis: * ;; Version | Datum | Autor | Beschreibung * ;; | | | * ;; 11.601 |19.12.2002|Schaumberger|mehrsprachige Version * ;; | | | * ;; | | | * ;;--------------------------------------------------------------------------* ;;--------------------------------------------------------------------------* ;; in-packages * ;;--------------------------------------------------------------------------* (in-package :custom) ;;--------------------------------------------------------------------------* ;; use-packages * ;;--------------------------------------------------------------------------* (use-package :OLI) ;;--------------------------------------------------------------------------* ;; export * ;;--------------------------------------------------------------------------* (export '( ts-land-kurven-datei-dialog ) ) ;;--------------------------------------------------------------------------* ;; license * ;;--------------------------------------------------------------------------* ;;--------------------------------------------------------------------------* ;; global variables * ;;--------------------------------------------------------------------------* ;;--------------------------------------------------------------------------* ;; local variables * ;;--------------------------------------------------------------------------* ;;*************************************************************************** ;; MENUS * ;;*************************************************************************** ;;*************************************************************************** ;; DISPLAY-TABLES * ;;*************************************************************************** ;;*************************************************************************** ;; DIALOGS * ;;*************************************************************************** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Hilfsmakro nur Punkte erzeugen (sd-defdialog 'ts-land-punkte-datei-dialog :dialog-title '(sd-multi-lang-string "ReadPoints" :german "Punkte lesen") ;;:toolbox-button nil :dialog-control :parallel :after-initialization '(progn (when (not (sd-module-active-p "SURFACING")) (progn (sd-display-error (sd-multi-lang-string "Plaese activate sufracing module first" :german "Bitte zuerst Surfacing Modul aktivieren")) (cancel) ) ) ) :variables `( (Name :value-type :filename :title ,(sd-multi-lang-string "Name" :german "Name") :add-suffix t :direction :input :prompt-text ,(sd-multi-lang-string "Specify file name" :german "Dateiname der Koordinatendatei angeben.") :filename-incl-path t :initialPattern "*.txt" ) (teil :value-type :part-incl-new :wire-part-allowed t :title ,(sd-multi-lang-string "Part" :german "Teil") :initial-value (if (and (sd-inq-curr-part) (sd-inq-wire-part-p (sd-inq-curr-part))) (sd-inq-curr-part) nil ) :prompt-text ,(sd-multi-lang-string "Specify part name" :german "Name fÏr Drahtteil in welchem Punkte erzeugt werden sollen angeben.") :after-input (progn (when (equal (ts-land-check-for-empty-or-wired-part teil) :NotAllowed) (progn (sd-display-error (format nil (sd-multi-lang-string "\"~a\" ist not allowed. Part has to be a new part or an exising wired part" :german "\"~a\" zu wÌhlen ist in diesem Kontex nicht erlaubt") (sd-inq-obj-pathname teil))) (setf teil nil) ) ) ) ) ) :local-functions '( (main-action () (ts-land-kurven-mac (first Name) teil t) ) ) :ok-action '(sd-call-cmds (main-action)) ;;:help-action `(ts_help (format nil "~a#Kurven_lesen" *ts-land-doc-file*)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Hilfsmakro Kurven erzeugen (sd-defdialog 'ts-land-kurven-datei-dialog :dialog-title '(sd-multi-lang-string "Read Curves" :german "Kurven lesen") ;;:toolbox-button nil :dialog-control :parallel :after-initialization '(progn (when (not (sd-module-active-p "SURFACING")) (progn (sd-display-error (sd-multi-lang-string "Plaese activate sufracing module first" :german "Bitte zuerst Surfacing Modul aktivieren")) (cancel) ) ) ) :variables `( (Name :value-type :filename :title ,(sd-multi-lang-string "Name" :german "Name") :add-suffix t :direction :input :prompt-text ,(sd-multi-lang-string "Specify file name" :german "Dateiname der Koordinatendatei angeben.") :filename-incl-path t :initialPattern "*.txt" ) (teil :value-type :part-incl-new :wire-part-allowed t :title ,(sd-multi-lang-string "Part" :german "Teil") :initial-value (if (and (sd-inq-curr-part) (sd-inq-wire-part-p (sd-inq-curr-part))) (sd-inq-curr-part) nil ) :prompt-text ,(sd-multi-lang-string "Specify part name" :german "Name fÏr Drahtteil in welchem Kurven erzeugt werden sollen angeben.") :after-input (progn (when (equal (ts-land-check-for-empty-or-wired-part teil) :NotAllowed) (progn (sd-display-error (format nil (sd-multi-lang-string "\"~a\" ist not allowed. Part has to be a new part or an exising wired part" :german "\"~a\" zu wÌhlen ist in diesem Kontex nicht erlaubt") (sd-inq-obj-pathname teil))) (setf teil nil) ) ) ) ) ) :local-functions '( (main-action () (ts-land-kurven-mac (first Name) teil) ) ) :ok-action '(sd-call-cmds (main-action)) ;;:help-action `(ts_help (format nil "~a#Kurven_lesen" *ts-land-doc-file*)) ) ;;*************************************************************************** ;; CHECK INPUT FUNCTIONS * ;;*************************************************************************** (defun ts-land-check-for-empty-or-wired-part (teil) (let (teil-s) ;;(display teil) (if (not (sel_item-p teil)) (setf teil_s (sd-pathname-to-obj teil)) (setf teil_s teil) ) (if (sel_item-p teil) (if (sd-inq-wire-part-p teil) (setf ret :ok) ;; else (setf ret :NotAllowed) ) ;; else (setf ret :ok) ;; neuer Teil ) ret ) ) ;;*************************************************************************** ;; FUNCTIONS * ;;*************************************************************************** ;;--------------------------------------------------------------------------* ;; Funktion: ts-land-kurven-mac * ;; * ;; 3D-Kurven in von einer Datei einlesen * ;; * ;; * ;; Parameter : Name ... Dateiname * ;; * ;; * ;; Returnwert: ----------- * ;; * ;; Schaumberger G. 05.10.1998 * ;;-------------------------------------------------------------------------*/ (defun ts-land-kurven-mac (Name teil &optional nur_punkte) (let (datei_desc zeile punktliste koords zaehler) ;;(display "ts-land-kurven-mac") (setf datei_desc (open Name :direction :input :if-does-not-exist nil)) (if (equal datei_desc nil) (progn (sd-display-error (format nil (sd-multi-lang-string "Cannot open file ~a for reading" :german "Kann Datei ~a nicht zum Lesen Îffnen") Name)) ) ;; else (progn (setf zeile (read-line datei_desc nil "END-OF-FILE")) (setf zeile (string-trim '(#\Space #\Tab #\Newline) zeile)) (setf zaehler 1) (setf punktliste nil) (loop until (equal zeile "END-OF-FILE") do (progn ;;(display (format nil "zeile = <~a>" zeile)) (if (sd-string= zeile "") ;; Spline ist abgeschlossen (progn (ts-land-spline-zeichnen punktliste teil) (setf punktliste nil) ) ;; progn ;; else ;; naechsten Splinepunkt lesen (progn (setf koords (sd-string-split zeile " ,")) (if (equal (length koords) 3) (progn (setf pkt (make-gpnt3d :x (read-from-string (first koords)) :y (read-from-string (second koords)) :z (read-from-string (third koords)) )) (if nur_punkte (ts-land-spline-zeichnen (list pkt) teil) ;; else (setf punktliste (append punktliste (list pkt))) ) ) ;; else (display (format nil (sd-multi-lang-string "Error in line ~a" :german "Fehler in Zeile ~a in der Eingabedatei") zaehler)) ) ) ) ;; if ;; naechste Zeile (setf zeile (read-line datei_desc nil "END-OF-FILE")) (setf zeile (string-trim '(#\Space #\Tab #\Newline) zeile)) (incf zaehler) ) ;; progn ) ;; loop (close datei_desc) ;; den letzten Spline auch noch (ts-land-spline-zeichnen punktliste teil) ) ) ) ) (defun ts-land-spline-zeichnen (punktliste teil) (let (l pkt fehler) (setf l (length punktliste)) (when (> l 0) (if (< l 2) ;; einen Punkt einzeichnen (progn (setf pkt (first punktliste)) ;;(display (format nil "Zeichne 3D-Punkt <~a>" pkt)) (sd-call-cmds (LINKS-UI::VERTEX_CREATION :wire_part teil pkt)) ) ;; else ;; Spline zeichnen (progn ;;(display punktliste) (setf fehler nil) (setf spline (sd-call-cmds (apply #'LINKS-UI::SPLINE_DIALOG :spline_option_create_expand :point_pick_create :wire_part teil :closed :off punktliste) :failure (setf fehler t))) ;; Punkt auch einzeichnen (dolist (pkt punktliste) (progn (sd-call-cmds (LINKS-UI::VERTEX_CREATION :wire_part teil pkt)) ) ) ) ) ) ;; when ) )