how debug following code in cad vba

how debug following code in cad vba

Anonymous
Not applicable
413 Views
5 Replies
Message 1 of 6

how debug following code in cad vba

Anonymous
Not applicable
following code is to pointing 3d map of galaxy's arm from near solar system
but it has error
error name is type mismatch 13 and
object variable or with bloc variable no set
I do not know where error exist
if attached file is runed ,you may can see the error
of course, I do not know deeply about vba in cad, only a little know
so need your help,
attached file is vba code, and excel file

Option Explicit

Private Sub CommandButton1_Click()
Call DrawMeStars
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
frmDrawMeStars.Caption = "Go to Acad, draw the stars"
End Sub
Public Sub DrawMeStars()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlRange As Excel.Range
Dim coeff As Integer '+1 or -1
Dim location(0 To 2) As Double
Dim pointobj As AcadPoint

Dim lngRows As Long
Dim lngCols As Long
Dim indx As Long
Dim jndx As Long
Dim ra As String 'orbit coordiate of earth

Dim dec As String 'declination (elevater)
Dim mas As String ' palallax(use to distance)

Dim radegree As Double 'ra degree
Dim decdegree As Double 'dec degree


Dim radtrad As Double 'ra degree to radian
Dim decdtrad As Double 'dec degree to radian

Dim dist As Double 'distance

MsgBox "Be patience, works slowly"
frmDrawMeStars.Hide
On Error Resume Next

Err.Clear ' clear any errors
Set xlApp = GetObject(, "Excel.application") ' See if Excel is running
If Err 0 Then ' ' If Excel not running start a new session
Err.Clear
Set xlApp = CreateObject("Excel.application") ' Start Excel if excel is not running
If Err 0 Then
MsgBox " Could not start Excel ! , Is Excel Installed ? ", vbCritical, " Excel Error ! "
Err.Clear
End If
End If
Err.Clear

On Error GoTo Err_Control

xlApp.DisplayAlerts = False
xlApp.Visible = True ' Make excel application visible
xlApp.WindowState = xlMinimized ' Minimize application window so we don't see it

Set xlBook = xlApp.Workbooks.Open(FileName:="c:\40mas.xls")

' Make Autocad window maximum
AcadApplication.WindowState = acMax

Set xlSheet = xlBook.Worksheets(1)

xlSheet.Activate ' make sheet 1 the active sheet

'
' get Excel data
'
Set xlRange = xlBook.ActiveSheet.UsedRange
lngRows = xlRange.Rows.Count
lngCols = xlRange.Columns.Count

Const pi = 3.14159265358979

Dim dataArr() As Variant

dataArr = xlRange.Value2

xlApp.DisplayAlerts = True

xlBook.Close Savechanges:=False
xlApp.Quit
' clean up
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
DoEvents

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

For lngRows = 11 To UBound(dataArr, 1)


If dataArr(lngRows, 11) = "" Then

lngRows = lngRows + 4
End If


ra = dataArr(lngRows, 11)
dec = dataArr(lngRows, 12)
mas = dataArr(lngRows, 13)
If Mid(dec, 1, 1) = "-" Then coeff = -1 Else: coeff = 1
'calculating ra degree

radegree = 15 * CDbl(Mid(ra, 1, 2)) + 15 * CDbl(Mid(ra, 4, 2)) / 60 + 15 * Val(Mid(ra, 7, 6)) / 3600
'caculating dec degree
decdegree = CDbl(Mid(dec, 2, 2)) * coeff + CDbl(Mid(dec, 5, 2)) * coeff / 60 + Val(Mid(dec, 8, 6)) * coeff / 3600
'convert ra degree to radian
radtrad = (radegree / 180) * pi 'ra transferring from degree to radian
decdtrad = (decdegree / 180) * pi 'dec tranfering from degree to radian

dist = 3.26 * 1000 / CDbl(mas) ' calculating distance
'position of x,y z of location0=x,location1=y,location2=z

location(0) = dist * Cos(decdtrad) * Cos(radtrad)
location(1) = dist * Sin(radtrad) * Cos(decdtrad)
location(2) = dist * Sin(decdtrad)

Set pointobj = ThisDrawing.ModelSpace.AddPoint(location)

Next
ZoomAll
CommandButton2.SetFocus
CommandButton2.ForeColor = vbRed
frmDrawMeStars.Show
frmDrawMeStars.Caption = "Done"

Err_Control:
If Err.Number 0 Then
MsgBox Err.Description & vbCrLf & Err.Number
xlBook.Close Savechanges:=False
xlApp.Quit
' clean up
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
End Sub
0 Likes
414 Views
5 Replies
Replies (5)
Message 2 of 6

Anonymous
Not applicable
To find this error first put a breakpoint in the Err_Control on the msgbox line. Run the code. When the code stops place the mouse pointer on lngRows. An alert box will show lngRows = 1872.
Add dataArr to the Watch window. Look at dataArr(1872). Empty!
To fix change the if test.
0 Likes
Message 3 of 6

Anonymous
Not applicable
thanks a lot
0 Likes
Message 4 of 6

Anonymous
Not applicable
It may also be of use to you (though you have fixed your problem) to know about the "Locals" window (displays a list of all variable values at any given breakpoint in your program) and the F8 key, which allows you to step through your code line-by-line after a breakpoint. (Bear in mind with that, however, that the code is not executed until you move onto the next line).
0 Likes
Message 5 of 6

Anonymous
Not applicable
thanks a lot
0 Likes
Message 6 of 6

Anonymous
Not applicable
You're quite welcome 🐵
0 Likes