{ElevMOD 3.10 - dbelfm@monitor.net - 6/30/2002}
Procedure ElevModel;
CONST
{Default Paramaters separation distances and view names}
P1='120'; {Horizontal Separation 10ft}
P2='120'; {Vertical Separation 10ft}
P3='FRONT'; {Front View Label}
P4='LEFT'; {Left View Label}
P5='RIGHT'; {Right View Label}
P6='BACK'; {Back View Label}
VAR
H,V,x1,y1,x2,y2,xbb,ybb,x,y,z,B,C,D,upi: REAL;
Cancel: BOOLEAN;
Name: STRING;
n,i,ver: INTEGER;
Hn,ssH: HANDLE;
Procedure Gunits(Var upi:REAL);
VAR x,y,z: REAL; Um,U2m: STRING;
BEGIN GetUnits(x,y,z,upi,Um,U2m); END;
Procedure CkWsheet(VAR ssH: HANDLE);
CONST
Wname='ElevMod Param';
BEGIN
ssH:=GetObject(Wname);
IF ssH<>NIL THEN TargetSprdSheet(ssH) ELSE BEGIN
NewSprdSheet(Wname,10,10,6,2,FALSE,FALSE);
ssH:=LNewObj;
SetName(LNewObj,Wname);
TargetSprdSheet(ssH);
LoadCell(1,1,'Hor Separation'); LoadCell(1,2,P1);
LoadCell(2,1,'Vert Separation'); LoadCell(2,2,P2);
LoadCell(3,1,'Front'); LoadCell(3,2,P3);
LoadCell(4,1,'Left'); LoadCell(4,2,P4);
LoadCell(5,1,'Right'); LoadCell(5,2,P5);
LoadCell(6,1,'Back'); LoadCell(6,2,P6);
END;
END;Procedure PModel(A: REAL);
VAR H: HANDLE;
BEGIN
DoMenuTextbyName('Paste In Place',0);
H:=LSActLayer;
HRotate(H,0,0,A);
IF (A=0) THEN B:=-(xbb-x) ELSE
IF (A=-90) THEN B:= (xbb-y) ELSE
IF (A=180) THEN B:= (Xbb-x) ELSE
IF (A=90) THEN B:=-(Xbb-y);
DoMenuTextbyName('Standard Views',3);
GetBBox(H,x1,y1,x2,y2);
IF (A=0)|(A=-90) THEN BEGIN
Move3DObj(H,B,0,ybb);
END;
IF (A=180)|(A=90) THEN BEGIN
Move3DObj(H,B,0,-ybb);
END;
DselectAll;
END;
Procedure MainBegin;
BEGIN
DoMenuTextByName('Copy',0);
Layer('Elevation Model');
DoMenuTextByName('Standard Views',1);
DselectAll; SelectObj((L='Elevation Model') & (T<>Light));
IF (Count(Sel=TRUE)>0) THEN DeleteObjs;
C:=GetLScale(ActLayer);
IF Fnderror then alrtdialog('error');
BeginGroup; DoMenuTextbyName('Paste In Place',0); EndGroup;
GetBBox(LnewObj,x1,y1,x2,y2);
x:=Abs(x2-x1)/2; y:=abs(y2-y1)/2;
MoveObjs(-(x1+x2)/2,-(y1+y2)/2,False,False);
xbb:=x+y+Abs(H)/2;
DoMenuTextByName('Standard Views',3);
GetBBox(LnewObj,x1,y1,x2,y2);
D:=1.2*C/8*upi;
MoveObjs(-(x1+x2)/2,-(y1+y2)/2+2*D,False,False);
DoMenuTextbyName('Cut',0);
ybb:=Abs(y2-y1);
z:=Abs(y2-y1)+abs(V/2); ybb:=z-Abs(y2-y1)/2;
TextSize(18); TextFont(21); TextJust(2);
PModel(0); MoveTo(B,V/2); CreateText(GetCellStr(ssh,3,2));
PModel(-90); MoveTo(B,V/2); CreateText(GetCellStr(ssh,5,2));
PModel(180); MoveTo(B,-z); CreateText(GetCellStr(ssh,6,2));
PModel(90); MoveTo(B,-z); CreateText(GetCellStr(ssh,4,2));
DselectAll;
DoMenuTextByName('Fit To Window',0);
END;
Procedure DefD1;
VAR sw,sh: INTEGER;
BEGIN
SW:=300; SH:=350;
BeginDialog(1,1,100,100,100+sw,100+sh);
SetTitle('Enter Separation Distances');
AddButton('OK',1,1,SW-90, SH-30,SW-30,SH-10);
AddButton('Cancel',2,1,SW-170, SH-30,SW-105,SH-10);
AddField('Creates 4 elevation views of Layer "MODEL" on Layer "Elevation Model"',4,1,15,10,SW-5,45);
AddField('Enter Horizontal Separation between views',5,1,15,55,SW-20,70);
AddField('',10,2,50,80,150,95);
AddField('Enter Vertical Separation between views',6,1,15,105,SW-20,120);
AddField('',11,2,50,130,150,145);
sh:=170;
AddField('View:',41,1,10,sh,55,sh+15);
AddField('Label:',42,1,65,sh,116,sh+15);
sh:=sh+25;
AddField('Front:',31,1,10,sh,52,sh+15);
AddField('',12,2,60,sh,299,sh+15);
sh:=sh+25;
AddField('Left:',32,1,20,sh,52,sh+15);
AddField('',13,2,60,sh,299,sh+15);
sh:=sh+25;
AddField('Right:',33,1,12,sh,52,sh+15);
AddField('',14,2,60,sh,299,sh+15);
sh:=sh+25;
AddField('Back:',34,1,15,sh,52,sh+15);
AddField('',15,2,60,sh,299,sh+15);
EndDialog;
EndDialog;
END;
Procedure RunD1;
Procedure VAL(n:INTEGER; VAR X: REAL);
BEGIN
IF NOT (ValidNumStr(GetField(n),x)) THEN BEGIN
SelField(n); i:=0; Sysbeep;
END
ELSE IF (ver=7) & (Pos(Name,GetField(n))=Len(GetField(n))) THEN x:=x*12;
END;
BEGIN
GetDialog(1);
SelField(10); Name:=Chr(39);
FOR n:=1 TO 2 DO SetField(9+n,Num2StrF(GetCellNum(ssH,n,2)));
FOR n:=3 TO 6 DO SetField(9+n,GetCellStr(ssH,n,2));
REPEAT
DialogEvent(i);
IF (i=1) THEN VAL(10,H);
IF (i=1) THEN VAL(11,V);
UNTIL(i=1)|(i=2);
IF i=1 THEN BEGIN
LoadCell(1,2,Num2Str(2,H));
LoadCell(2,2,Num2Str(2,V));
FOR n:=3 TO 6 DO LoadCell(n,2,GetField(9+n));
END;
ClrDialog;
END;Procedure LayerChk;
VAR H: HANDLE;
BEGIN
H:=Flayer; Cancel:=TRUE;
WHILE (i=0) & (H<>NIL) DO BEGIN
Name:=GetLname(H);
IF Name='MODEL' THEN Cancel:=FALSE;
H:=NextLayer(H);
END;
IF Cancel THEN AlrtDialog('A 3D object must be on a layer named "MODEL" to create
4 Elevation View layout!');
END;
Procedure ObjChk;
Function DoItem(H:HANDLE): BOOLEAN;
VAR a: REAL;
BEGIN
a:=CalcVolume(H);
WriteLn(Concat(H,',',a));
IF (a>0) THEN SetSelect(H) ELSE SetDSelect(H); redraw;
END;
BEGIN
Layer('MODEL');
DSelectAll;
DoMenuTextBYNAME('Layer Options',1);
DoMenuTextBYNAME('Standard Views',1);
ForEachObjectInLayer(DoItem,0,1,0);
DSelectObj(T=Light);
IF Count(Sel=TRUE)=0 THEN BEGIN
Cancel:=TRUE;
Alrtdialog('NO objects found! A 3D model must be on "MODEL" Layer to create 4 view layout.');
END;
END;Procedure DefD2(i:INTEGER);
VAR n,Sw,Sh,x,y: INTEGER;
BEGIN
Sw:=315; SH:=180;
BeginDialog(2,1,100,100,Sw+100,Sh+100);
SetTitle('ElevMod View Labels');
AddButton('OK',1,1,238,149,290,165);
AddButton('Cancel',2,1,158,149,222,165);
AddField('Front:',11,1,10,37,52,53);
AddField('Left:',12,1,20,64,52,80);
AddField('Right:',13,1,12,91,52,107);
AddField('Back:',14,1,15,118,52,134);
AddField('',21,2,54,37,299,53);
AddField('',22,2,54,64,299,80);
AddField('',23,2,54,91,299,107);
AddField('',24,2,54,118,299,134);
AddField('VIEW:',31,1,10,15,55,31);
AddField('LABEL:',41,1,65,15,116,31);
EndDialog;
GetDialog(2);
FOR n:=1 TO 4 DO SetField(20+n,GetCellStr(ssH,n,2));
REPEAT
DialogEvent(i);
UNTIL (i=1)|(i=2);
IF i=1 THEN FOR n:=1 TO 4 DO LoadCell(n,2,GetField(20+n));
END;BEGIN
ClrMessage;
GetVersion(ver,y1,x,y2);
IF Ver<9 THEN IF YNDialog('All script palettes must be closed or script copy paste functions may duplicate items in pallets instead of model elevations. All pallets closed?') THEN BEGIN
CkWsheet(ssH);
PushAttrs; i:=0;
LayerChk;
IF NOT Cancel THEN ObjChk;
IF NOT Cancel THEN BEGIN
Gunits(upi); DefD1; RunD1; END;
IF i=1 THEN MainBegin;
PopAttrs;
END;
END;
Run(ElevModel);