Solved: 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]

Hi Duane,

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

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

The only way I see to do it without API is send the arrays to a sub/function and let it combine them. :yes
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]

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

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 :bug:

If there is anything else I can do let me know :yes

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

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"

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