Consulting

Results 1 to 9 of 9

Thread: Solved: Avoiding the need to rebuild points for ACAD.

  1. #1
    VBAX Newbie
    Joined
    Feb 2005
    Posts
    5
    Location

    Solved: HELP! Avoiding the need to rebuild points for ACAD.

    I am more fimilar w/AutoLISP than I am w/VBA in the ACAD environment. So, needless to say AutoLISP usually runs thru my head when I am trying to solve issues in VBA. I want to use the "AddLeader" method to automate adding a leader to my drawing. In my code I prompt the user for (3) three points for the leader using the "GetPoint" method. Then during the draw portion of my code I use the "AddLeader" method to draw the leader. The "AddLeader" needs an array of points which I have pt1, pt2 and pt3. I am seeing so far that it needs me to reconstruct these points from their individual arrays to a larger array that include their collective data. I am finding the only examples and way to do this is to transfer each individual portion of the array to a new slot on the new array called "points". I want to know if I can automate this w/a loop or group the original points in another fashion. All this retyping seems unnecessary????

    This is my code:[VBA]
    'Aquire info for weld symbols
    Private Sub wsuser()
    Dim varRet As Variant
    varRet = ThisDrawing.Utility.GetPoint(, "Leader start point: ")
    pt1(0) = varRet(0)
    pt1(1) = varRet(1)
    pt1(2) = varRet(2)
    varRet = ThisDrawing.Utility.GetPoint(pt1, "Leader second point: ")
    pt2(0) = varRet(0)
    pt2(1) = varRet(1)
    pt2(2) = varRet(2)
    varRet = ThisDrawing.Utility.GetPoint(pt2, "Leader last point: ")
    pt3(0) = varRet(0)
    pt3(1) = varRet(1)
    pt3(2) = varRet(2)
    'MsgBox varRet(0) & ", " & varRet(1) & ", " & varRet(2)
    Dim NoNull As Integer
    NoNull = 1 ' Disallow null
    ThisDrawing.Utility.InitializeUserInput NoNull, "Fillet Groove Plug"
    ThisDrawing.Utility.Prompt "Specify Weld Name "
    wldName = ThisDrawing.Utility.GetKeyword("[Fillet/Groove/Plug]: ")
    ThisDrawing.Utility.InitializeUserInput NoNull, "Field All None Reference Back"
    ThisDrawing.Utility.Prompt "Specify Weld Type "
    wldType = ThisDrawing.Utility.GetKeyword("[Field/All/Reference/Back]: ")
    ThisDrawing.Utility.InitializeUserInput NoNull, "Near Far Both"
    ThisDrawing.Utility.Prompt "Specify Weld Side "
    wldSide = ThisDrawing.Utility.GetKeyword("[Near/Far/Both]: ")
    End Sub
    Sub weldsymbol()
    wsuser
    drwleader
    'MsgBox wldName & " " & wldType & " " & wldSide
    End Sub
    Private Sub drwleader()
    'draws a leader in model space, no annotation
    Dim leaderObj As AcadLeader
    Dim points(0 To 8) As Double
    Dim pt(0 To 2) As Double
    Dim width As Double
    Dim text As String
    Dim leaderType As Integer
    Dim annotationObject As AcadObject

    points(0) = pt1(0): points(1) = pt1(1): points(2) = pt1(2)
    points(3) = pt2(0): points(4) = pt2(1): points(5) = pt2(2)
    points(6) = pt3(0): points(7) = pt3(1): points(8) = pt3(2)

    pt(0) = pt3(0): pt(1) = pt3(1): pt(2) = pt3(2)
    width = 1
    text = "help"
    leaderType = acLineWithArrow
    Set annotationObject = ModelSpace.AddMText(pt, width, wldSide)
    'create the leader object in model space
    Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotationObject, leaderType)
    ZoomAll
    End Sub[/VBA]
    Last edited by dboose; 02-09-2005 at 11:06 AM. Reason: removed excess points array
    DBOOSE

  2. #2
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,940
    Location
    Hi Duane,

    Did you solve this then? Ifso, I can mark this Solved if you'd like.

  3. #3
    VBAX Newbie
    Joined
    Feb 2005
    Posts
    5
    Location
    Hey Zack,

    Thanks for your help. I had two post, one was put into the testing area and is solved. Which is what you responded to earlier. However, this one "HELP! Avoiding the need to rebuild points for ACAD." is not solved yet. Actually yours is the only reply I have received for this post so far.

    Thanks again!
    Duane
    DBOOSE

  4. #4
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    The only way I see to do it without API is send the arrays to a sub/function and let it combine them.
    I also included an alternate way but the points var will need to be global or passed.

    [VBA]
    Private pt1(2) As Double
    Private pt2(2) As Double
    Private pt3(2) As Double
    'Private points(0 To 8) As Double 'an alternate
    Private Sub wsuser()
    Dim varRet() As Double
    varRet = ThisDrawing.Utility.GetPoint(, "Leader start point: ")
    CombineArr varRet, pt1
    'CombineArr varRet, points 'alternate
    ' pt1(0) = varRet(0)
    ' pt1(1) = varRet(1)
    ' pt1(2) = varRet(2)
    varRet = ThisDrawing.Utility.GetPoint(pt1, "Leader second point: ")
    CombineArr varRet, pt2
    'CombineArr varRet, points,3 'alternate
    ' pt2(0) = varRet(0)
    ' pt2(1) = varRet(1)
    ' pt2(2) = varRet(2)
    varRet = ThisDrawing.Utility.GetPoint(pt2, "Leader last point: ")
    CombineArr varRet, pt3
    'CombineArr varRet, points,6 'alternate
    ' pt3(0) = varRet(0)
    ' pt3(1) = varRet(1)
    ' pt3(2) = varRet(2)
    'MsgBox varRet(0) & ", " & varRet(1) & ", " & varRet(2)
    Dim NoNull As Integer
    NoNull = 1 ' Disallow null
    ThisDrawing.Utility.InitializeUserInput NoNull, "Fillet Groove Plug"
    ThisDrawing.Utility.Prompt "Specify Weld Name "
    wldName = ThisDrawing.Utility.GetKeyword("[Fillet/Groove/Plug]: ")
    ThisDrawing.Utility.InitializeUserInput NoNull, "Field All None Reference Back"
    ThisDrawing.Utility.Prompt "Specify Weld Type "
    wldType = ThisDrawing.Utility.GetKeyword("[Field/All/Reference/Back]: ")
    ThisDrawing.Utility.InitializeUserInput NoNull, "Near Far Both"
    ThisDrawing.Utility.Prompt "Specify Weld Side "
    wldSide = ThisDrawing.Utility.GetKeyword("[Near/Far/Both]: ")
    End Sub
    Sub weldsymbol()
    wsuser
    drwleader
    'MsgBox wldName & " " & wldType & " " & wldSide
    End Sub
    Private Sub drwleader()
    'draws a leader in model space, no annotation
    Dim leaderObj As AcadLeader
    Dim points(0 To 8) As Double
    Dim pt(0 To 2) As Double
    Dim width As Double
    Dim text As String
    Dim leaderType As Integer
    Dim annotationObject As AcadObject
    CombineArr pt1, points 'not required for alternate
    CombineArr pt2, points, 3 'not required for alternate
    CombineArr pt3, points, 6 'not required for alternate
    ' points(0) = pt1(0): points(1) = pt1(1): points(2) = pt1(2)
    ' points(3) = pt2(0): points(4) = pt2(1): points(5) = pt2(2)
    ' points(6) = pt3(0): points(7) = pt3(1): points(8) = pt3(2)
    CombineArr pt, pt3
    'pt(0) = pt3(0): pt(1) = pt3(1): pt(2) = pt3(2)
    width = 1
    text = "help"
    leaderType = acLineWithArrow
    Set annotationObject = ModelSpace.AddMText(pt, width, wldSide)
    'create the leader object in model space
    Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotationObject, leaderType)
    ZoomAll
    End Sub
    Private Sub CombineArr(iArr() As Double, ioArr() As Double, Optional iArrStart = 0)
    Dim I As Integer
    For I = LBound(iArr) To UBound(iArr)
    ioArr(iArrStart) = iArr(I)
    iArrStart = iArrStart + 1
    Next
    End Sub
    [/VBA]

  5. #5
    VBAX Newbie
    Joined
    Feb 2005
    Posts
    5
    Location
    Tommy,
    Hi! I am so excited w/the reply you gave me. After reading some of the other items you helped with I was positive you would be able to point me in the direction I was looking for. Thank you so much, exactly what I am looking for. I believe I understand your sub routine but some of it still hangs in the fog a little. If you would be so kind and explain it in laymen terms for me I would really appreciate it. One thing I am certain I don't understand is this:
    CombineArr pt1, points 'not required for alternate
    CombineArr pt2, points, 3 'not required for alternate
    CombineArr pt3, points, 6 'not required for alternate
    I see you are passing info to the new sub you wrote but I don't understand the 3 and 6 or the rem 'not required for alternate.

    Thank you again so much!!!

    Duane
    DBOOSE

  6. #6
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    Hi dboose,
    Private Sub CombineArr(iArr() As Double, ioArr() As Double, Optional iArrStart = 0)
    The subroutine has an optional argument, it is iArrStart it's default value (if not passed) is set to 0. That is what "Optional iArrStart = 0" means.

    The line below will copy the array pt1 to points starting in the 0 position
    CombineArr pt1, points 'not required for alternate
    The line below will copy the array pt2 to points starting in the 3rd position
    CombineArr pt2, points, 3 'not required for alternate
    The line below will copy the array pt3 to points starting in the 6 position
    CombineArr pt3, points, 6 'not required for alternate

    The alternate I was talking about is get rid of pt1, pt2, pt3, and copy varRet straight into the points array as in:
    CombineArr varRet, points 'copy the array varRet to the first 3 positions
    CombineArr varRet, points, 3 'copy the array varRet to the 3rd position to the 5th
    CombineArr varRet, points, 6 'copy the array varRet to the 6th position to the 8th

    Since these arrays are 0 based the numbering seems a little funny.

    I'm kinda curious about the weld symbols you are using, are you going to insert as blocks or are you going to draw from scratch? I was just wondering we have the weld symbols on a menu/lsp pick, but we normally use fillets or at the most a full pen, no field welding, our customers don't like it when we send something to field weld/cut

    If there is anything else I can do let me know

  7. #7
    VBAX Newbie
    Joined
    Feb 2005
    Posts
    5
    Location
    Hey Tommy,

    My initial thought is to drawing everything from scratch. Mostly because I want to run myself through as much code as possible, build up my coding knowledge. Because my knowledge is elementary I am sure I am beginning this way because I don't know better too. I want to build the prompts for weld size, length and spacing between if it's not a full bead. I also want to address other weld types too. Typically here at work we use straight fillets but I am trying to think a little beyond. Once I have the code where I want it, dealing mostly w/everything at the command line and drawing programatically from scratch, I will look to rewrite portions of the code to use a dialog box/user form. After that I will look at more efficient ways to write the code. Most of all I am using this as a training tool. My next project I want to write some code that will batch open acad drawings-saveas another filetype (i.e. lower version level or dxf) and in a different folder.

    Again, thank you for every thing. You have really opened my thinking up and helped me understand VBA a lot better. God bless you and your family!

    Duane
    DBOOSE

  8. #8
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    I like to draw from scratch but that is because I don't have to worry about sending the drawings/blocks. I would suggest that with the input you set some defaults ex. [Fillet/Groove/Plug]F) in other words don't make the have to type something in, use the normal for the defaults and make them input different, also keep the input as default for the next entry. Just a thought or 2

    wldName = ThisDrawing.Utility.GetKeyword("Fillet/Groove/Plug:[F] ")
    If wldName = vbNullString Then wldName = "Fillet"

  9. #9
    VBAX Newbie
    Joined
    Feb 2005
    Posts
    5
    Location
    Great suggestion! I will definitely apply. I may look at using blocks simply for the training in my coding but probably not keep it that way.

    Have a great weekend!!!
    DBOOSE

Posting Permissions

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