TurboCAD Forums

The Ultimate Resource for TurboCAD Knowledge

Register
 
The purpose of these forums is to discuss TurboCAD.  Please keep the discussion of other products to compatibility issues or how the other software’s can be used with TurboCAD.


VBScript to replace selected objects with circles of set diameter
Read 5300 times
* November 12, 2009, 01:59:43 AM
Hi

This is a small utility to change selected objects into circles. The diameter if each replacing circle is read from the object's X size it is replacing.

I recently had to do machine toolpaths from a 3rd party's dxf where all the holes to be drilled was polylines (about 60 holes). I wrote this utility to make the task easier for me. The polyline circles was in 16 segments and the cnc router would not have cut round circles for the larger holes.

The script works in the TC macro recorder

Feel free to use, change or comment.



[attachment deleted by admin]
« Last Edit: November 12, 2009, 02:27:34 AM by pvr »

Logged


November 12, 2009, 02:47:52 AM
#1
Hi pvr,

I never used this soft routines.

How can I use this, how must I place this in TC16.1 ?
Must I place it in a subdir of TC ?

Thanks,
Marc

Logged
greetings from belgium (Pajottenland)
WIN 8.1/10 - x64
- TC 9 --> TC 16.2 / 52.0 pro Platinum
- AnimationLab 4.4 - MontageCenter 1.0
- CAM plug-in for v 16


* November 12, 2009, 11:00:58 AM
#2
Hi Marc

Download and unzip the file. You can unzip to any directory. Then under TC's View menu select MacroRecorder Palette. The Macro recorder (MR) will open. Now on the MR toolbar select open file button and go to the directory where you have unzipped this file and open it. Now select the objects on your drawing you want to change to circles and click the run button on the MR toolbar. The objects will be changed to circles. The objects should not be single lines as the diameter is read from the itmes x size. The diameter can be overridden by typing a diameter size, but then all circles will have the same size. This only works under TC Professional version and was made with TC v15 but should work with all versions from version 7.

Hope it helped and good luck.

Cheers

Piet

[attachment deleted by admin]

Logged


November 12, 2009, 01:36:58 PM
#3
Hoy Piet,

Thanks, I will try this.

Marc

Logged
greetings from belgium (Pajottenland)
WIN 8.1/10 - x64
- TC 9 --> TC 16.2 / 52.0 pro Platinum
- AnimationLab 4.4 - MontageCenter 1.0
- CAM plug-in for v 16


* June 03, 2019, 07:44:24 PM
#4
Seems like the script for this was deleted. Anyone have an example, or the original script?

Scott...

Hi

This is a small utility to change selected objects into circles. The diameter if each replacing circle is read from the object's X size it is replacing.

I recently had to do machine toolpaths from a 3rd party's dxf where all the holes to be drilled was polylines (about 60 holes). I wrote this utility to make the task easier for me. The polyline circles was in 16 segments and the cnc router would not have cut round circles for the larger holes.

The script works in the TC macro recorder

Feel free to use, change or comment.



[attachment deleted by admin]

Logged


* June 04, 2019, 12:13:36 AM
#5
Hey Scott,

Hope this helps :)

----------------------------------
' Obj2Circle.tcr
' Replace selected objects with circles of set diameter'
' To be loaded into TurboCAD's MacroRecorder and run from there

option explicit
Dim TCDwg, TCGrs
Dim Dia

Sub CreateCircle(Target)
 Dim NewCircle

 Set NewCircle = TCGrs.AddArcCenterAndPoint(0, 0, 0, Dia/2, 0, 0, 0, 0)
   
   NewCircle.MoveAbsolute Target.ReferencePoint.X, Target.ReferencePoint.Y, Target.ReferencePoint.Z
   NewCircle.Properties("PenColor") = RGB(255, 128, 64)   
End Sub

Sub Main
 Dim TCSel, Target, NewCircle, BBox

 Set TCDwg = ActiveDrawing
 Set TCGrs = TCDwg.Graphics
 Set TCSel = ActiveDrawing.Selection

   If TCSel.Count < 1 then
     MsgBox "Select some items first!"
     Exit Sub
   End If

   For Each Target in TCSel   
      Set BBox= Target.CalcBoundingBox
      Dia = BBox.Max.X - BBox.Min.X
      CreateCircle(Target)
      Target.Delete
      TCDwg.ActiveView.Refresh
   Next

   ActiveDrawing.Selection.Unselect
   TCDwg.ActiveView.Refresh
End Sub

Main

------------------------------

Copy all between the two ----------------- lines and save to a .tcr file



Piet

Logged


June 04, 2019, 05:57:17 AM
#6
Hey Scott,

Hope this helps :)

----------------------------------
' Obj2Circle.tcr
' Replace selected objects with circles of set diameter'
' To be loaded into TurboCAD's MacroRecorder and run from there

Out of curiosity, which version can use this script?  From what I have read, more recent versions cannot use Visual Basic anymore.


Jeff

Logged
TC Pro Platinum 2019, 2018, 2017, 2016 & 2015 (all with LightWorks & RedSDK) & V21
System: i7-5820K @ 3.30GHz, ASRock X99 Extreme4, 16GB DDR4-2133 RAM, Gigabyte GTX 970, Samsung NVMe SSD 950 (256GB), Windows 7 Pro (64-bit) SP1


* June 04, 2019, 08:29:39 AM
#7
Macro recorder is a "leftover" in TC and still work, maybe they have work on it resently, i think to remember a post from Shaheryar about this.
The script above here work i v 2018 at least, i dont have 2019 open at the moment, but guess it will work there aswell

Torfinn

Logged
V18, V19, V20, V21, 2015/ 16/ 17/ 18 Pro. Platinum
Deluxe V20, V21, 2015/ 16/ 17
RedSDK enabled
Windows 10 Home Premium 64 bit, 32 GB
NVIDIA Geforce GTX 780m, 1 GB


* August 08, 2019, 05:27:55 AM
#8
Thanks so much for the file. After you sent it I've used it thousands of times!

Couple questions:

1) The macro sets the color of the circle thats created. Any idea how to set the color to "By Layer"?

2) Do you know how to access the "Play Script" button with a hot key mapping?

Thanks for your help!
Scott...


Hey Scott,

Hope this helps :)

----------------------------------
' Obj2Circle.tcr
' Replace selected objects with circles of set diameter'
' To be loaded into TurboCAD's MacroRecorder and run from there

option explicit
Dim TCDwg, TCGrs
Dim Dia

Sub CreateCircle(Target)
 Dim NewCircle

 Set NewCircle = TCGrs.AddArcCenterAndPoint(0, 0, 0, Dia/2, 0, 0, 0, 0)
   
   NewCircle.MoveAbsolute Target.ReferencePoint.X, Target.ReferencePoint.Y, Target.ReferencePoint.Z
   NewCircle.Properties("PenColor") = RGB(255, 128, 64)   
End Sub

Sub Main
 Dim TCSel, Target, NewCircle, BBox

 Set TCDwg = ActiveDrawing
 Set TCGrs = TCDwg.Graphics
 Set TCSel = ActiveDrawing.Selection

   If TCSel.Count < 1 then
     MsgBox "Select some items first!"
     Exit Sub
   End If

   For Each Target in TCSel   
      Set BBox= Target.CalcBoundingBox
      Dia = BBox.Max.X - BBox.Min.X
      CreateCircle(Target)
      Target.Delete
      TCDwg.ActiveView.Refresh
   Next

   ActiveDrawing.Selection.Unselect
   TCDwg.ActiveView.Refresh
End Sub

Main

------------------------------

Copy all between the two ----------------- lines and save to a .tcr file



Piet

Logged


* August 09, 2019, 03:37:35 PM
#9
re: …1) The macro sets the color of the circle that's created. Any idea how to set the color to "By Layer"?

Use -3 (minus three) for "By Layer".

Original:
NewCircle.Properties("PenColor") = RGB(255, 128, 64)   
New:

NewCircle.Properties("PenColor") = -3

-3 = By Layer
-4 = By Block
(edited for incorrect number for Block)
« Last Edit: August 10, 2019, 07:50:42 PM by John R »

Logged
John R.

V17—V21, 2015—2019
Designer, Deluxe, (Professional, Expert, Basic), Platinum
RedSDK enabled
Windows 10 Pro (1803), 64-bit


* August 10, 2019, 03:08:24 PM
#10
Hey John where or how did you get those references from, -3 and -5 ?

Logged
Daz
TCW V21, 2015-2019 PP, Animation Lab V5.2 & Redsdk enabled, LightWorks rendering mostly.


* August 10, 2019, 08:48:39 PM
#11
Hey John where or how did you get those references from, -3 and -5 ?

I botched that up. I checked an olde list and this is what I had: 0=Black, -3=By Layer, -4=By Block, -5=By Pen
"-5" is normally used in the "Brush Color" Property, so that a hatch will be the same color as its parent.

Draw 3 lines. In the Line Color section of the Property toolbar, set one to By Layer, another to By Block and the third to White (TurboCAD True Color).
Select the "By Layer" line and click on the "Copy" icon in the Selection Info palette.
This will open a webpage in your browser showing all the properties of the Line.
The "Line Color" entry will show a Value of -3.

If you do the same with the other two lines, you'll get a Value of -4 and 16777215 (the Decimal number for white).
You can use Excel to generate a Decimal number. On line 68 in Excel I have the RGB numbers (255,255,255) listed in separate columns (F,G,H).
In column "I" I have: =SUM(F68+256*G68+65536*H68)
This generates a number of 16777215.
TurboCAD used to use Decimal numbers long ago before they switched to RGB.

I was trying to figure this out about 15-20 years ago. Here's a TurboCAD Colors list in HTML format that shows the different color formats.

Logged
John R.

V17—V21, 2015—2019
Designer, Deluxe, (Professional, Expert, Basic), Platinum
RedSDK enabled
Windows 10 Pro (1803), 64-bit


* August 11, 2019, 04:02:32 AM
#12
Thanks John. I always use the macro palette to get the code - this will save a lot of time!

Logged
Nikki
TC20 platinum
TC 2015 platinum
TC 2017 with lightworks


* August 11, 2019, 09:57:26 AM
#13
Here's a picture from Excel of how I set this up.

Logged
John R.

V17—V21, 2015—2019
Designer, Deluxe, (Professional, Expert, Basic), Platinum
RedSDK enabled
Windows 10 Pro (1803), 64-bit


* August 12, 2019, 04:46:28 PM
#14
Thanks John, -3 worked perfectly!

Scott...


Hey John where or how did you get those references from, -3 and -5 ?

I botched that up. I checked an olde list and this is what I had: 0=Black, -3=By Layer, -4=By Block, -5=By Pen
"-5" is normally used in the "Brush Color" Property, so that a hatch will be the same color as its parent.

Draw 3 lines. In the Line Color section of the Property toolbar, set one to By Layer, another to By Block and the third to White (TurboCAD True Color).
Select the "By Layer" line and click on the "Copy" icon in the Selection Info palette.
This will open a webpage in your browser showing all the properties of the Line.
The "Line Color" entry will show a Value of -3.

If you do the same with the other two lines, you'll get a Value of -4 and 16777215 (the Decimal number for white).
You can use Excel to generate a Decimal number. On line 68 in Excel I have the RGB numbers (255,255,255) listed in separate columns (F,G,H).
In column "I" I have: =SUM(F68+256*G68+65536*H68)
This generates a number of 16777215.
TurboCAD used to use Decimal numbers long ago before they switched to RGB.

I was trying to figure this out about 15-20 years ago. Here's a TurboCAD Colors list in HTML format that shows the different color formats.

Logged


* August 12, 2019, 07:33:11 PM
#15
Thanks John, -3 worked perfectly!

Scott...

You're welcome.

Logged
John R.

V17—V21, 2015—2019
Designer, Deluxe, (Professional, Expert, Basic), Platinum
RedSDK enabled
Windows 10 Pro (1803), 64-bit