;;;   CADDPAK   2003     General Macro Package for General CADD Pro
;;;   PROPSCAL.MCR       proportional scale macro
;;;   Copyright 2003 by Bjorn R Holmgren; all rights reserved.
;;; 
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
/MSP,++,/XMD,++,MO;
/VLC,;
;
.INITIALISE;
NF,D,!,!,/VIN,6,$VAL;
OR,??,/VIN,13,$VAL,OR,--;
NF,D,6,!;
;
.FROM;
/PMT,2,#,/PMT,3,#,/VST,2,NOTSET;
.FROM1;
/PMT,1,'Pick Object to Scale From ...',%45,'<ENTER> to Zoom',#;
/VPT,10,@;
/IF,$DERR[EQ]-1,/VST,2,FROM,/GTO,ZOOM;
/IF,$DERR[EQ]-2,/GTO,EXIT;
/CEL,O,$X(10),$Y(10),!;
/IF,$VAL[EQ]0,/PMT,2,'Object not found ...',%45,'<ESC> to Quit',#,/GTO,FROM1;
/PMT,2,#;
/EEX,1,E,/VIN,0,$VAL;
/EEX,1,N,/VIN,1,$VAL;
/EEX,1,P,1,A,/VPT,0,$PNTX,$PNTY;
/IF,$I(1)[GT]1,/EEX,1,P,2,A,/VPT,1,$PNTX,$PNTY;
/IF,$I(1)[GT]2,/EEX,1,P,3,A,/VPT,4,$PNTX,$PNTY;
/DEL;
/IF,$I(2)[EQ]1,/PMT,2,'^^^GPoint chosen /!!! ... Pick again ...^^',#,/GTO,FROM1;
/VRL,4,1,/VRL,5,1;
/IF,$I(2)[NE]10,/GTO,TO;
/PMT,1,'^^^GD^^iameter ... or ... ^GR^^adius ... ?',#,/CIN;
/IF,$VAL[EQ]1,/VRL,4,2;
;
.TO;
/PMT,2,#,/PMT,3,#,/VST,2,NOTSET;
.TO1;
/PMT,1,'Pick Object to Scale to ...',%45,'<ENTER> to Zoom',#;
/VPT,10,@;
/IF,$DERR[EQ]-1,/VST,2,TO,/GTO,ZOOM;
/IF,$DERR[EQ]-2,/GTO,EXIT;
/CEL,O,$X(10),$Y(10),!;
/IF,$VAL[EQ]0,/PMT,2,'Object not found ...',%45,'<ESC> to Quit',#,/GTO,TO1;
/PMT,2,#;
/EEX,1,E,/VIN,2,$VAL;
/EEX,1,N,/VIN,3,$VAL;
/EEX,1,P,1,A,/VPT,2,$PNTX,$PNTY;
/IF,$I(3)[GT]1,/EEX,1,P,2,A,/VPT,3,$PNTX,$PNTY;
/IF,$I(3)[GT]2,/EEX,1,P,3,A,/VPT,5,$PNTX,$PNTY;
/DEL;
/IF,$I(2)[EQ]1,/PMT,2,'^^^GPoint chosen /!!! ... Pick again ...^^',#,/GTO,TO1;
/IF,$I(2)[NE]10,/GTO,CALC;
/PMT,1,'^^^GD^^iameter ... or ... ^GR^^adius ... ?',#,/CIN;
/IF,$VAL[EQ]1,/VRL,5,2;
;
.CALC;
/IF,$I(0)[EQ]11,/VPT,1,$X(4),$Y(4);
/IF,$I(2)[EQ]11,/VPT,3,$X(5),$Y(5);
/VRL,0,$SQT( $SQR($X(0)-$X(1))+$SQR($Y(0)-$Y(1)) );
/VRL,1,$SQT($SQR($X(2)-$X(3))+$SQR($Y(2)-$Y(3)));
/VRL,3,($R(5)*$R(1))/($R(4)*$R(0));
;
/VIN,10,0,/VST,3,FIRST;
;
.REFMODE;
/PMT,1,'Scale each objects in place or relative to one common point ?',#;
/PMT,2,'^^^ME^^ach_in_place   ^MC^^ommon_point',#,/CIN;
/IF,$VAL[EQ]1,/VST,1,EACH;
/IF,$VAL[EQ]2,/VST,1,COMMON;
/IF,$VAL[EQ]-1,/GTO,REFMODE;
/IF,$VAL[EQ]-2,/GTO,EXIT;
/IF,$VAL[EQ]0,/GTO,REFMODE;
;
.SELECTION;
/PMT,2,#,/VST,2,NOTSET;
/IF,$I(10)[NE]0,/PMT,2,'^^',%44,'<RETURN> for ^G',$S(3),'^^',#; 
.SELECTION1;
/PMT,1,'Pick Selection Set to be scaled ...',%42,'<ESC> to quit ...',#;
/IF,$S(1)[EQ]EACH,/PMT,3,'^^^MW^^indow   ^MO^^bject',%47,'^MM^^ode',%57,'^MZ^^oom',#,/CIN,/PMT,2,#,/PMT,3,#;
/IF,$S(1)[EQ]COMMON,/PMT,3,'^^^MW^^indow   ^MO^^bject  ^MF^^inish_selection',%51,'^MM^^ode',%61,'^MZ^^oom',#,/CIN,/PMT,2,#,/PMT,3,#;
/IF,$STR[EQ]W,/GTO,WIN;
/IF,$STR[EQ]O,/GTO,OBJ;
/IF,$STR[EQ]F,/IF,$S(3)[EQ]FIRST,/GTO,SELECTION;
/IF,$STR[EQ]F,/IF,$S(1)[EQ]EACH,/GTO,EXIT;
/IF,$STR[EQ]F,/IF,$S(1)[EQ]COMMON,/GTO,SCALE;
/IF,$STR[EQ]M,/IF,$I(10)[EQ]0,/GTO,REFMODE;
/IF,$STR[EQ]M,/GTO,SELECTION;
/IF,$STR[EQ]Z,/VST,2,SELECTION,/GTO,ZOOM;
/IF,$VAL[EQ]-1,/IF,$I(10)[EQ]0,/GTO,SELECTION; 
/IF,$VAL[EQ]-1,/IF,$S(3)[EQ]O,/GTO,OBJ;
/IF,$VAL[EQ]-1,/IF,$S(3)[EQ]W,/GTO,WIN;
/IF,$VAL[EQ]-1,/IF,$S(3)[NE]FIRST,/GTO,OBJSEL; 
/IF,$VAL[EQ]-2,/GTO,EXIT;
/IF,$VAL[EQ]0,/GTO,SELECTION;
;
.OBJ;
/VST,3,O;
/PMT,2,#,/PMT,3,'^^^GOBJECT MODE^^ ... Pick Objects ...',#;
/IF,$S(1)[EQ]EACH,/CEL,O,@,!;
/IF,$S(1)[EQ]COMMON,/IF,$I(10)[EQ]0,/CEL,O,@,!;
/IF,$S(1)[EQ]COMMON,/IF,$I(10)[GT]0,/CEL,L,O,@,!;
/IF,$VAL[EQ]0,/PMT,2,'Nothing selected ...',#,/GTO,SELECTION1;
/VIN,10,$I(10)+1;
/IF,$S(1)[EQ]EACH,/GTO,SCALE;
/GTO,SELECTION;
;
.WIN;
/VST,3,W;
/PMT,2,#,/PMT,3,'^^^GWINDOW MODE^^ ... Pick Objects ...',#;
/IF,$S(1)[EQ]EACH,/CEL,W,@,@,!;
/IF,$S(1)[EQ]COMMON,/IF,$I(10)[EQ]0,/CEL,W,@,@,!;
/IF,$S(1)[EQ]COMMON,/IF,$I(10)[GT]0,/CEL,L,W,@,@,!;
/IF,$VAL[EQ]0,/PMT,2,'Nothing selected ...',#,/GTO,SELECTION1;
/VIN,10,$I(10)+1;
/IF,$S(1)[EQ]EACH,/GTO,SCALE;
/GTO,SELECTION;
;
.SCALE;
/PMT,3,#,/PMT,1,'^^^GPick reference point^^',#;
SZ,L,!,@,$R(3),$R(3);
/IF,$VAL[EQ]0,/GTO,SCALE;
/IF,$DERR[EQ]-1,/GTO,SCALE;
/IF,$DERR[EQ]-2,/GTO,EXIT;
/VIN,10,0,/DEL,/GTO,SELECTION;
;
.ZOOM;
/PMT,3,#,/PMT,1,'Select Zoom Mode ...',%45,'<ESC> to abort ...',#;
/PMT,2,'^^^MW^^indow  ^MP^^revious  ^MI^^n  ^MO^^ut  ^MA^^ll   PA^MN^^   A^MB^^ort',#,/CIN;
/IF,$STR[EQ]W,/PMT,2,#,/PMT,1,'Enter Window ... ',#,ZW,@,@,/GTO,LEAVEZOOM;
/IF,$STR[EQ]P,ZP,/GTO,LEAVEZOOM;
/IF,$STR[EQ]I,/PMT,2,#,/PMT,1,'Enter Centre of View ... ',#,ZI,@,/GTO,LEAVEZOOM;
/IF,$STR[EQ]O,/PMT,2,#,/PMT,1,'Enter Centre of View ... ',#,ZO,@,/GTO,LEAVEZOOM;
/IF,$STR[EQ]A,ZA,/GTO,LEAVEZOOM;
/IF,$STR[EQ]N,/PMT,2,#,/PMT,1,'Enter Centre of View ... ',#,PA,@,/GTO,LEAVEZOOM;
/IF,$STR[EQ]B,/GTO,LEAVEZOOM;
/IF,$VAL[EQ]-2,/GTO,LEAVEZOOM;
/IF,$VAL[LE]0,/GTO,ZOOM;
.LEAVEZOOM;
/GTO,$S(2);
;
.EXIT;
NF,D,$I(6),!;
/IF,$I(13)[EQ]1,OR,++;
.END;
MR;
/VLC,I,20,P,20,R,20,S,20,!;
/XMD,--,/MSP,--,PU;