Draw multiple lines?

Draw multiple lines?

Anonymous
Not applicable
2,570 Views
5 Replies
Message 1 of 6

Draw multiple lines?

Anonymous
Not applicable

Hello everyone. As you may know I am fresh to VBA (elementary research), my question is: How can I draw multiple lines and text by pre-determined coordinates? I've been able to generate a single line, but once I add a second set of coordinates for line #2, the VBA bugs out and I have to start from scratch again (It stops recognizing "Private Sub CreateLine()" after a second set is added). Please assist. Thank you!!

 

Extra note: I am actively researching this solution, and am aiming for a self-contained code, no Excel references.

0 Likes
Accepted solutions (1)
2,571 Views
5 Replies
Replies (5)
Message 2 of 6

Ed__Jobe
Mentor
Mentor

Post your code so that we can help you.

Ed


Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.

EESignature

0 Likes
Message 3 of 6

Anonymous
Not applicable

Ok, this is a long post, but it is everything I have so far.

 

First code to draw a rectangle (works fine):

 

Private Sub Tester_Click()
    pi = 3.14159265358979
    ptLenI = 39
    ptWidI = 27
    
    TitleBlock.Hide
    
    pt1 = ThisDrawing.Utility.GetPoint(, "Pick lower left edge:")
    'ptR = ThisDrawing.Utility.GetPoint(, "Pick right edge:")
    pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, ptLenI)
    pt3 = ThisDrawing.Utility.PolarPoint(pt2, pi / 2, ptWidI)
    pt4 = ThisDrawing.Utility.PolPrivate Sub Tester_Click()
    pi = 3.14159265358979
    ptLenI = 39
    ptWidI = 27
    
    TitleBlock.Hide
    
    pt1 = ThisDrawing.Utility.GetPoint(, "Pick lower left edge:")
    'ptR = ThisDrawing.Utility.GetPoint(, "Pick right edge:")
    pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, ptLenI)
    pt3 = ThisDrawing.Utility.PolarPoint(pt2, pi / 2, ptWidI)
    pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, ptWidI)
    'pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, ptWidI)
    
    ThisDrawing.ModelSpace.AddLine pt1, pt2
    ThisDrawing.ModelSpace.AddLine pt2, pt3
    ThisDrawing.ModelSpace.AddLine pt3, pt4
    ThisDrawing.ModelSpace.AddLine pt4, pt1
    
    '*** OUTER BORDER ********************************************
    
    TitleBlock.show
    
End Sub
arPoint(pt1, pi / 2, ptWidI)
    'pt4 = ThisDrawing.Utility.PolarPoint(pt1, pi / 2, ptWidI)
    
    ThisDrawing.ModelSpace.AddLine pt1, pt2
    ThisDrawing.ModelSpace.AddLine pt2, pt3
    ThisDrawing.ModelSpace.AddLine pt3, pt4
    ThisDrawing.ModelSpace.AddLine pt4, pt1
    
    '*** OUTER BORDER ********************************************
    
    TitleBlock.show
    
End Sub

Added to General:

 

    Sub CreateLine()
    Dim StartPoint(0 To 2) As Double
    Dim EndPoint(0 To 2) As Double

    Dim txtStartPointX = 5.00
    Dim txtStartPointY = 28.00
    Dim txtStartPointZ = 0.00
    Dim txtEndPointX = 5.00
    Dim txtStartPointY = 27.50
    Dim txtStartPointZ = 0.00

    StartPoint(0) = txtStartPointX
    StartPoint(1) = txtStartPointY
    StartPoint(2) = txtStartPointZ
    EndPoint(0) = txtEndPointX
    EndPoint(1) = txtEndPointY
    EndPoint(2) = txtEndPointZ
    With ThisDrawing.ModelSpace
        .AddLine StartPoint, EndPoint
        .Item(.Count - 1).Update
End Sub

Added to second Button:

 

Private Sub CommandButton1_Click()
CreateLine
End Sub

Looking to type in an entire list of these coordinates for line generation. As shown in the screenshot also, various parts of the title block will have justified text (contents controlled by the dialogue box). The text content generation is no issue, only the placement. ' This is sourced information, not my own.

 

 

Sub Example_AddMtext()
    ' This example creates an MText object in model space.
    
    Dim MTextObj As AcadMText
    Dim corner(0 To 2) As Double
    Dim width As Double
    Dim text As String
    corner(0) = 0#: corner(1) = 10#: corner(2) = 0#
    width = 10
    text = "This is the text String for the mtext Object"

    ' Creates the mtext Object
    Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner, width, text)
    ZoomAll
    
End Sub
0 Likes
Message 4 of 6

Anonymous
Not applicable

And here is what I have for Multiple Text lines... Same issue of not being able to place multiple instances, only a single piece.

Private Sub CommandButton1_Click()
'***** ROW 1 *****
    ' This example creates an MText object in model space.
    
    Dim MTextObj As AcadMText
    Dim corner(0 To 2) As Double
    Dim width As Double
    Dim text As String
    
    corner1(0) = 17#: corner1(1) = 22#: corner1(2) = 5#
    corner11(0) = 23.012: corner11(1) = 24#: corner11(2) = 1.1
        
    'corner2(0) = 17.15625: corner2(1) = 22.4: corner2(2) = 5.25
    'corner22(0) = 23.012: corner22(1) = 24#: corner22(2) = 1.1
    
    'corner03A(0) = 17.15625: corner03A(1) = 22.4: corner03A(2) = 5.25
    'corner03B(0) = 23.012: corner03B(1) = 24#: corner03B(2) = 1.1
    
    'corner04A(0) = 17.15625: corner04A(1) = 22.4: corner04A(2) = 5.25
    'corner04B(0) = 23.012: corner04B(1) = 24#: corner04B(2) = 1.1
    
    'corner05A(0) = 17.15625: corner05A(1) = 22.4: corner05A(2) = 5.25
    'corner05B(0) = 23.012: corner05B(1) = 24#: corner05B(2) = 1.1
    
    'corner06A(0) = 17.15625: corner06A(1) = 22.4: corner06A(2) = 5.25
    'corner06B(0) = 23.012: corner06B(1) = 24#: corner06B(2) = 1.1
    
    'corner07A(0) = 17.15625: corner07A(1) = 22.4: corner07A(2) = 5.25
    'corner07B(0) = 23.012: corner07B(1) = 24#: corner07B(2) = 1.1
    
    'corner08A(0) = 17.15625: corner08A(1) = 22.4: corner08A(2) = 5.25
    'corner08B(0) = 23.012: corner08B(1) = 24#: corner08B(2) = 1.1
    
    'corner09A(0) = 17.15625: corner09A(1) = 22.4: corner09A(2) = 5.25
    'corner09B(0) = 23.012: corner09B(1) = 24#: corner09B(2) = 1.1
    
    'corner10A(0) = 17.15625: corner10A(1) = 22.4: corner10A(2) = 5.25
    'corner10B(0) = 23.012: corner10B(1) = 24#: corner10B(2) = 1.1
    
    widthT = 5.25
    widthN = 1.3775
    
    text1 = Me.REFDWG01.text
    text11 = Me.REFDWGNO01.text
    text2 = Me.REFDWG02.text
    text22 = Me.REFDWGNO02.text
    
    ' Creates the mtext Object
    Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner1, widthT, text1)
    Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner11, widthN, text11)
    Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner2, widthT, text2)
    Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner22, widthN, text22)
     
End Sub

Private Sub REFDWG01_Change()

End Sub

 

 

0 Likes
Message 5 of 6

Ed__Jobe
Mentor
Mentor

All the coordinates for the mtext are the same. It looks like you are just placing them on top of each other.

 

Also, you Dim corner(), but not any of the other "corner" variables. Since you are not using Option Explicit (read help on it), it allows you to enter them and they get dimmed as variants. The original corner variable is never used.

Ed


Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.

EESignature

0 Likes
Message 6 of 6

Anonymous
Not applicable
Accepted solution

In the former "accepted" example it is (hit accept in the excitement of the moment lol). I'll post my revised version here. My apologies for the pixelization of the image, it still captures the outcome. The second half to this code is still in works though. Where to place these suggestions is still a mystery to me: Verify Text Style existence in dwg.

0 Likes