Message 1 of 2
what is objec variable or with bloc variable no set
Not applicable
12-29-2006
05:54 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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, and then all most of source code is written by here's id fatty
attached file is vba code, and excel file
please help me
following is that's code
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:\200mas.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
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, and then all most of source code is written by here's id fatty
attached file is vba code, and excel file
please help me
following is that's code
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:\200mas.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