I faced problem with VBA code, I want to start numbering as 1 from the third cell but it's started from number 2 ?!

[Elias]

Sub XYZ()
Dim ttt1 As String
Dim ttt2 As String
Dim ttt3 As String
Dim ccoc As Integer
Dim P1(0 To 2) As Double
Dim t1 As Variant
Dim t2 As Variant
Dim total(0 To 5) As Double
Dim t, sel, myBlock, po, ac, b1, b2, xl As Object
Dim p As Variant
Dim p2(0 To 2) As Double
Dim tex, i, ch, c, g, r, tp, en, co, rn
On Error Resume Next
Set ac = GetObject(, "AutoCAD.Application"): Set xl = GetObject(, "Excel.Application")
If Err <> 0 Then MsgBox "Please you should open AutoCAD first  :(": Exit Sub
xl.WindowState = xlMinimized
ac.WindowState = vbMaximizedFocus
On Error Resume Next: ac.ActiveDocument.SelectionSets("TempSSet").Delete
Set sel = ac.ActiveDocument.SelectionSets.Add("TempSSet")
sel.SelectOnScreen

i = -1: Cells(0, 1) = "SNo.": Cells(1, 2) = "EASTING": Cells(1, 3) = "NORTHING": Cells(1, 4) = "ELEVATION": Cells(1, 5) = "Object Name": Cells(1, 6) = "Length": Cells(1, 7) = "Radius": Cells(1, 8.) = "Area"
For Each po In sel
tp = tp + 1
Next
co = 2
rn = 3
If Sheet62.CheckBox1.Value = False Or Sheet62.CheckBox2.Value = False Then xl.WindowState = xlMaximized
For Each po In sel
If co = 8 Then co = 2 Else co = co + 1
i = i + 1
If i > tp - 1 Then Exit For
Set myBlock = sel.Item(i)
If InStr(1, myBlock.ObjectName, "Text", vbTextCompare) = False And InStr(1, myBlock.ObjectName, "Leader", vbTextCompare) = False And InStr(1, myBlock.ObjectName, "Dimension", vbTextCompare) = False Then
If myBlock.ObjectName = "AcDbLine" Or myBlock.ObjectName = "AcDbArc" Then
t1 = myBlock.StartPoint
t2 = myBlock.EndPoint
total(0) = t1(0): total(1) = t1(1): total(2) = t1(2): total(3) = t2(0): total(4) = t2(1): total(5) = t2(2)
p = total
Else
p = myBlock.Coordinates
End If
If myBlock.ObjectName = "AcDbCircle" Then
p = myBlock.Center
End If
On Error Resume Next
For g = 0 To 100000
Err.Clear
ch = p(g)
If Err <> 0 Then Exit For
Next
g = g - 1
If myBlock.ObjectName = "AcDbPolyline" Or myBlock.ObjectName = "AcDbSpline" Then r = 2 Else r = 3
en = 0
For c = 0 To g Step r
P1(0) = p(c): P1(1) = p(c + 1)
If r = 3 Then P1(2) = p(c + 2)
jeenee = myBlock.ObjectName
If Left(jeenee, 4) = "AcDb" Then jeenee = ExtractElement(jeenee, 2, "AcDb")
For nee = 1 To rn - 1
If Cells(nee, 2).Value = P1(0) And Cells(nee, 3).Value = P1(1) Then Exit For
Next
p2(0) = P1(0) + Sheet62.TextBox2.Text: p2(1) = P1(1) + Sheet62.TextBox3.Text: p2(2) = 0: Cells(rn, 2) = rn - 1: Cells(rn, 3) = P1(0): Cells(rn, 4) = P1(1): Cells(rn, 5) = P1(2): Cells(rn, 6) = jeenee
tex = ""
ccoc = Sheet62.TextBox4.Text
ttt1 = Round(P1(0), ccoc)
ttt1 = Cunt(ttt1, ccoc)
ttt2 = Round(P1(1), ccoc)
ttt2 = Cunt(ttt2, ccoc)
ttt3 = Round(P1(2), ccoc)
ttt3 = Cunt(ttt3, ccoc)

If Sheet62.CheckBox1.Value = True Then tex = "X = " & ttt1 & Chr(10) & "Y = " & ttt2 & Chr(10) & "Z = " & ttt3 & Chr(10)
If Sheet62.CheckBox2.Value = True Then tex = "P. " & rn - 1 & Chr(10) & tex
If Sheet62.CheckBox6.Value = True Then tex = rn - 1 & Chr(10) & tex
If nee = rn And (Sheet62.CheckBox1.Value = True Or Sheet62.CheckBox2.Value = True Or Sheet62.CheckBox6.Value = True) Then Set t = ac.ActiveDocument.ModelSpace.AddMText(p2, 0, tex): t.Height = Sheet62.TextBox1.Text: t.Update

en = en + 1
rn = rn + 1
Next
'If myBlock.Layer = "" Then Cells(1, 8.)= 0 Else
If myBlock.ObjectName = "AcDbLine" Or myBlock.ObjectName = "AcDbPolyline" Then Cells(rn - 1, 7) = Round(myBlock.Length, 4)
If myBlock.ObjectName = "AcDbLine" Or myBlock.ObjectName = "AcDbPolyline" Then Cells(rn - 1, 9) = Round(myBlock.Area, 4)
If myBlock.ObjectName = "AcDbCircle" Or myBlock.ObjectName = "AcDbArc" Then Cells(rn - 1, 8.) = Round(myBlock.Radius, 4)
If myBlock.ObjectName = "AcDbCircle" Or myBlock.ObjectName = "AcDbArc" Then Cells(rn - 1, 9) = Round(myBlock.Area, 4)
End If
Next
Columns("A:I").EntireColumn.AutoFit
Columns("J:I").Font.Bold = True
 Range("A1:I1").Font.Bold = True
 Range("A1:I1").HorizontalAlignment = xlCenter
 
 
End Sub

Edited September 21, 2020 by Elias

[rlx]

this site has a special vba forum , think you should post there. I have close to zero experience with vba so I gonna do a wild guess :

i = -1: Cells(0, 1) = "SNo.": Cells(1, 2) = "EASTING": Cells(1, 3) = "NORTHING": Cells(1, 4) = "ELEVATION": Cells(1, 5) = "Object Name": Cells(1, 6) = "Length": Cells(1, 7) = "Radius":

 

I assume i=-1 is a counter and you probably use ...bladiebla (set i (i +1))... at some point. In lisp the first item in a list is number 0 , but , just guessing here , maybe vba / excel starts with 1? I don't have vba enabled in my autocad so I can't test it. I'm sure other users here use vba , I believe Bigal has some experience with vba and he respons to many of the questions posted on this forum so I wouldn't be surpised he will give you a (better) answer.

 

 

[BIGAL]

What I know about VBa is dangerous, some stuff missing to test maybe Cells(rn, 2) = rn - 1 rn-2 ?

[Elias]

9 hours ago, BIGAL said:

What I know about VBa is dangerous, some stuff missing to test maybe Cells(rn, 2) = rn - 1 rn-2 ?

Hello Dear BIGAL,

 

Can you please be more specific what is the missing stuff

when I put rn=2 it's start numbering from 1 in the second ROW so I need it to start numbering (1) from the third ROW, I tired a lot but I still don't know what was the mistake.

 Thanks    

[BIGAL]

If you wrote the code then you should be able to work out what is wrong or did some one else do it ? It looks like some forms are being called. 

 

Ok

1 need image showing what is wrong. 

2 need xls with macro in it.

 

Again I am no expert in VBA.

[Elias]

 Sorry for disturbing you 

 

 

 TEST.xlsm

 

 

 

 

[BIGAL]

As I already guessed look at your row numbers you have row 1 as a blank line so row3 -2 if want a 1. Its a case of finding that rn-2 position. Not sure why row 1 is blank but that may be harder to fix. Can test is A1 blank A2 blank etc and subtract correct row number.

 

I think its in this line

p2(0) = P1(0) + Sheet62.TextBox2.Text: p2(1) = P1(1) + Sheet62.TextBox3.Text: p2(2) = 0: Cells(rn, 2) = rn - 1: Cells(rn, 3) = P1(0): Cells(rn, 4) = P1(1): Cells(rn, 5) = P1(2):

 

not tested busy at moment

Edited September 24, 2020 by BIGAL

[sanju2323]

Hi Elias,

 

   You need to change some lines below, hope your issue is resolved.

 

'Replace line

If Sheet1.CheckBox2.Value = True Then tex = "P. " & rn - 1 & Chr(10) & tex
If Sheet1.CheckBox6.Value = True Then tex = rn - 1 & Chr(10) & tex

'with

If Sheet1.CheckBox2.Value = True Then tex = "P. " & rn - 2 & Chr(10) & tex
If Sheet1.CheckBox6.Value = True Then tex = rn - 2 & Chr(10) & tex

'Replace line

p2(0) = P1(0) + Sheet1.TextBox2.Text: p2(1) = P1(1) + Sheet1.TextBox3.Text: p2(2) = 0: Cells(rn, 2) = rn - 1: Cells(rn, 3) = P1(0): Cells(rn, 4) = P1(1): Cells(rn, 5) = P1(2): Cells(rn, 6) = jeenee

'with

p2(0) = P1(0) + Sheet1.TextBox2.Text: p2(1) = P1(1) + Sheet1.TextBox3.Text: p2(2) = 0: Cells(rn, 2) = rn - 2: Cells(rn, 3) = P1(0): Cells(rn, 4) = P1(1): Cells(rn, 5) = P1(2): Cells(rn, 6) = jeenee

 

Bye

Edited September 24, 2020 by sanju2323

[Elias]

Your solution was very helpful, truly Bro you are a genius 
Thanks a lot

[sanju2323]

Your welcome