PDA

View Full Version : Solved: VBA and AutoCAD reading points from a txt file?



Zrob
04-10-2008, 06:18 PM
Hi Guys,

Does anyone here have experience plotting points in AutoCAD using VBA from a txt file? If so can you post an example of one.

Thanks for any advice on how I should get started.

Rob

Tommy
04-11-2008, 10:28 AM
Hey Rob,

You can create a point by giving it the x and y, there is another thread that is a script for plotting a surveyer's line. The real questions here is what do YOU mean by plotting? drawing lines from point to point or actually plotting on a plotter? Are you actually using the point or is it figuratively speaking?

See an example for drawing lines from a text file look towards the end
http://vbaexpress.com/forum/showthread.php?t=2647

I can fix you up but I need to know more about what you want to do. :)

fixo
04-11-2008, 03:13 PM
Hi Guys,

Does anyone here have experience plotting points in AutoCAD using VBA from a txt file? If so can you post an example of one.

Thanks for any advice on how I should get started.

Rob

Hope this will get you started
Source file is a comma delimited text file
Change full path of this file (blue colored)



Public Sub DrawPointsFromTextFile()
Dim fd As Long
Dim sline As String
Dim ar As Variant
fd = FreeFile
Open "C:\Temp\Coordinates.txt" For Input Access Read Shared As fd
Do Until EOF(fd)
Line Input #fd, sline
ar = Split(sline, ",")
ReDim pt(UBound(ar)) As Double
Dim i As Integer
For i = 0 To UBound(ar)
pt(i) = CDbl(ar(i))
Next i
ThisDrawing.ModelSpace.AddPoint pt
Loop
Close fd
End Sub


~'J'~

Zrob
04-11-2008, 05:03 PM
Hi Guys!

Tommy, I would like to plot points in model space, by reading the info out of a text file. Basically I have a offset chart for a small boat, so I am converting all the data that they give in Ft-In-1/16 the way boat builders do, and I wrote a C++ program that converts that to a decimal, and I write it to a text file. But now I would lke to read that in with VBA in AutoCAD and need help on that end.

Fatty, thanks for that example!

Rob

fixo
04-12-2008, 12:04 AM
Hi, Rob

Can you upload here a small part of this
text file to see how it looks like?
Guess, there is need to convert imperic
to decimals to draw the points with accuracy

~'J'~

Zrob
04-12-2008, 06:43 AM
Sure, I was going to do that but I had some problems uploading last night, let me try again. I have two pics that explane my 2 txt files, but I think I should only make or tun it into one file, so let me know and I wil tailor that part of it for you if needed.

But basically one file has the frame spacing in the Z direction, the other one file has the data for half the side profile(seen here), then you would just mirror that later on.

Zrob
04-12-2008, 06:49 AM
Frame Profiles txt explanation, I can adjust this output.

Zrob
04-12-2008, 06:57 AM
And the actual txt docs in a zip file with all items. In this post, let me know what you think.


Thanks For any help with this and if you need me to change the config files let me know and I will.

fixo
04-12-2008, 07:34 AM
Hi Rob,
I need a time to chew it :)
I'll try

~'J'~

fixo
04-12-2008, 08:55 AM
And the actual txt docs in a zip file with all items. In this post, let me know what you think.


Thanks For any help with this and if you need me to change the config files let me know and I will.
It's me again :)
I don't understand completely your task, sorry
Here is what I could to write so far
I hope somebody else will help you with second part



Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Function ReadTxtFile(fil As String) As Collection
Dim fd As Long
Dim sline As String
Dim txtColl As New Collection
fd = FreeFile
Open fil For Input Access Read Shared As fd
Do Until EOF(fd)
Line Input #fd, sline
txtColl.Add sline
Loop
Close fd
Set ReadTxtFile = txtColl
End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Sub test()
Dim col As New Collection
Dim itm As Variant
Dim ar() As Variant
Dim i As Integer, j As Integer
Dim iCount As Integer
Set col = ReadTxtFile("C:\Temp\Frame_Profiles.txt") '<-change the full path of the text file
For i = 1 To col.Count Step 2
ReDim Preserve ar(j)
ar(j) = col.Item(i) & col.Item(i + 1)
j = j + 1
Next
iCount = UBound(ar)
Dim match As String
Dim framenum As String
i = 0
Do Until i >= iCount
j = 0
DoNext:
Dim pts() As Double
match = Left(ar(i), InStr(1, ar(i), ",") - 1)
framenum = Left(ar(i), InStr(1, ar(i), ",") - 1)
Do While match = framenum
itm = Split(ar(i), ",")
ReDim Preserve pts(j + 1) As Double
pts(j) = CDbl(itm(1)): pts(j + 1) = CDbl(itm(2))
j = j + 2
i = i + 1
If i >= iCount Then
Exit Do
End If
framenum = Left(ar(i), InStr(1, ar(i), ",") - 1)
If match <> framenum Then
Exit Do
GoTo DoNext
End If
Loop
Dim opline As AcadLWPolyline
Set opline = ThisDrawing.ModelSpace.AddLightWeightPolyline(pts)
Loop
ThisDrawing.Regen acActiveViewport
End Sub


~'J'~

Tommy
04-12-2008, 12:58 PM
Hi Fatty :hi: I figured you had this one done :bow:

Hi Rob,

Without diving in too deep I will make a few assumtions (:bug:)

There are different numbers of knuckels and chimes (your terms maybe? why not x,y,z?) for each frame. The data supplied is a sample not the real data. Also there will be a "spacing" for each frame along with the multiple base dimensions. This is not a viking boat.:rofl: You acually want to draw a 3d model of the ship.

Would you want the frame to be draw with a polyline?

I have some code that already does the decimal conversion from the format you posted, FYI.

As Fatty said

I need a time to chew it :)

fixo
04-12-2008, 01:10 PM
Hi Tom, glad to see you :hi:


This is not a viking boat.:rofl:

C'mon, it's much better, I think :)

Have a great day, guys

~'J'~

Tommy
04-12-2008, 02:01 PM
As long as the frames are in order and the frames have identical ids this should work. but just to make sure

My spacings file
------
12,
172
13,
196
------

my profiles
------
12,
0, 11.375
12,
66.9375, 95.4375
12,
139.938, 138.375
12,
325.875, 214.688
12,
324, 214
13,
0, 23.0625
13,
61.5625, 104.938
13,
133.438, 148.938
13,
323.563, 222.188
13,
324, 222.188

------



'iFileName needs to contain the full path to the file with the extension
Function OpenFile(iFileName As String) As Long
Dim mFrFle As Long
'Close
mFrFle = FreeFile
On Error GoTo OPPS
Open iFileName For Input As #mFrFle
OpenFile = mFrFle
On Error GoTo 0
Exit Function
OPPS:
MsgBox Err.Description
Close mFrFle 'close the file you just tried to open and release the id
Err.Clear
End Function
Sub ReadFileIntoArray()
Dim ZId As Long, XYID As Long, mFrmNo As Long, mFrameLoc As Double
Dim mXYFrmID As Long, mY As Double, mX As Double, mXYID As Long
Dim FramArray() As Double, mStr As Long, mNextRec As Boolean, dum As String
Dim mPoly As Acad3DPolyline
ReDim FramArray(0)
'Z cords
ZId = OpenFile("C:\Projects\txt files and pics\Frame_Spacings.txt")
'x and y
XYID = OpenFile("C:\Projects\txt files and pics\Frame_Profiles.txt")
mNextRec = True
While Not EOF(ZId)
Input #ZId, mFrmNo
Input #ZId, dum, mFrameLoc
If mNextRec Then Input #XYID, mXYID, dum
While mXYID = mFrmNo
If Not EOF(XYID) Then
Input #XYID, mY, mX
mStr = UBound(FramArray, 1)
If mStr = 0 Then
ReDim Preserve FramArray(mStr + 2)
FramArray(mStr) = mX
FramArray(mStr + 1) = mY
FramArray(mStr + 2) = mFrameLoc
Else
ReDim Preserve FramArray(mStr + 3)
FramArray(mStr + 1) = mX
FramArray(mStr + 2) = mY
FramArray(mStr + 3) = mFrameLoc
End If
If Not EOF(XYID) Then Input #XYID, mXYID, dum
mNextRec = False
Else
mXYID = 500000
End If
Wend
If mStr > 0 Then Set mPoly = ThisDrawing.ModelSpace.Add3DPoly(FramArray)
ReDim FramArray(0)
ZoomAll
Wend
End Sub


Fatty I also think it is much better than a viking boat :)

Zrob
04-12-2008, 06:38 PM
Hi Guys!

Will I be able to run this code in AutoCAD 2000?

Fatty, here is another example pic of what I am trying to do. This is a quick mock up of a 1960's ski boat "runabout" by Rivira. http://www.svensons.com/boat/?p=RunaboutsInboard/riviera

But really I am working on a steel tug boat project 150' long, drafting is my trade BUT I have been trying to pick up programing, I finished a basic C++ class, but its lack of windows functionality left me a little disapointed. So my next class will be VB very soon!!

Thanks for all your help, I don't have it running yet but I am working with it still!!

Rob

Tommy
04-13-2008, 07:16 AM
I developed it in 2000 so I hope it will run :)
Let us know what trouble you have and we can tweek it from there.

Zrob
04-13-2008, 08:05 AM
Tommy,

Its not runing and I have a funny feeling its on my end..
I am thinking I need to set a ckeck box in the visual basic editor, its the item that sets windows operating variables."API stuff".....since I have a new lap top now with windows XP home addition.......do you know what I mean, but I can't find this darn menu to do it its somewhere in my visual basic editor.

Also, as I try and run this I have AutoCAD open, with a blank drawing ready to go set to decimal units.......RIGHT?

Here is a pic does it look right to you so far, bare with me its been a while since I played arround with VBA.

Thanks!

Tommy
04-13-2008, 08:11 AM
What does it say? VBA complains a lot, but it usually says something. :)

Zrob
04-13-2008, 08:28 AM
I know,.........it says nothing at all. Does not highlight in yellow or anything.?

Tommy
04-13-2008, 08:32 AM
Place your curser into the
ReadFileIntoArray and press F8 and step through it. Lets see what happens from there

Zrob
04-13-2008, 08:33 AM
Ok, somthing is working, but it was unnoticable but if I zoom the drawing way out and run it it does the zoomall and that does work, but no lines or points show up.

Tommy
04-13-2008, 08:36 AM
Can you post the files you are using?

Zrob
04-13-2008, 08:41 AM
Ok I did the debug, see attachment, but its skipping over all the if statments for some reason.?

Tommy
04-13-2008, 08:45 AM
That means the frames are not equal. The frames HAVE to start with the same number in both files.

Zrob
04-13-2008, 08:48 AM
Oh shoot, ok let me fix......

Thanks

Zrob
04-13-2008, 09:26 AM
Tommy thats awesome! Nice job!!

Now I have a nice platform to work with, I will have to see if I have any doe in my paypal account,...just checked it but it only had like $3.00 left so I am going to transfer some doe in and make a donation to this web site within the next week or as soon as possible! You guys are the BEST!

Rob

PS Thanks to Fatty also.....always willing to help out as well!!

Tommy
04-13-2008, 09:32 AM
Glad we could Help :)
Don't forget to mark it solved :)

Zrob
04-13-2008, 09:46 AM
I will, but will that lock this tread?

I am try too modify polylines to just a typical line:


'Dim mPoly As Acad3DPolyline
Dim mPoly As AcadLine


But this is giving me trouble:


If mStr > 0 Then Set mPoly = ThisDrawing.ModelSpace.Add3DPoly(FramArray)
'If mStr > 0 Then Set mPoly = ThisDrawing.ModelSpace.Add3DPoly(FramArray)

Tommy
04-13-2008, 10:32 AM
A quick and dirty:

If mStr > 0 Then
Set mPoly = ThisDrawing.ModelSpace.Add3DPoly(FramArray)
mPoly.Explode
End If

Otherwise you would need to rewrite the sub a lot.

Zrob
04-13-2008, 10:38 AM
Right, actually a 3Dpolyline is fine. I got off track and was thinking it was a spline my bad.

Tommy
04-13-2008, 10:42 AM
Would you like to draw the whole frame instead of half the frame?

Zrob
04-13-2008, 10:54 AM
Sure, since its code. Oh I think there are double lines going in not sure but zoom in at the ends and explode and erase then you will see what I mean.

Its cool though...

Tommy
04-13-2008, 11:02 AM
Double line = double input :)

Zrob
04-13-2008, 11:13 AM
Double line = double input :)

Yup......my text file again....

:bug:

Tommy
04-13-2008, 11:41 AM
Whew glad it wasn't me. LOL I was thinking while I mowed the yard "I sure hope I don't have a sna-phoo" :)

Tommy
04-13-2008, 11:58 AM
This should give you the full frame. :)

'iFileName needs to contain the full path to the file with the extension
Function OpenFile(iFileName As String) As Long
Dim mFrFle As Long
'Close
mFrFle = FreeFile
On Error GoTo OPPS
Open iFileName For Input As #mFrFle
OpenFile = mFrFle
On Error GoTo 0
Exit Function
OPPS:
MsgBox Err.Description
Close mFrFle 'close the file you just tried to open and release the id
Err.Clear
End Function
Sub ReadFileIntoArray()
Dim ZId As Long, XYID As Long, mFrmNo As Long, mFrameLoc As Double
Dim mXYFrmID As Long, mY As Double, mX As Double, mXYID As Long
Dim FramArray() As Double, mStr As Long, mNextRec As Boolean, dum As String
Dim mPoly As Acad3DPolyline
ReDim FramArray(0)
'Z cords
ZId = OpenFile("C:\Projects\txt files and pics\Frame_Spacings.txt")
'x and y
XYID = OpenFile("C:\Projects\txt files and pics\Frame_Profiles.txt")
mNextRec = True
While Not EOF(ZId)
Input #ZId, mFrmNo
Input #ZId, dum, mFrameLoc
If mNextRec Then Input #XYID, mXYID, dum
While mXYID = mFrmNo
If Not EOF(XYID) Then
Input #XYID, mY, mX
mStr = UBound(FramArray, 1)
If mStr = 0 Then
ReDim Preserve FramArray(mStr + 5)
FramArray(mStr) = mX
FramArray(mStr + 1) = mY
FramArray(mStr + 2) = mFrameLoc
FramArray(mStr + 3) = -mX
FramArray(mStr + 4) = mY
FramArray(mStr + 5) = mFrameLoc
Else
ReDim Preserve FramArray(mStr + 6)
FramArray(mStr + 1) = mX
FramArray(mStr + 2) = mY
FramArray(mStr + 3) = mFrameLoc
FramArray(mStr + 4) = -mX
FramArray(mStr + 5) = mY
FramArray(mStr + 6) = mFrameLoc
End If
If Not EOF(XYID) Then Input #XYID, mXYID, dum
mNextRec = False
Else
mXYID = 500000
End If
Wend
If mStr > 0 Then
SortaPoint FramArray
Set mPoly = ThisDrawing.ModelSpace.Add3DPoly(FramArray)
End If
ReDim FramArray(0)
ZoomAll
Wend
End Sub
'standard bubble sort for the points on the x plane
Public Sub SortaPoint(MyPoints() As Double)
Dim mTmp As Double
Dim J As Integer
Dim K As Integer
Dim L As Integer
J = UBound(MyPoints) '<- find the max number of points
For K = 0 To J - 3 Step 3
For L = K + 3 To J Step 3
If MyPoints(K) > MyPoints(L) Then
mTmp = MyPoints(K)
MyPoints(K) = MyPoints(L)
MyPoints(L) = mTmp
mTmp = MyPoints(K + 1)
MyPoints(K + 1) = MyPoints(L + 1)
MyPoints(L + 1) = mTmp
mTmp = MyPoints(K + 2)
MyPoints(K + 2) = MyPoints(L + 2)
MyPoints(L + 2) = mTmp
End If
Next
Next
End Sub

Zrob
04-13-2008, 12:50 PM
I have some code that already does the decimal conversion from the format you posted, FYI.

As Fatty said

Tommy, would this code by any chance read it out of a pdf file?

Its brutal typing in all this data, thats what I am doing now....:(

Tommy
04-13-2008, 12:54 PM
Ummm Adobe reader 8 has the option to save as text. Otherwise e-mail it to me and I'll see what I can do.

Zrob
04-13-2008, 01:31 PM
Even if the data chart in the pdf file is a jpg, will it still convert that to a txt file? Because thats what I have.

Tommy
04-13-2008, 01:38 PM
No not that I am aware of.

Go ahead and send it to me and let me see what I can do. I have a lot of tricks up me sleeve. :)

Zrob
04-13-2008, 02:22 PM
Sent

Zrob
04-13-2008, 08:35 PM
Tommy,

Here is the latest problem/BUG, working with the new code but this BUG happens with the old code as well, maybe its me/my config files, I am not sure. I have both txt files up to frame 25, but I only get approx 16 or 18 frames, and a debug error; see pic. What do you think is the problem?

Zrob
04-14-2008, 05:22 PM
Ok I found it, a double entry in my config file......lets see if I can get past 25 frames now......

Tommy
04-14-2008, 05:49 PM
What no text files? LOL I have up to 18 frames and it look really good.

Tommy
04-14-2008, 05:58 PM
btw before I forget; the safe array complaint from acad means that the program has reached the end of the information.

Zrob
04-14-2008, 06:12 PM
Well I call my txt files config......

Tommy, I was thinking to bad we could not tag each frame to a matching layer....that would be slick!

Tommy
04-15-2008, 10:03 AM
Sub AddLayer(iFrameNo As Long)
Dim mLayer As AcadLayer
'copied straight from the help files
Set mLayer = ThisDrawing.Layers.Add(CStr(iFrameNo))
mLayer.Linetype = "CONTINUOUS"
mLayer.Color = iFrameNo
ThisDrawing.ActiveLayer = mLayer
'now draw
End Sub
Sub ReadFileIntoArray()
.......
If mStr > 0 Then
SortaPoint FramArray
AddLayer mFrmNo
Set mPoly = ThisDrawing.ModelSpace.Add3DPoly(FramArray)
End If
........
End Sub



:)

Zrob
04-15-2008, 10:19 AM
Tommy, I added Foc'sle Deck data, though a small problem with the line directions at the top, not sure what you think, but I will try and run that data by itself, then see what it does.

Thanks!

Zrob
04-15-2008, 10:31 AM
Ok, so I went to the last saved data files without the Foc'sle dat and ran that, then I ran just the Foc'sle data and here is what I got. I am sure you can figure this one out.......I need to think about it for now. But I think I can work arround it. I think I will run one more combination hang on.....

Zrob
04-15-2008, 10:39 AM
Ok I ran the data once wth the Foc'sle data inbeded then once with just the Foc'sle data. Not sure.......but this kida seem like the right profile. Though I will have to check the CAD file better.

What do you make of it?

Zrob
04-15-2008, 06:54 PM
This is up to frame 59 with the new layer code. NICE!

Zrob
04-17-2008, 07:20 PM
This is the first step, finished. Next will be to clean things up, and put some surfaces on and I may do that in another cad package.

shamsam1
05-01-2008, 12:56 AM
can i like to export autocad (dwg) date to excel.. like dimesions,drawing no..etc..do help me soooon

noyjoreb
03-29-2010, 11:39 AM
hi tommy,
why this code not work when i try to run in autocad?
it says run time erro 99
subscript out of range

ive change the path of a txt file.."D:\coordinates.txt"

what will i do? i need this macro that autocad will import txt file coordinates and plot a line in autocad.. anybody can answer this please... thanks in advance

Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Function ReadTxtFile(fil As String) As Collection
Dim fd As Long
Dim sline As String
Dim txtColl As New Collection
fd = FreeFile
Open fil For Input Access Read Shared As fd
Do Until EOF(fd)
Line Input #fd, sline
txtColl.Add sline
Loop
Close fd
Set ReadTxtFile = txtColl
End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Sub test()
Dim col As New Collection
Dim itm As Variant
Dim ar() As Variant
Dim i As Integer, j As Integer
Dim iCount As Integer
Set col = ReadTxtFile("C:\Temp\Frame_Profiles.txt") '<-change the full path of the text file
For i = 1 To col.Count Step 2
ReDim Preserve ar(j)
ar(j) = col.Item(i) & col.Item(i + 1)
j = j + 1
Next
iCount = UBound(ar)
Dim match As String
Dim framenum As String
i = 0
Do Until i >= iCount
j = 0
DoNext:
Dim pts() As Double
match = Left(ar(i), InStr(1, ar(i), ",") - 1)
framenum = Left(ar(i), InStr(1, ar(i), ",") - 1)
Do While match = framenum
itm = Split(ar(i), ",")
ReDim Preserve pts(j + 1) As Double
pts(j) = CDbl(itm(1)): pts(j + 1) = CDbl(itm(2))
j = j + 2
i = i + 1
If i >= iCount Then
Exit Do
End If
framenum = Left(ar(i), InStr(1, ar(i), ",") - 1)
If match <> framenum Then
Exit Do
GoTo DoNext
End If
Loop
Dim opline As AcadLWPolyline
Set opline = ThisDrawing.ModelSpace.AddLightWeightPolyline(pts)
Loop
ThisDrawing.Regen acActiveViewport
End Sub