;;--------------------------------------------------------------------------* ;; Copyright 2009 DC4 Technisches Büro GmbH * ;; * ;;--------------------------------------------------------------------------* ;; http://ww3.cad.de/foren/ubb/Forum29/HTML/003468.shtml * ;;--------------------------------------------------------------------------* ;; translated: german/english by der_Wolfgang@forum@Cad.de 07.12.2009 * ;; added: 2 time check for same point with utilitzy function * ;; + assist feedback by der_Wolfgang@forum@Cad.de 06.12.2009 * ;;--------------------------------------------------------------------------* (in-package :custom) (use-package :OLI) (unless (fboundp 'oli::sd-am-pnt-equal-p) ;; load missing tool from same directory (load (format nil "~A/sd_am_pnt_equal_p" (directory-namestring *load-truename*))) ) ;;--------------------------------------------------------------------------* (sd-defdialog 'dc4-anno-copy-sketch-dialog :dialog-title '(sd-multi-lang-string "Copy Sketch" :german "Skizze kopieren") :variables '( (quelle :selection (*sd-anno-sketch-seltype*) :prompt-text (sd-multi-lang-string "Select sketch to copy." :german "Skizze zum Kopieren angeben") :title (sd-multi-lang-string "Sketch" :german "Skizze") ) (ppnt :value-type :docupntcnp :prompt-text (sd-multi-lang-string "Specify start point for movement." :german "Ausgangspunkt fuer Verschiebung angeben") :title (sd-multi-lang-string "Start Pnt" :german "Startpunkt") :before-input (sd-execute-annotator-command :cmd "CANCEL") :check-function #'(lambda (np) (check-same-point np rpnt)) :after-input (sd-execute-annotator-command :cmd (format nil "LINE ~A ~A,~A" (if (string>= (getf (oli:sd-inq-version) :major) "14") "ASSIST" "") (oli::gpntdocu_x ppnt) (oli::gpntdocu_y ppnt))) ) (rpnt :value-type :docupntcnp :prompt-text (sd-multi-lang-string "Specify end point for movement." :german "Endpunkt fuer Verschiebung angeben") :title (sd-multi-lang-string "Dest Pnt" :german "Zielpunkt") :check-function #'(lambda (np) (check-same-point np ppnt)) :after-input (sd-execute-annotator-command :cmd "CANCEL") ) ) ;; end variables :local-functions '( (check-same-point (new-pnt other-pnt) (if other-pnt (if (sd-am-pnt-equal-p new-pnt other-pnt) (values :error (sd-multi-lang-string "Start and end point are identical!" :german "Start- und Zielpunkt sind identisch!")) :ok ) :ok)) (next-action () (let (uname mep1 mep2 comstring nothing) (setf uname (sd-am-inq-unique-name quelle)) (setf mep1 (format nil "~a,~a" (oli::gpntdocu_x ppnt) (oli::gpntdocu_y ppnt))) (setf mep2 (format nil "~a,~a" (oli::gpntdocu_x rpnt) (oli::gpntdocu_y rpnt))) (setf comstring (format nil "~a~% ~a~% ~a~a~a~% ~a~% ~a~% ~a~% ~a~% ~a~a~a~a~a~a~a~% ~a" "INQ_ENV 7" "LET Cname ('~'+(INQ 302))" "EDIT_PART '" uname "'" "END_PART" "INQ_ENV 7" "LET Pname ('~'+(INQ 302))" "INQ_PART Pname" "MODIFY COPY '" uname "' 0,0 ((" mep2 "+(-1)*" mep1 ") / (INQ 4)) END" "EDIT_PART Cname" )) (sd-execute-annotator-command :cmd comstring) (sd-process-event "*DOCU-CHANGE-OBJECT-TREE-EVENT*") );;let ) ) :cleanup-input '(sd-execute-annotator-command :cmd "CANCEL") :ok-action '(next-action) :help-action '(sd-display-url "http://osd.cad.de/lisp_2d_10.htm") )