Jump to content
Pat Stanford

Replace Circle with Loci

Recommended Posts

Someone on the Vectorworks mail list asked for a way to replace 11,000 circles with loci at the centers of the circles. This script replaces every circle in a drawing with a locus point. If you only want to do some edit the criteria in the ForEachObject line and use Layer, Class, Lineweight, Color, etc. to limit the objects that will be acted on.

Use at your own risk.

Procedure Test;

{Replaces every circle in a drawing with a 2D loci at}
{the center of the circle. Use with care after backing up}
{the original drawing. Use at your own risk. Here there}
{be dragons. No warranty expressed or implied.   ;-)  }

{July 15, 2011}
{? 2011, Coviana, Inc - Pat Stanford pat@coviana.com}
{Licensed under the GNU Lesser General Public License}



Var		Hand1, Hand2	:Handle;
	Int1, Int2		:Integer;



Procedure DoAction(Hand3:Handle);
Var X1, Y1 : Real;

Begin
	Get2DPt(Hand3, 1, X1, Y1);
	Locus (X1,Y1);
	DelObject(Hand3);
End;

Begin
ForEachObject(DoAction,((ST=CIRCLE)));
End;

Run(Test);

Share this post


Link to post

Someone finally posted a request for the inverse of this this, a script to replace a loci with a circle, so here it is.

Procedure LociToCircle;

{Replaces every Loci in a drawing with a Circle}
{centered at the insertion point of the loci. Use with care after backing up}
{the original drawing. Use at your own risk. Here there}
{be dragons. No warranty expressed or implied.   ;-)  }

{Adjust the Const Radius = 1' to a unit an size appropriate to the requirement}
{All Circles created will use the default class, color, etc of the document.}

{January 28, 2015}
{July 15, 2011}
{© 2011-2015, Coviana, Inc - Pat Stanford pat@coviana.com}
{Licensed under the GNU Lesser General Public License}


Const	Radius = 1';

Var		Hand1, Hand2	:Handle;
	Int1, Int2		:Integer;



Procedure DoAction(Hand3:Handle);
Var X1, Y1 : Real;

Begin
	Get2DPt(Hand3, 1, X1, Y1);
	ArcByCenter(X1,Y1, Radius,0,360);
	DelObject(Hand3);
End;

Begin
ForEachObject(DoAction,((T=LOCUS)));
End;

Run(LociToCircle);

Edited by Pat Stanford

Share this post


Link to post

Hi Lyle,

   There is now. This script gives you an option to draw the circles on the Ground Plane, or elevate them to the height of the 3D Locus by changing the value of constant "Circles3D". See comments in script. I also added a dialog to let you specify the circle's diameter before the script runs.
 

Procedure Loci3DToCircle;

{ Replaces every Loci in a drawing with a Circle }
{ centered at the insertion point of the loci. Use with care after backing up }
{ the original drawing. Use at your own risk. Here there }
{ be dragons. No warranty expressed or implied.   ;-)  }

{ Adjust the Const Radius = 1' to a unit an size appropriate to the requirement }
{ All Circles created will use the default class, color, etc of the document. }

{ January 28, 2015}
{ July 15, 2011}
{ © 2011-2015, Coviana, Inc - Pat Stanford pat@coviana.com}
{ Licensed under the GNU Lesser General Public License}

{ 08 Aug 2020 - Raymond J Mullin }
{ This is a modification of Pat Stanford's script to convert 2D Loci to circles. }
{ This script will convert 3D Loci to Circles on the Ground Plane if constant Circles3D is FALSE, }
{ or it will elevate the circles to the Z height of the 3D Loci if constant Circles3D is TRUE. }
{ This script will also use a dialog for the user to set the Circle's Diameter. }

Const	
	Radius = 6";
	Circles3D = TRUE;	{ Circles on Ground Plane if FALSE. Floating circles if TRUE. }
Var
	Diam :Real;


	Procedure DoAction(H :Handle);
	Var
		X, Y, Z : Real;
	Begin
		GetLocus3D(H, X, Y, Z);
		ArcByCenter(X, Y, Diam/2, 0, 360);	
		SetObjectVariableBoolean(LNewObj, 1160, FALSE);	{ circle on Gnd Plane }
		if Circles3D then Move3DObj(LNewObj, 0, 0, Z);	{ elevate circle }
		DelObject(H);					{ delete 3D Locus }
	End;		{ DoAction }


BEGIN
	Diam := RealDialog('What Diameter?', Num2StrF(Radius*2));
	if not DidCancel then
		ForEachObject(DoAction, T=LOCUS3D);
END;
Run(Loci3DToCircle);

 

Have fun,

Raymond

 

  • Like 2

Share this post


Link to post

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


 

7150 Riverwood Drive, Columbia, Maryland 21046, USA   |   Contact Us:   410-290-5114

 

© 2018 Vectorworks, Inc. All Rights Reserved. Vectorworks, Inc. is part of the Nemetschek Group.

×
×
  • Create New...