;=============================PRP3-2003=============================;
;THIS MACRO HAS BEEN WRITTEN IN 20-08-2003 ;
;PLACE:    GREECE
:AUTHOR:   ANASTASIOS N.NEROUTSOS;
:COMMENTS: THE MACRO CREATES relative DATUM DIMENSIONS ;
          ;IT GIVES 0,0 COORDIN. IN A REF.POINT AND CALCULATES THE NEXT;
          ;POINTS PICKED,FROM THIS ORIGIN;
;MENU:     AYTONOMOUS;
;USERS:    ESPECIALY FOR MECHAN.ENGINEERS
;LICENCE:  FREE FOR ANYONE 
;e-mail:    anero@tee.gr
;====================================================================;


  .ARXIKOPOIHSH;
  /MSP,++;
  /XMD,++;
  LT,0,!,LW,1,!,LK,14,!;
   MO;     
  un,!;
;
   .TEXT;
   /PMT,1,'   Give me the [TEXT SIZE]...... .? :___ ',#;
   /VRL,0,~,/PMT,1,#;  
    TZ,$R(0);
    us,t,z,$r(0),!,!,!;
    ;
   .APXH;==========================================
    /PMT,1,#,/PMT,2,#,/PMT,3,#;
   /PMT,1,'   Pick a ^MREF^^ POINT....? :___ ',#;
   /Vpt,4,@,/PMT,1,#;  
   bp,$x(4),$y(4);
   dc,b,;
   /pmt,1,#;
;                     
   /PMT,1,' Pick [shoulder start]   ?.: .. ',#;
   L1,$x(4),$y(4),@;
  /vpt,41,$pntx,$pnty;
  oo;
;
/PMT,1,#;
TS,B,++,!;
   LD,$X(4),$Y(4),$X(41),$Y(41),@,  REF X=Y=0 ,#;
TS,B,--,!;
    /GOTO,VOLOS;
       ;   
    .VOLOS;
LL,!;
/VRL,14,$VAL;		              MHKOS SHOULDER = R14

    /PMT,1,#,/PMT,3,#;        =============================
    /PMT,2,' SELECT a [Point] ..........? :  <ESC> to stop ',#;
    /VPT,0,@;
    /IF,$DERR[EQ]-2,/goto,nikos;
      ;
   .SYNE;
   /PMT,1,#, /PMT,2,#;  
   /PMT,3,' (D r a g for [Leader] -Shoulder text   of point)...?: .... ',#;  arist-dejia
 L1,$X(0),$Y(0),@;
/VPT,41,$PNTX,$PNTY;		2 SHMEIO
;
 /PMT,3,'Flip      shoulder           [text] ............  ...?: .... ',#;                    keimeno
/VPT,51,@;		3 SHMEIO ARIST-DEJIA
 LD,$X(0),$Y(0),$X(41),$Y(41),$X(51),$Y(51), ,#;
/IF,$X(51)[GT]$X(41),/GTO,THETIKO;
/IF,$X(51)[LT]$X(41),/GTO,ARNHTIKO;
;
.THETIKO;
/VPT,0,$X(0)-$X(4),$Y(0)-$Y(4),;
TS,J,L,!;
   /VRL,1,$X(0),;
   /VRL,2,$Y(0),;         
    /VST,1,X;         
   /VST,2,Y;  
;
 /VPT,61,$X(41)+1.10*$R(14),$Y(41);	SHMEIO TELOUS SHOULDER  GIA SYNTETAGMENH
  TL,$X(61),$Y(61),$S(1),$S(2),!,#,PU,;
  TL,$X(61)+1.5*$R(0),$Y(61),$R(1),$R(2),!,#,PU,;    GRAFEI TOH SYNTETAGM.

/GTO,VOLOS;
;
.ARNHTIKO;
/VPT,0,$X(0)-$X(4),$Y(0)-$Y(4),;
TS,J,R,!;
   /VRL,1,$X(0),;		synteta
   /VRL,2,$Y(0),;   		syntetagmenes
    /VST,1,X;         		x 
    /VST,2,Y;  		y
 /VPT,61,$X(41)-1.10*$R(14),$Y(41);	SHMEIO TELOUS SHOULDER  GIA SYNTETAGMENH
;
NF,D,!,!;			DEKADIKA PSHFIA
/VRL,16,$VAL;
/VRL,20,$R(0);
;
/IF,$R(16)[EQ]2,/VRL,20,5*$R(0);  AN EINAI 2 DEKADIKA
/IF,$R(16)[EQ]3,/VRL,20,6*$R(0); 
/IF,$R(16)[EQ]4,/VRL,20,8*$R(0);              	"	
/IF,$R(16)[EQ]6,/VRL,20,10*$R(0);	"
;
TL,$X(61)-$R(20),$Y(61),$S(1),$S(2),!,#,PU,
TL,$X(61),$Y(61),$R(1),$R(2),!,#,PU;
/GTO,VOLOS;
   ;
   .nikos;   
   /PMT,2,' Pick a new [REF] point or [END] the macro ? >:  New[R]ef    [E]nd',#,/cin;
  ;     
  /IF,$VAL [EQ] 1,/GOTO,APXH; 
  /IF,$VAL [EQ] 2,/GOTO,TERMA;
    ; 
   .TERMA;
   /PMT,2,' AnaSoft   [AVGOUSTOS 2003 ] , ',#; 
   /CIN,/PMT,1,/pmt,2,/pmt,3,#;
   dc,a,;
    mo;
   /MSP,--,;
   /XMD,--,;
  ;............TELOS  TOY MACRO....................................;