Here are a couple of scripts for creating lines parallel to a centerline. The first requires a polyline centerline made with arc vericies.The second provides different options for creating parallel lines and concentric arcs.
+++++++++++++++++++++++++++++++++++++++++++{Routine 1}{This routine was created to rapidy make Street pavement from a polyline centerline with line and arc components.The Centerline must be a polyline beginning with a corner vertex. The second vertex must be a arc vertex. The verticies of the centerline must then alternate corner,arc,corner,arc, etcand end with a corner vertex. It may be necessary to edit the polyline vertices If they donot follow the Proper sequence.The best way to create the centerline is to use the polyline tool set to Polyline by arc point.} {David J. Clinton Greatrac@Aol.com May 5 2002} PROCEDURE StreetFrmPolyCl050702;VARx,y,x1,y1,x2,y2,x3,y3,x5,y5,x10,y10,xpc,ypc,xpt,ypt,R1,R2,R3,Ang1,Ang2,D1:REAL;
Delta,T,Sang,AAng:REAL;
VertNo1,VertNo2,VertNo3,VertType1,VertType2,VertType3,NumVert:INTEGER;
Ptype,Fp,ITEM,LW,Efp,Elw,Epp:INTEGER;
HPoly,Hline1,Hline2,Harc1,Harc2,Harc3,HRect1,HR1,HR2,HPavemt1,HPavemt2:HANDLE;
BBack,BFront,abort,done,ok,BLoc:BOOLEAN;Procedure Dialog; VAR Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2 : INTEGER;
Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER); VAR scrx1,scry1,scrx2,scry2:INTEGER;BEGIN GetScreen(scrx1,scry1,scrx2,scry2); x1:=((scrx1+scrx2) div 2)-(Width div 2); x2:=x1+Width; END;
Procedure MakeDialog; CONST y1 = 100; scnh = 230; scnw = 220; BEGIN AlignScr(scnw,x1,x2); y2:=y1+scnh; px3:=(scnw div 2) - 70; px4:=(scnw div 2) - 10; px1:=(scnw div 2) + 10; px2:=(scnw div 2) + 70; py1:=scnh-40; py2:=scnh-20; BeginDialog(2,1,x1,y1,x2,y2); AddButton('OK',1,1,px1,py1,px2,py2); AddButton('Cancel',2,1,px3,py1,px4,py2); AddField('_______________________',3,1,20,18,210,33); AddField('Pavement Fill',4,1,20,10,165,25); AddField('Pavement Width',5,1,10,40,150,55); AddField('24',6,2,130,40,180,55); AddField('Fill Patern No',7,1,10,65,150,85); AddField('4',8,2,130,65,180,85); AddField('Line Weight',9,1,10,95,170,115); AddField('1',10,2,130,95,180,115); AddButton('Loci at Control Points',11,3,10,135,170,155); {AddButton('Loci at Control Points',12,3,10,95,170,115);} EndDialog;END;
BEGINMAKEDIALOG;END;
Procedure GetInfo;BEGINdone:=false;abort:=false;
GetDialog(2);
REPEAT
DialogEvent(Item);
IF Item = 1 THEN BEGIN OK:= ValidNumStr(GetField(6),D1); OK:= ValidNumStr(GetField(8),FP); OK:= ValidNumStr(GetField(10),LW); BLoc:=ItemSel(11); Done:= True; abort:=false; END; IF Item = 2 THEN BEGIN Done:= True; ABORT:= TRUE; END; IF Item = 11 THEN BEGIN SetItem(11,True); END;UNTIL DONE;ClrDialog;END;
PROCEDURE IntersectLines; {Subroutine}VARx1,y1,x2,y2,x3,y3,x4,y4,m1,m2,b1,b2:REAL;BEGIN IF (HR1<> NIL) AND (HR2 <> NIL) THEN BEGIN GetSegPt1(HR1,x1,y1); GetSegPt2(HR1,x2,y2); GetSegPt1(HR2,x3,y3); GetSegPt2(HR2,x4,y4); m1:=(y1-y2)/(x1-x2); m2:=(y3-y4)/(x3-x4); IF m1<>m2 THEN BEGIN b1:=-m1*x1+y1; b2:=-m2*x3+y3; x5:=(b1-b2)/(m2-m1); y5:=m1*x5+b1; IF Bloc THEN Locus(x5,y5); END; END; DSelectAll;END;
PROCEDURE LinePoly;VARx1,y1,x2,y2,Mang,Lang,LLeng:REAL;
HpL:HANDLE;
BEGIN AngleVar; DSelectAll; HPL:=Hline1; Lang:=HAngle(Hpl); LLeng:=HLength(Hpl); Mang:=Lang+90; GetSegPt1(Hpl,x1,y1); GetSegPt2(Hpl,x2,y2); MoveTo(x1,y1); BeginPoly; Addpoint(x1,y1); LineTo(D1,#Mang); LineTo(LLeng,#Lang); LineTo(2*D1,#(Mang+180)); LineTo(LLeng,#(Lang+180)); LineTo(x1,y1); EndPoly; DelObject(HPL); END;
BEGIN {=====================Actual Routine================================} dialog; getinfo; IF Abort = FALSE THEN BEGIN DSelectAll; AngleVar; D1:=D1/2; Efp:=FFillPat; Elw:=FPenSize; Epp:=FPenPat; PenPat(2); PenSize(LW);
Message('Pick the Polyline (Pick Air to Cancel)'); GetLine(x,y,x10,y10); ClrMessage; HPoly:=PickObject(x,y); Ptype:=GetType(Hpoly); IF (HPoly <> NIL) AND (Ptype = 21) THEN BEGIN NumVert:=GetVertNum(Hpoly); VertNo1:=1; REPEAT VertNo2:=VertNo1+1; VertNo3:=VertNo2+1; GetPolylineVertex(HPoly,VertNo1,x1,y1,VertType1,R1); GetPolylineVertex(HPoly,VertNo2,x2,y2,VertType2,R2); GetPolylineVertex(HPoly,VertNo3,x3,y3,VertType3,R3); IF (R2 <> 0) THEN {IF VertNo2 is an arc Vertex do this} BEGIN IF Hline1 = NIL THEN BEGIN Moveto(x1,y1); Lineto(x2,y2); Hline1:=LNewObj; DSelectAll; END; Moveto(x2,y2); Lineto(x3,y3); Hline2:=LNewObj; DSelectAll; Ang1:=Hangle(Hline1); Ang2:=Hangle(Hline2); Delta:=Abs(Ang2-Ang1); T:=Abs(R2*Tan(Deg2Rad(Delta/2))); Moveto(x2,y2); Move(T,#(Ang1+180)); PenLoc(xpc,ypc); IF Bloc THEN {PC of Arc} Locus(xpc,ypc); Lineto(R2,#(Ang1+90)); HR1:=LNewObj; Moveto(x2,y2); Move(T,#Ang2); PenLoc(xpt,ypt); IF Bloc THEN {PT of Arc} Locus(xpt,ypt); Lineto(R2,#(Ang2+90)); HR2:=LNewObj; SetSegPt2(Hline1,xpc,ypc); SetSegPt1(Hline2,xpt,ypt); DSelectAll; LinePoly; {Rectangle on First Line} HRect1:=LNewObj; SetFPat(HRect1,Fp); DSelectAll; IntersectLines; {Arc Center} DelObject(HR1); DelObject(HR2); MoveTo(x5,y5); Lineto(xpc,ypc); HR1:=LNewObj; MoveTo(x5,y5); Lineto(xpt,ypt); HR2:=LNewObj; DSelectAll; Sang:=Hangle(HR2); AAng:=Hangle(HR1)-Hangle(HR2); IF (AAng > 180) OR (AAng = 180) THEN AAng:=-(360-AAng); IF (AAng < -180) OR (AAng = -180) THEN AAng:=AAng+360; DelObject(HR1); DelObject(HR2); {++++++++++++++++++++++++Begin Arcs++++++++++++} Arc(x5-R2,y5+R2,x5+R2,y5-R2,#Sang,#AAng); Harc3:=LNewObj; {Centerline} ARC(x5-R2-D1,y5+R2+D1,x5+R2+D1,y5-R2-D1,#Sang,#AAng);{Outside} HArc1:=LNewObj; SetFPat(Harc1,Fp); ARC(x5-R2+D1,y5+R2-D1,x5+R2-D1,y5-R2+D1,#Sang,#AAng);{Inside} HArc2:=LNewObj; SetFPat(Harc2,Fp); DSelectAll; SetSelect(HArc1); SetSelect(Hrect1); DoMenuTextByName('Add Surface',0); HPavemt1:=LSActLayer; HMoveBackward(HPavemt1,BBack); HMoveForward(Harc2,BFront); DSelectAll; SetSelect(HPavemt1); SetSelect(HArc2); DoMenuTextByName('Clip Surface',0); DelObject(Harc2); DelObject(Harc3); SetSelect(HPavemt2); DoMenuTextByName('Add Surface',0); HPavemt2:=LSActLayer; DSelectAll; END; {++++++++++++++++++++++++End Arcs++++++++++++} Hline1:=Hline2; IF (R2 = 0) THEN BEGIN Moveto(x2,y2); Lineto(x3,y3); Hline1:=LNewObj; END; VertNo1:=VertNo1+1; UNTIL (VertNo3 = NumVert); Hline1:=Hline2; LinePoly; HRect1:=LNewObj; SetFPat(HRect1,Fp); DSelectAll; SetSelect(Hrect1); SetSelect(HPavemt2); DoMenuTextByName('Add Surface',0); END; HMoveForward(HPoly,TRUE); DSelectAll;Settool(2);PenPat(Epp);FillPat(Efp);PenSize(Elw);Redrawall;END;END;RUN (StreetFrmPolyCl050702);
===========================================+++++++++++++++++++++++++++++++++++++++++++==========================================={Routine 2}
{This routine creates a parallel line or arc on one or both sides of a mouse picked line or arc. Other options are to drag for multple parallel lines, move a line in a parallel direction or Creat a Polygon fill with the Both sides option selected. To pick the centerline one must pick And drag on the centerline. this allows srolling when picking multiple numer of objects }
{David J.Clinton Greatrac@Aol May 7, 2002}
PROCEDURE ParallelarcLine031502;
VARX,Y,x99,y99,multidist:REAL;obtype,item,multinum:INTEGER;ExFillPattern:LONGINT;HD: Handle;D1: REAL;oneside,both,abort,done,ok,multiple,polie,mov:BOOLEAN;{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
PROCEDURE Dialog;{CREATES Dialog and Retreves information} VAR Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2 : INTEGER; {-------------------------------------------------------} Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER); VAR scrx1,scry1,scrx2,scry2:INTEGER;
BEGIN GetScreen(scrx1,scry1,scrx2,scry2); x1:=((scrx1+scrx2) div 2)-(Width div 2); x2:=x1+Width; END; {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
Procedure MakeDialog; CONST y1 = 100; scnh = 230; scnw = 220;
BEGIN AlignScr(scnw,x1,x2); y2:=y1+scnh; px3:=(scnw div 2) - 70; px4:=(scnw div 2) - 10; px1:=(scnw div 2) + 10; px2:=(scnw div 2) + 70; py1:=scnh-40; py2:=scnh-20;
BeginDialog(2,1,x1,y1,x2,y2);
AddButton('OK',1,1,px1,py1,px2,py2); AddButton('Cancel',2,1,px3,py1,px4,py2); AddField('_______________________',3,1,20,18,210,33); AddField('Parrallel Arc/Line',4,1,20,10,165,25); AddField('Offset Distance',5,1,10,40,150,55); AddField('30',6,2,130,40,180,55); AddButton('One Side',7,3,70,65,190,85); AddButton('Both Sides',8,3,70,85,190,105); AddButton('Drag For Multiple',9,3,70,105,210,125); AddButton('Polygon Fill',10,3,70,125,210,145); AddButton('Move Line Parallel',11,3,70,145,210,165); EndDialog; END;{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++} BEGIN MAKEDIALOG; END;{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
Procedure GetInfo; BEGIN done:=false; abort:=false;
GetDialog(2); SELFIELD(6);
REPEAT DialogEvent(Item);
IF Item = 1 THEN BEGIN OK:= ValidNumStr(GetField(6),D1); {offset} oneside:=ItemSel(7); both:= ItemSel(8); MULTIPLE:= ItemSel(9); Polie:= ItemSel(10); Mov:=ItemSel(11); Done:= TRUE; Abort:=FALSE; END;
IF Item = 2 THEN BEGIN Done:= TRUE; ABORT:= TRUE; END; IF Item = 7 THEN BEGIN SetItem(7,TRUE); SetItem(8,FALSE); SetItem(9,FALSE); SetItem(10,FALSE); SetItem(11,FALSE); END;
IF Item = 8 THEN BEGIN SetItem(7,FALSE); SetItem(8,TRUE); SetItem(9,FALSE); SetItem(10,FALSE); SetItem(11,FALSE); END;
IF Item = 9 THEN BEGIN SetItem(7,FALSE); SetItem(8,FALSE); SetItem(9,TRUE); SetItem(10,FALSE); END; IF Item = 10 THEN BEGIN SetItem(7,FALSE); SetItem(8,true); SetItem(9,false); SetItem(10,true); SetItem(11,FALSE); END;
IF Item = 11 THEN BEGIN SetItem(7,FALSE); SetItem(8,false); SetItem(9,false); SetItem(10,false); SetItem(11,True); END;
UNTIL DONE;ClrDialog;END;
PROCEDURE ParallelLine;
VARX0,Y0,X1,Y1,X2,Y2,X3,Y3,X4,Y4,X5,Y5,x11,y11,x12,y12,x13,y13,X14,Y14,MANG,LANG,D,LineLeng:REAL;HTestPoly,HLt,HRt,HCtr,HPoly,HDc:HANDLE;Z:BOOLEAN;
BEGIN AngleVar; y:=0; X:=0; LANG:=0; MANG:=0; Hctr:=HD; D:=D1; X1:=0; Y1:=0; X2:=0; Y2:=0; X3:=0; Y3:=0; X4:=0; Y4:=0; X5:=0; Y5:=0;
IF Oneside THEN BEGIN LANG:=HAngle(HCtr); Lineleng:=Hlength(HCtr); MANG:=LANG+90; GetSegPt1(HCtr,X1,Y1); GetSegPt2(HCtr,X2,Y2); MoveTo(X1,Y1); MoveTo(1000,#Mang); PenLoc(X3,Y3); MoveTo(X2,Y2); MoveTo(1000,#Mang); PenLoc(X4,Y4); Message('Pick Direction'); GetPt(X5,Y5); ClrMessage; Poly(X1,Y1,X3,Y3,X4,Y4,X2,Y2); HTestpoly:=LNewObj; Z:=PtInPoly(X5,Y5,HTestPoly); DelObject(HtestPoly);
IF Z THEN BEGIN Moveto(X1,Y1); Move(D,#Mang); Lineto(LineLeng,#Lang); Hlt:=LNewObj; SetDselect(HLt); END;
IF Not Z THEN BEGIN Moveto(X1,Y1); Move(-D,#Mang); Lineto(LineLeng,#Lang); HRt:=LNewObj; SetDselect(HRt); END; Z:=False; END; {End of one Side}
IF Both THEN BEGIN LANG:=HAngle(HCtr); Lineleng:=Hlength(HCtr); MANG:=LANG+90; GetSegPt1(HCtr,X1,Y1); GetSegPt2(HCtr,X2,Y2); Moveto(X1,Y1); Move(D,#Mang); Lineto(LineLeng,#Lang); Hlt:=LNewObj; SetDselect(HLt); Moveto(X1,Y1); Move(-D,#Mang); Lineto(LineLeng,#Lang); HRt:=LNewObj; SetDselect(HRt);
IF Polie THEN BEGIN GetSegPt1(HLt,x11,y11); GetSegPt2(HLt,x12,y12); GetSegPt2(HRt,x13,y13); GetSegPt1(HRt,x14,y14); Poly(X11,Y11,X12,Y12,X13,Y13,X14,Y14,X11,Y11); HPoly:=LNewObj; SetDselect(Hpoly); SetFPat(HPoly,5); HMoveBackward(HPoly,TRUE); DelObject(HRt); DelObject(HLt); END;
END; {End of Both sides}
IF Mov THEN BEGIN Z:=FALSE; LANG:=HAngle(HCtr); Lineleng:=Hlength(HCtr); MANG:=LANG+90; GetSegPt1(HCtr,X1,Y1); GetSegPt2(HCtr,X2,Y2); MoveTo(X1,Y1); MoveTo(1000,#Mang); PenLoc(X3,Y3); MoveTo(X2,Y2); MoveTo(1000,#Mang); PenLoc(X4,Y4); Poly(X1,Y1,X3,Y3,X4,Y4,X2,Y2); HTestpoly:=LNewObj; Message('Pick Direction'); GetPt(X5,Y5); ClrMessage; Z:=PtInPoly(X5,Y5,HTestPoly); DelObject(HtestPoly); DSelectObj(ALL); SetSelect(HCtr);
IF NOT Z THEN BEGIN MoveObjs(-D,#MANG,FALSE,FALSE); SetDSelect(Hctr); HCtr:=NIL; END;
IF Z THEN BEGIN MoveObjs(D,#MANG,FALSE,FALSE); SetDSelect(Hctr); HCtr:=NIL; END; RedrawAll; END;
{----------------------------------------------------} IF MULTIPLE THEN BEGIN LANG:=HAngle(HCtr); Lineleng:=Hlength(HCtr); MANG:=LANG+90; GetSegPt1(HCtr,X1,Y1); GetSegPt2(HCtr,X2,Y2); MoveTo(X1,Y1); MoveTo(10000,#Mang); PenLoc(X3,Y3); MoveTo(X2,Y2); MoveTo(10000,#Mang); PenLoc(X4,Y4); Poly(X1,Y1,X3,Y3,X4,Y4,X2,Y2); HTestPoly:=LNewObj; Z:=PtInPoly(X99,Y99,HTestPoly); DelObject(HtestPoly);
IF NOT Z THEN D:=-D; Moveto(X1,Y1); Lineto(X2,Y2); HDc:=LNewObj;
REPEAT DSelectObj(ALL); SetSelect(HDc); MoveObjs(D,#MANG,FALSE,FALSE); Duplicate(0,0); HDc:=LNewObj; MULTINUM:=MULTINUM-1; UNTIL(MULTINUM<0) OR (HDc=NIL); END;{EndMultiple} END; {+++++++++++++++++++++++++++++++++++++++++++++++}
PROCEDURE ParallelArc;VAR X1,Y1,X2,Y2,R,DB,X4,Y4,X5,Y5,D,X7,X8,Y7,Y8,Cvalx,RAD,Cvaly,SAng,AAng : REAL; HArcOut,HarcIn,HArcCenter:HANDLE;
BEGIN AngleVar; HArcIn:=Nil; HarcOut:=NIL; HArcCenter:=HD; GetArc(HArcCenter,SANG,AANG); Rad:=(HPerim(Hd)/Deg2Rad(AAng)); HCenter(HArcCenter,CValX,CValY);
IF NOT both THEN BEGIN Message('Pick Direction'); GetPt(X2,Y2); DB:=Distance(X2,Y2,cvalX,cvalY);
IF DB > RAD THEN BEGIN R:=RAD+D1; X7:=Cvalx+R; Y7:=Cvaly-R; X8:=Cvalx-R; Y8:=Cvaly+R; ARC(X8,Y8,X7,Y7,#SANG,#AANG); HarcOut:=LNewObj; SetDSelect(HArcOut); END;
IF DB < RAD THEN BEGIN R:=RAD-D1; X7:=Cvalx+R; Y7:=Cvaly-R; X8:=Cvalx-R; Y8:=Cvaly+R; ARC(X8,Y8,X7,Y7,#SANG,#AANG); HArcIn:=LNewObj; SetDSelect(HArcIn); END;END;
IF Both THEN BEGIN R:=RAD+D1; X7:=Cvalx+R; Y7:=Cvaly-R; X8:=Cvalx-R; Y8:=Cvaly+R; ARC(X8,Y8,X7,Y7,#SANG,#AANG); HArcOut:=LNewObj; SetDSelect(HArcOut);
R:=RAD-D1; X7:=Cvalx+R; Y7:=Cvaly-R; X8:=Cvalx-R; Y8:=Cvaly+R; ARC(X8,Y8,X7,Y7,#SANG,#AANG); HArcIn:=LNewObj; SetDSelect(HArcIn); END;
IF Polie THEN BEGIN SetFPat(HArcOut,5); HMoveBackward(HArcOut,TRUE); SetFPat(HArcIn,5); SetSelect(HArcOut); SetSelect(HArcIn); DoMenuTextByName('Clip Surface',0); DelObject(HarcIn); DSelectAll; END;END;{===================================}
BEGIN {Main Routine} Multiple:=FALSE; Done:= FALSE; ABORT:= FALSE; both:=false; Mov:=False; oneside:=false; ok:=false; Dialog; GetInfo; DSelectAll;
IF NOT Abort THEN BEGIN ExFillPattern:=FFillPat; FillPat(0); Message('Pick and Drag a Line or Arc( Pic Air Cancel)'); GetLine(X,Y,x99,y99); HD:=PickObject(X,Y); ClrMessage; IF (HD <> NIL) THEN REPEAT multidist:=distance(x,y,x99,y99); multinum:=Round(multidist/d1); Obtype:=GetType(HD);
IF Obtype = 2 THEN BEGIN SetLS(HD,-6); PARALLELLINE; Redraw; END;
IF Obtype = 6 THEN BEGIN SetLS(HD,-6); PARALLELARC; Redraw; END; Message('Pick and Drag a Line or Arc( Pic Air Cancel)'); GetLine(X,Y,x99,y99); HD:=PickObject(X,Y); Obtype:=GetType(HD); ClrMessage; UNTIL ((HD = NIL) OR ((obtype <> 2) AND (obtype <> 6))); END;
FillPat(ExFillPattern);ClrMessage;ReDraw;SetTool(2);DSelectAll; END;Run(ParallelarcLine031502);