Extrude Polygons to 3D Locus Point

[Pat Stanford]

This script checkes each 2D Polygon on the active layer to see if there is exactly one 3D locus point within its boundaries. If there is exactly 1 loci, then a duplicate of the polygon is made and extruded. The original polygon and the locus point are deleted. At the end of the script all of the remaining polygons and locus points are selected.

I origianlly tried to use ForEveryObject to do this, but it seemed that the handle to the new Extrude was somehow getting placed into the stack and being handled in the routine designed to handle the loci. It was easier to write my own handlers and use global variables than to troubleshoot the ForEveryObject problem.

Use as you see fit, but please credit me if you use this.

Pat

===============

Procedure ExtrudePolygonTo3DLoci;

{? 2007, Coviana, Inc - Pat Stanford pat@coviana.com}

{Licensed unde the GNU Lesser General Public License}

{This procedure steps through each 2D Polygon}

{on the active layer looking for 3D Loci located}

{with the boundary of the poly. If there is }

{exactly one 3D Loci within the Poly boundary}

{the polygon is extruded to the Z-Height of}

{the Loci and the Loci is deleted. If there are}

{no 3D Loci or more than 1 3D Loci, the polgon}

{is left untouched. Any remaining 2D Polygons}

{and 3D Loci will be selected at the end of}

{the procedure.}

Var PolyHandle, LocusHandle: Handle;

PolyCount,PolyIndex:Integer;

PolyCriteria:String;

PolyArray:DynArray of Handle;

Procedure LocusHandler(LH_Locus, LH_Poly:Handle);

{This procedure takes the locus handle and}

{uses the Z+Height of the locus as the height}

{to extrude a copy ofthe polygon pointed to by}

{PolyHandle. The original polygon and the locus}

{point are then deleted.}

Var X1,Y1,LocusZ:Real; {X1,Y1 are dummy variables, we only need the LocusZ}

NewExtrude:Handle; {Dummy Variable for Duplicate}

Begin

GetLocus3D(LH_Locus,X1,Y1,LocusZ); {Get Height to extrude to}

BeginXtrd(0,LocusZ); {Start the extrude}

NewExtrude:=CreateDuplicateObject(LH_Poly,Nil); {Need a new object to extude}

EndXtrd; {End the extude}

DelObject(LH_Poly); {Delete the original polygon}

DelObject(LH_Locus); {Delete the locus point}

End;

Procedure PolyHandler(PH_Poly:Handle); {PH_Poly is a handle to the polygon}

{This procedure gets the name of the polygon}

{changes it to one we can use. It then counts}

{the number of 3D Loci in the area of the}

{Polygon. If there is exactly 1 Loci, it passes}

{the Loci's handle to the LocusHandler procedure.}

Var S1,S2,S3,S4:String; {Strings to hold the criteria and polygon name}

Begin

S1:=GetName(PH_Poly); {Store the existing name}

S2:='COV_123-456-789'; {Set the temp name}

S3:=concat('Loc=',S2); {Set up the criteria for the poly area}

S4:=concat('(T=LOCUS3D) & (Loc=',CHR(39),S2,CHR(39),')');

SetName(PH_Poly,S2); {Set the poly name to the temp name}

If Count(S4)=1 then {If only one poly then}

Begin

DSelectAll; {DSelectAll}

SelectObj(S4); {Select the one locus point}

LocusHandler(FSActLayer,PH_Poly); {Call the LocusHandler procedure with the handle to the locus point}

End;

SetName(PH_Poly,S1); {Restore the original poly name}

End;

Begin {Main Procedure}

PolyIndex:=1;

PolyCriteria:='(T=POLY)';

PolyCount:=Count(PolyCriteria);

PolyHandle:=FInLayer(ActLayer);

Allocate PolyArray[1..PolyCount];

{Make list of polys before we begin}

While PolyHandle<> Nil do

If GetType(PolyHandle)=5 then

Begin

PolyArray[PolyIndex]:=PolyHandle;

PolyIndex:=PolyIndex+1;

PolyHandle:=NextObj(PolyHandle);

End

Else PolyHandle:=NextObj(PolyHandle);

{Use List of Polys to handle Areas}

PolyIndex :=1;

While PolyIndex <= PolyCount do

Begin

PolyHandler(PolyArray[PolyIndex]); {call PolyHandler Procedure}

PolyIndex := PolyIndex + 1;

end;

DSelectAll;

SelectObj((T=POLY));

SelectObj((T=LOCUS3D));

ResetOrientation3D;

End; {Main Procedure}

Run(ExtrudePolygonTo3DLoci);

=================