;;--------------------------------------------------------------------------* ;; Copyright 2003 DC4 Technisches Büro GmbH * ;; * ;;--------------------------------------------------------------------------* ;; Dateiname: am_mirror.lsp ;; Version : 1.0 ;; Datum : 21.08.2003 ;; Author : Gt ;; ;; translated: german/english by der_Wolfgang@forum@Cad.de 23.10.2007 ;; added: sketch+mirror axes feedback by der_Wolfgang@forum@Cad.de mar2008 ;;--------------------------------------------------------------------------* (in-package :custom) (use-package :OLI) (sd-defdialog 'dc4-anno-ansicht-spiegeln-dialog :dialog-title '(sd-multi-lang-string "Mirror View/Sketch" :german "Ansicht/Skizze spiegeln") :variables '( (ans :selection (*sd-anno-view-seltype* *sd-anno-sketch-seltype*) :prompt-text (sd-multi-lang-string "Select view / sketch to mirror" :german "Ansicht / Skizze zum Spiegeln angeben.") :title (sd-multi-lang-string "View/Sketch" :german "Ansicht/Skizze") :gui-value (when ans (sd-am-inq-name ans)) :multiple-items nil :check-function #'(lambda (para) (if nil :ok :err)) :confirmation (:Err :dialog :warning :prompt (sd-multi-lang-string "Mirroring the view/sketch might damage some dimensions!" :german (format nil "~a~%~a" "Durch das Spiegeln koennen Bemassungen beschaedigt werden," "besonders nach erneutem Aktualisieren!")) :severity :high :cancel-cleanup (cancel) ) :next-variable 'pnt1 ) (m2p :value-type :boolean :toggle-type :wide-toggle :title (sd-multi-lang-string "2 points" :german "2 Punkte") :initial-value t :after-input (after-m2p-action) :next-variable 'pnt1 ) (mh :value-type :boolean :toggle-type :wide-toggle :title (sd-multi-lang-string "horizontal" :german "waagerecht.") :after-input (after-mhv-action) :next-variable 'pnt1 ) (mv :value-type :boolean :toggle-type :wide-toggle :title (sd-multi-lang-string "vertical" :german "senkrecht") :after-input (after-mhv-action) :next-variable 'pnt1 ) ("-") (mirror-axes-info :initial-value (format nil "next_mirror_axes_~A" (random 999999))) (assist :value-type :boolean :toggle-type :wide-toggle :title (sd-multi-lang-string "Draw Axes Assistance" :german "Zeige Achsen Hilfe") :initial-value T :next-variable 'pnt1 ) (pnt1 :value-type :docupntcnp :toggle-type :invisible :prompt-text (sd-multi-lang-string "Specify 1st point on mirror axis" :german "Erster Punkt fuer Spiegelachse angeben") :title (sd-multi-lang-string "Pnt 1" :german "Punkt 1") :before-input (progn ;; delete previous, if any.. (sd-execute-annotator-command :cmd (format nil "DELETE INFOS '~A' END" mirror-axes-info)) ;; start persitent feedback (sd-execute-annotator-command :cmd (format nil "C_LINE ~A ~A" (if assist "ASSIST" "") (cond (m2p "TWO_PTS") (mh "HORIZONTAL") (mv "VERTICAL") ) ;; end cond )) ) ;; end progn :before-input :after-input (progn (sd-execute-annotator-command :cmd (format nil "~A,~A ~A" (oli::gpntdocu_x pnt1) (oli::gpntdocu_y pnt1) (if m2p "" "END") )) (sd-set-variable-status 'pnt2 :enable m2p) ) ;; end progn :after-input :next-variable (when m2p 'pnt2) ) (pnt2 :value-type :docupntcnp :toggle-type :invisible :prompt-text (sd-multi-lang-string "Specify 2nd point on mirror axis" :german "Zweiter Punkt fuer Spiegelachse angeben") :title (sd-multi-lang-string "Pnt 2" :german "Punkt 2") :initial-enable nil :after-input (sd-execute-annotator-command :cmd (format nil "~A,~A END" (oli::gpntdocu_x pnt2) (oli::gpntdocu_y pnt2) )) ) ) :mutual-exclusion '((m2p mh mv)) :local-functions '( (after-m2p-action () (sd-set-variable-status 'pnt1 :enable t) (sd-set-variable-status 'pnt2 :enable nil) ) (after-mhv-action () (sd-set-variable-status 'pnt1 :enable t) (sd-set-variable-status 'pnt2 :enable nil) ) (next-action () (let (uname mep1 mep2 comstring) (setf uname (sd-am-inq-unique-name ans)) (setf mep1 (format nil "~a,~a" (oli::gpntdocu_x pnt1) (oli::gpntdocu_y pnt1))) (cond (mv (setf mep2 (format nil "~a,~a" (oli::gpntdocu_x pnt1) (+ 1 (oli::gpntdocu_y pnt1))))) (mh (setf mep2 (format nil "~a,~a" (+ 1 (oli::gpntdocu_x pnt1)) (oli::gpntdocu_y pnt1)))) (m2p (setf mep2 (format nil "~a,~a" (oli::gpntdocu_x pnt2) (oli::gpntdocu_y pnt2)))) );;cond (setf comstring (format nil "~a '~a'~%~a~%~a ~a ~a '~a' ~a~%~a" "EDIT_PART" uname "END_PART" "MODIFY MIRROR DEL_OLD KEEP_READABLE TWO_PTS" mep1 mep2 uname "END" "EDIT_PART PARENT" ;; EDIT_PART TOP is quite dangerous!!! )) ;;(display comstring) (sd-execute-annotator-command :cmd comstring) ) ) (clean-action () (progn (sd-am-change-curr-info-attribute mirror-axes-info "") (sd-execute-annotator-command :cmd (format nil "DELETE INFOS '~A' END" mirror-axes-info)) ) ) ) :after-initialization '(sd-am-add-curr-info-attributes (list mirror-axes-info)) :cancel-action '(clean-action) :ok-action '(progn (clean-action) (next-action)) )