I need to locate or create a Macro that would read a text file that contains
x postion, y position, and diameter.
Each of the 4000 circles in this file are a different diameter. There is no linear progression.
The following code will read your text file and create the circles. I have it optimized pretty well, on my system it creates 5000 circles in less than half a second.
Sub CreateCircles() Const strFilePathName As String = "D:\Users\Shelby\Documents\Work\CircleData.txt" Const intLineDataBegins As Integer = 10 Dim s As Shape, sr As New ShapeRange Dim intLineCount As Integer Dim strLine As String Dim vArray As Variant On Error GoTo ErrHandler Optimization = True ActiveDocument.BeginCommandGroup "Create Circles" EventsEnabled = False ActiveDocument.SaveSettings ActiveDocument.PreserveSelection = False intLineCount = 1 Open strFilePathName For Input As #1 While Not EOF(1) Line Input #1, strLine vArray = Split(strLine, ",") If intLineCount >= intLineDataBegins Then Set s = ActiveVirtualLayer.CreateEllipse2(vArray(0), vArray(1), vArray(3) / 2) sr.Add s End If intLineCount = intLineCount + 1 Wend Close #1 ActiveDocument.LogCreateShapeRange sr sr.Group ExitSub: ActiveDocument.PreserveSelection = True ActiveDocument.RestoreSettings EventsEnabled = True Optimization = False ActiveWindow.Refresh Application.Refresh ActiveDocument.EndCommandGroup Exit Sub ErrHandler: MsgBox "Error occured: " & Err.Description Resume ExitSub End Sub
Datu Adiatma said:Hi, thanks for sharing this macro code.Would you mind to highlight which part of this code that set the reference point?
I don't think that there is anything in Shelby's code to set the reference point. The circles will be located with respect to the current point in the document where x=0 and y=0.
You can manually change the x=0, y=0 point in the document before running the macro. With the rulers visible, click on the corner where the rulers meet, then drag to the location where you would like 0,0 to be.
I always get error saying: "Error occured: Subscript out of range"
My file is basically simple csv without any header, so edit the above script into this:
Instead of this:
Set s = ActiveVirtualLayer.CreateEllipse2(vArray(0), vArray(1), vArray(3) / 2)
try this:
Set s = ActiveVirtualLayer.CreateEllipse2(vArray(0), vArray(1), vArray(2) / 2)