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.