TheSwamp
Code Red => VB(A) => Topic started by: Suresh_nair 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
.
.
.
.
.
.
-
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.
-
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.
-
Still unable to solve would appreciate some help on this :)
-
Try using:
Dim insertionPoint(1) As Double
Instead of
Dim insertionPoint(1) As Variant
-
needs a 3d point not 2
Dim insertionPoint(0 To 2) As Double =good
-
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.
-
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.
-
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.
-
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. :)