Consulting

Page 1 of 3 1 2 3 LastLast
Results 1 to 20 of 53

Thread: Solved: VBA and AutoCAD reading points from a txt file?

  1. #1

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

    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
    My {Tube Amp} Building Forum
    http://www.dreamtone.org/Forum/

  2. #2
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    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.

  3. #3
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    Quote Originally Posted by Zrob
    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'~

  4. #4
    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
    My {Tube Amp} Building Forum
    http://www.dreamtone.org/Forum/

  5. #5
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    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'~

  6. #6
    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.
    Last edited by Zrob; 04-12-2008 at 07:08 AM.
    My {Tube Amp} Building Forum
    http://www.dreamtone.org/Forum/

  7. #7
    Frame Profiles txt explanation, I can adjust this output.
    Last edited by Zrob; 04-12-2008 at 07:04 AM.
    My {Tube Amp} Building Forum
    http://www.dreamtone.org/Forum/

  8. #8
    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.
    My {Tube Amp} Building Forum
    http://www.dreamtone.org/Forum/

  9. #9
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    Hi Rob,
    I need a time to chew it
    I'll try

    ~'J'~

  10. #10
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    Quote Originally Posted by Zrob
    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'~

  11. #11
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    Hi Fatty I figured you had this one done

    Hi Rob,

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

    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. 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

  12. #12
    VBAX Regular fixo's Avatar
    Joined
    Jul 2006
    Location
    Sankt-Petersburg
    Posts
    99
    Location
    Hi Tom, glad to see you

    This is not a viking boat.
    C'mon, it's much better, I think

    Have a great day, guys

    ~'J'~

  13. #13
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    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
    Last edited by Aussiebear; 04-06-2023 at 09:47 PM. Reason: Adjusted the code tags

  14. #14
    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=Runa...nboard/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
    My {Tube Amp} Building Forum
    http://www.dreamtone.org/Forum/

  15. #15
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    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.

  16. #16
    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!
    My {Tube Amp} Building Forum
    http://www.dreamtone.org/Forum/

  17. #17
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    What does it say? VBA complains a lot, but it usually says something.

  18. #18
    I know,.........it says nothing at all. Does not highlight in yellow or anything.?
    My {Tube Amp} Building Forum
    http://www.dreamtone.org/Forum/

  19. #19
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    Place your curser into the
    ReadFileIntoArray and press F8 and step through it. Lets see what happens from there

  20. #20
    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.
    My {Tube Amp} Building Forum
    http://www.dreamtone.org/Forum/

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •