Assembly Posted July 13, 2012 Share Posted July 13, 2012 Here is a function I wrote to create an offset polyline. I draw flashings regularly. This code makes it easy. All you need to do is set the thickness, use the Next Point to give a distance and angle and this will create a closed poly line. PROCEDURE Offset; {Code by Justin Wright 14 July 2012} {Open to anyone cheers} TYPE Level1=Structure hTemp: Array[1..4] of Handle; GroupHandle:Handle; RectHandle:Handle; DirectionAngle:REAL; END; Var ArrayStore:Array[1..10] of Level1; PolyLocus:Array[1..100] of Handle; iPolyLocus:Integer; X1,Y1,X2,Y2:REAL; ArrayPoint:Integer; iCount:Integer; iTotal:Integer; Thickness:REAL; bTemp:BOOLEAN; PntA1,PntA2,PntB1,PntB2,PntIntersect: Point; PROCEDURE NextPoint(LineLength,ObjAngle:REAL); {This function creates a rectangle of locus points and stores the locus handels in an array} {The array also stores the direction angle} BEGIN ArrayPoint:=ArrayPoint+1; BEGIN; BeginGroup; Locus(0,0); ArrayStore[ArrayPoint].hTemp[1]:=LNewObj; Locus(LineLength,0); ArrayStore[ArrayPoint].hTemp[3]:=LNewObj; Locus(0,Thickness); ArrayStore[ArrayPoint].hTemp[2]:=LNewObj; Locus(LineLength,Thickness); ArrayStore[ArrayPoint].hTemp[4]:=LNewObj; EndGroup; ArrayStore[ArrayPoint].GroupHandle:=LNewObj; ArrayStore[ArrayPoint].DirectionAngle:=ObjAngle; iTotal:=iTotal+1; END END; PROCEDURE UsePointsMakeShape; BEGIN; {Get the hanel of each group of locus/ Rotate the group / Get the position of the previous group to move the current} hRotate(ArrayStore[1].GroupHandle,0,0,ArrayStore[1].DirectionAngle); {Get the position of a locus from previous group to move the current group into possition} For iCount:=2 to iTotal Do Begin; hRotate(ArrayStore[iCount].GroupHandle,0,0,ArrayStore[iCount].DirectionAngle); GetLocPt(ArrayStore[iCount-1].hTemp[3],X1,Y1); hMove(ArrayStore[iCount].GroupHandle,X1,Y1); End; {Use the Locus in the group to find the intersetoin of the lines. Create a new set of locus which will become the polyline points} {First Point} PolyLocus[iPolyLocus]:=ArrayStore[1].hTemp[1]; {Cycyle up through the group to the the inside} For iCount:=1 to iTotal-1 Do BEGIN; GetLocPt(ArrayStore[iCount].hTemp[1],PntA1.X,PntA1.y); GetLocPt(ArrayStore[iCount].hTemp[3],PntA2.x,PntA2.y); GetLocPt(ArrayStore[iCount+1].hTemp[1],Pntb1.x,PntB1.y); GetLocPt(ArrayStore[iCount+1].hTemp[3],PntB2.x,PntB2.y); LineLineIntersection(PntA1,PntA2,PntB1,PntB2,bTemp,bTemp,PntIntersect); Locus(PntIntersect.x,PntIntersect.y); iPolyLocus:=1+iPolyLocus; PolyLocus[iPolyLocus]:=LNewObj; END; {Get the two end points at the top of the polyline} iPolyLocus:=1+iPolyLocus; PolyLocus[iPolyLocus]:=ArrayStore[iTotal-1].hTemp[3]; iPolyLocus:=1+iPolyLocus; PolyLocus[iPolyLocus]:=ArrayStore[iTotal-1].hTemp[4]; {Cycle down the array to get the right hand side intersection points} For iCount:=iTotal-1 downto 2 Do BEGIN; GetLocPt(ArrayStore[iCount].hTemp[2],PntA1.X,PntA1.y); GetLocPt(ArrayStore[iCount].hTemp[4],PntA2.x,PntA2.y); GetLocPt(ArrayStore[iCount-1].hTemp[2],Pntb1.x,PntB1.y); GetLocPt(ArrayStore[iCount-1].hTemp[4],PntB2.x,PntB2.y); LineLineIntersection(PntA2,PntA1,PntB2,PntB1,bTemp,bTemp,PntIntersect); Locus(PntIntersect.x,PntIntersect.y); iPolyLocus:=1+iPolyLocus; PolyLocus[iPolyLocus]:=LNewObj; END; {The final two points at the end of the poly} iPolyLocus:=1+iPolyLocus; PolyLocus[iPolyLocus]:=ArrayStore[1].hTemp[2]; iPolyLocus:=1+iPolyLocus; PolyLocus[iPolyLocus]:=ArrayStore[1].hTemp[1]; {Now create a new poly line} BeginPoly; For iCount:=1 to iPolyLocus DO Begin; GetLocPt(PolyLocus[iCount],X1,Y1); LineTo(x1,y1); End; EndPoly; {Delete all the locus now note needed} For iCount:=1 to iPolyLocus-1 DO BEGIN IF PolyLocus[iCount]<>NIL THEN DelObject(PolyLocus[iCount]); END; For iCount:=1 to iTotal-1 DO BEGIN IF ArrayStore[iCount].GroupHandle<>NIL THEN DelObject(ArrayStore[iCount].GroupHandle); END; END; {Now create the actual Geometery of the Flashings} PROCEDURE WINDOWHEad(FlashWidth:Real); BEGIN; NextPoint(5,45); NextPoint(15,90); NextPoint(FlashWidth,15); NextPoint(35,90); NextPoint(1,180); NextPoint(5,-90); UsePointsMakeShape; END; {***MAIN FUNCTION BODY***} BEGIN; iTotal:=1; iPolyLocus:=1; Thickness:=.55; {To use the fuctions simply NextPoinst then usePointsMakeShape} NextPoint(5,45); NextPoint(40,90); NextPoint(20,180); NextPoint(30,90); NextPoint(120,-10); NextPoint(10,-45); UsePointsMakeShape; END; RUN(Offset); Quote Link to comment
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.