Author Topic: Unable to add text in autocad while looping.  (Read 637 times)

0 Members and 1 Guest are viewing this topic.

Suresh_nair

  • Mosquito
  • Posts: 5
Unable to add text in autocad while looping.
« on: May 10, 2016, 12:12:23 pm »
Hi Friends,
         New to VBA hence please excuse my ignorance.
I have an excel spread sheet that is used to create one drawing in multiple views ( actually multiple panels nested in different views of a large box ie. front view/ side/ top etc..) . I'm done drawing the panels. This part is ok.
 Now when it comes to filling the panel dimensions above each panel i am facing a problem. The code works fine when it works outside the loop but when I try looping it .... no luck. can some one help please.
Code looks something like this.

Public Function Rectangle1(insertionPoint As Variant, Width As Double, height As Double) As AcadLWPolyline

Dim VerticesList(0 To 15) As Double

VerticesList(0) = insertionPoint(0): VerticesList(1) = insertionPoint(1)
VerticesList(2) = insertionPoint(0): VerticesList(3) = insertionPoint(1) + height
VerticesList(4) = insertionPoint(0) + Width: VerticesList(5) = insertionPoint(1) + height
VerticesList(6) = insertionPoint(0) + Width: VerticesList(7) = insertionPoint(1)

VerticesList(8) = insertionPoint(0): VerticesList(9) = insertionPoint(1)
VerticesList(10) = insertionPoint(0) + Width: VerticesList(11) = insertionPoint(1) + height
VerticesList(12) = insertionPoint(0): VerticesList(13) = insertionPoint(1) + height
VerticesList(14) = insertionPoint(0) + Width: VerticesList(15) = insertionPoint(1)

Set Rectangle1 = ActiveDocument.ModelSpace.AddLightWeightPolyline(VerticesList)
Rectangle1.Closed = True
Rectangle1.Update

End Function
Public Function AddText(textstring As String, insertionPoint As Variant, height As Double)
     
    Dim textObj As AcadText
    Dim textstring As String
    Dim insertionPoint(0 To 2) As Double
    Dim height As Double
    height = 100
       
    insertionPoint(0) = 2: insertionPoint(1) = 2: insertionPoint(2) = 0
    textstring = MyHeight & " x " & MyWidth
     
    Set textObj = ActiveDocument.ModelSpace.AddText(textstring, insertionPoint, height)'- i tried calling this line ito my loop
End Function

Sub test_rectangle()
Dim insertionPoint(1) As Variant
Dim MyWidth As Double
Dim MyHeight As Double
Dim MyRectangle As AcadLWPolyline
Dim i, j As Integer
Dim xoffset As Double
Dim yoffset As Double
  Dim textObj1 As AcadText
'-------------------------FRONT
insertionPoint(0) = 0
insertionPoint(1) = 0
MyHeight = Sheets("sheet1").Cells(10, 2)
MyWidth = Sheets("sheet1").Cells(11, 2)
Set MyRectangle = Rectangle2(insertionPoint, MyWidth, MyHeight)

insertionPoint(0) = -35
insertionPoint(1) = -35
Set MyRectangle = Rectangle2(insertionPoint, MyWidth + 70, MyHeight + 70)
Set textObj1 = textObj("textstring", insertionPoint, 100)
    j = 0
    yoffset = 0
Do Until Sheets("sheet1").Cells(19, 3 + j).Value = 0
    xoffset = 0
    i = 0
    Do Until Sheets("sheet1").Cells(19 + i, 3 + j).Value = 0
        insertionPoint(0) = yoffset
        insertionPoint(1) = xoffset
        MyHeight = Sheets("sheet1").Cells(19 + i, 3 + j)
        MyWidth = Sheets("sheet1").Cells(19 + i, 4 + j)
    Set MyRectangle = Rectangle2(insertionPoint, MyWidth, MyHeight)
    Set textObj = ActiveDocument.ModelSpace.AddText(textstring, insertionPoint, height)' ------- problem
    If Sheets("Sheet1").Cells(19 + i, 5 + j) = "Open" Then
     Set MyRectangle = Rectangle1(insertionPoint, MyWidth, MyHeight)
     End If
     
        xoffset = xoffset + MyHeight
        i = i - 2
    Loop
    yoffset = yoffset + MyWidth
    j = j + 3
Loop
.
.
.
.
.
.

« Last Edit: May 11, 2016, 03:56:57 am by Suresh_nair »

mmelone

  • Mosquito
  • Posts: 11
Re: Unable to add text in autocad while looping.
« Reply #1 on: May 10, 2016, 04:11:08 pm »
At first glance, it looks like you never define height in the test_rectangle function.  Since there is no Dim for height, the variable is automatically created as a Variant.  But, since a value was never given to the variable, it has no value when you are trying to pass it into the AddText function.

Suresh_nair

  • Mosquito
  • Posts: 5
Re: Unable to add text in autocad while looping.
« Reply #2 on: May 10, 2016, 09:27:33 pm »
mmelone ; thank you for your quick response.
I did try
 Set textObj = ActiveDocument.ModelSpace.AddText("textstring", insertionPoint, 100)

Here I assume insertion point would get the required values from the loop itself.
That too did not work.

Suresh_nair

  • Mosquito
  • Posts: 5
Re: Unable to add text in autocad while looping.
« Reply #3 on: May 14, 2016, 11:03:35 am »
Still unable to solve would appreciate some help on this :)

roy_043

  • Swamp Rat
  • Posts: 1367
  • BricsCAD 16
Re: Unable to add text in autocad while looping.
« Reply #4 on: May 15, 2016, 03:50:47 am »
Try using:
Code: [Select]
Dim insertionPoint(1) As DoubleInstead of
Code: [Select]
Dim insertionPoint(1) As Variant

Bryco

  • Water Moccasin
  • Posts: 1770
Re: Unable to add text in autocad while looping.
« Reply #5 on: May 15, 2016, 11:34:47 am »
needs a 3d point not 2
 Dim insertionPoint(0 To 2) As Double =good

roy_043

  • Swamp Rat
  • Posts: 1367
  • BricsCAD 16
Re: Unable to add text in autocad while looping.
« Reply #6 on: May 15, 2016, 04:24:32 pm »
needs a 3d point not 2
 Dim insertionPoint(0 To 2) As Double =good
AutoCAD may be more strict, but BricsCAD accepts a 2D point here.

Suresh_nair

  • Mosquito
  • Posts: 5
Re: Unable to add text in autocad while looping.
« Reply #7 on: May 17, 2016, 09:03:49 am »
Sub txt_insert()
    Dim textObj As AcadText
    Dim textstring As String
    Dim insertionPoint(0 To 2) As Double
   
        insertionPoint(0) = -1000: insertionPoint(1) = 200 + Sheets("sheet1").Cells(10, 2) + Sheets("sheet1").Cells(34, 2) / 2: insertionPoint(2) = 0
        Set textObj = ActiveDocument.ModelSpace.AddText("TOP VIEW", insertionPoint, 140)
        insertionPoint(0) = -1500: insertionPoint(1) = -Sheets("sheet1").Cells(34, 2) / 2: insertionPoint(2) = 0
        Set textObj = ActiveDocument.ModelSpace.AddText("BOTTOM VIEW", insertionPoint, 140)
        insertionPoint(0) = -1200: insertionPoint(1) = -200 - Sheets("sheet1").Cells(34, 2) - Sheets("sheet1").Cells(22, 2) / 2: insertionPoint(2) = 0
        Set textObj = ActiveDocument.ModelSpace.AddText("BACK VIEW", insertionPoint, 140)
       
End Sub


I am able to work outside the loop and get my text on to the drg. My problem is when i try and get the text to write inside a loop i an unable to do so. 
also please look at the enclosed fie. I am drawing individual panels(blue rectangles) inside a frame view(red rectangle) for a best possible fit. im ok with this part. Now I wish to add the dimensions of each blue rectangle within the rectangle itself, just after the rectangle is drawn while the loop is running.

57gmc

  • Newt
  • Posts: 51
Re: Unable to add text in autocad while looping.
« Reply #8 on: May 17, 2016, 11:10:17 am »
Does the reference to the xl sheet return a double? You may need to set a breakpoint in your code and watch what it its to make sure that InsertionPoint(1) is getting set properly. If not, you may need to use the CDbl() function to explicitly cast it to a double.
« Last Edit: May 17, 2016, 11:24:15 am by 57gmc »

Suresh_nair

  • Mosquito
  • Posts: 5
Re: Unable to add text in autocad while looping.
« Reply #9 on: May 17, 2016, 11:54:06 am »
Thanks guys . Problem solved

Public Function textObj(textstring As String, insertionPoint As Double, height As Double)
     
    Dim textObj As AcadText
    Dim textstring As String
    Dim insertionPoint(0 To 2) As Double
    Dim height As Double
    height = 100
       
    insertionPoint(0) = 2: insertionPoint(1) = 2: insertionPoint(2) = 0
    textstring = MyHeight & " x " & MyWidth
     
    Set textObj = ActiveDocument.ModelSpace.addtext("textstring", insertionPoint, 100)

End Function


Sub test_rectangle()
Dim insertionPoint(0 To 2) As Double
Dim MyWidth As Double
Dim MyHeight As Double
Dim MyRectangle As AcadLWPolyline
Dim i, j As Integer
Dim xoffset As Double
Dim yoffset As Double
Dim textObj As AcadText
'-------------------------FRONT
   
   ' Call ChnageAllToLyer

insertionPoint(0) = 0
insertionPoint(1) = 0
MyHeight = Sheets("sheet1").Cells(10, 2)
MyWidth = Sheets("sheet1").Cells(11, 2)
Set MyRectangle = Rectangle3(insertionPoint, MyWidth, MyHeight)


insertionPoint(0) = -35
insertionPoint(1) = -35
Set MyRectangle = Rectangle3(insertionPoint, MyWidth + 70, MyHeight + 70)

    j = 0
    yoffset = 0
Do Until Sheets("sheet1").Cells(19, 3 + j).Value = 0
    xoffset = 0
    i = 0
    Do Until Sheets("sheet1").Cells(19 + i, 3 + j).Value = 0
        insertionPoint(0) = yoffset
        insertionPoint(1) = xoffset
        MyHeight = Sheets("sheet1").Cells(19 + i, 3 + j)
        MyWidth = Sheets("sheet1").Cells(19 + i, 4 + j)
    Set MyRectangle = Rectangle2(insertionPoint, MyWidth, MyHeight)
    insertionPoint(1) = xoffset + 50
    Set textObj = ActiveDocument.ModelSpace.addtext(MyWidth & "x" & MyHeight, insertionPoint, 100)
   
    If Sheets("Sheet1").Cells(19 + i, 5 + j) = "Open" Then
     Set MyRectangle = Rectangle1(insertionPoint, MyWidth, MyHeight)
     End If
     
        xoffset = xoffset + MyHeight
        i = i - 2
    Loop
    yoffset = yoffset + MyWidth
    j = j + 3
Loop

'_______________ TOP
insertionPoint(0) = 0
insertionPoint(1) = Sheets("sheet1").Cells(10, 2) + 70 + 100
MyHeight = Sheets("sheet1").Cells(34, 2)
MyWidth = Sheets("sheet1").Cells(35, 2)
Set MyRectangle = Rectangle3(insertionPoint, MyWidth, MyHeight)

insertionPoint(0) = -35
insertionPoint(1) = -35 + Sheets("sheet1").Cells(10, 2) + 70 + 100
Set MyRectangle = Rectangle3(insertionPoint, MyWidth + 70, MyHeight + 70)

   j = 0
    yoffset = 0
Do Until Sheets("sheet1").Cells(43, 3 + j) = 0
    xoffset = 0
    i = 0
    Do Until Sheets("sheet1").Cells(43 + i, 3 + j) = 0
        insertionPoint(0) = yoffset
        insertionPoint(1) = xoffset + Sheets("sheet1").Cells(10, 2) + 70 + 100
        MyHeight = Sheets("sheet1").Cells(43 + i, 3 + j)
        MyWidth = Sheets("sheet1").Cells(43 + i, 4 + j)
    Set MyRectangle = Rectangle2(insertionPoint, MyWidth, MyHeight)
   
    insertionPoint(1) = xoffset + Sheets("sheet1").Cells(10, 2) + 70 + 100 + 50
    Set textObj = ActiveDocument.ModelSpace.addtext(MyWidth & "x" & MyHeight, insertionPoint, 100)
   
    If Sheets("Sheet1").Cells(43 + i, 5 + j) = "Open" Then
     Set MyRectangle = Rectangle1(insertionPoint, MyWidth, MyHeight)
    End If
     
        xoffset = xoffset + MyHeight
        i = i - 2
    Loop
    yoffset = yoffset + MyWidth
    j = j + 3
Loop

Attached file for your reference. Now on to the beautification part.. :)
The problem was indeed with the insertion point being defined wrongly
Wish to thank 57gmc/roy_043/mmelone & bryco for your reply and help . Cheers.
Do i need to close this post or mark it as resolved? please advise. Thanks again guys. :)