Hi,
I am trying to use an Excel spreadsheet to draw a rectangle in Intellicad. Here is the code I have used. It will open Intellicad but comes up with an error at the drawing stage. Here is the code. I have highlighted where the error is occurring. Any help would be appreciated.
Option Explicit
Sub DrawRectange()
Dim icadApp As Object
Dim icadDoc As Object
Dim RectArray(0 To 9) As Double
Dim Rectangle As Object
On Error Resume Next
Set icadApp = GetObject(, "icad.application")
On Error GoTo 0
If icadApp Is Nothing Then
Set icadApp = CreateObject("icad.application")
icadApp.Visible = True
End If
'Point1
RectArray(0) = 0
RectArray(1) = 0
'Point 2
RectArray(2) = ActiveSheet.Range("F5")
RectArray(3) = 0
'Point 3
RectArray(4) = ActiveSheet.Range("F5")
RectArray(5) = ActiveSheet.Range("F6")
'Point4
RectArray(6) = 0
RectArray(7) = ActiveSheet.Range("F6")
'Point
RectArray(8) = 0
RectArray(9) = 0
On Error Resume Next
Set icadDoc = icadApp.activedocument
On Error GoTo 0
If icadDoc Is Nothing Then
Set icadDoc = icadApp.Documents.Add
End If
Set Rectangle = icadDoc.modelspace.addlightweightpolyline(RectArray) < This is the error line
icadDoc.Application.zoomextents
Set Rectangle = Nothing
Set icadApp = Nothing
Set icadDoc = Nothing
End Sub
Re: EXCEL VBA to INTELLICAD
#2Hi,
Try this:
Try this:
Code: Select all
Option Explicit
Sub DrawRectange()
Dim icadApp As Object
Dim icadDoc As Object
Dim iCadLibrary As Object
Dim myPoints As Object
Dim Rectangle As Object
On Error Resume Next
Set icadApp = GetObject(, "icad.application")
On Error GoTo 0
If icadApp Is Nothing Then
Set icadApp = CreateObject("icad.application")
icadApp.Visible = True
End If
Set iCadLibrary = icadApp.Library
Set myPoints = iCadLibrary.CreatePoints
myPoints.Add 1, 0
myPoints.Add ActiveSheet.Range("F5"), 0
myPoints.Add ActiveSheet.Range("F5"), ActiveSheet.Range("F6")
myPoints.Add 0, ActiveSheet.Range("F6")
myPoints.Add ActiveSheet.Range("F5"), 1
On Error Resume Next
Set icadDoc = icadApp.ActiveDocument
On Error GoTo 0
If icadDoc Is Nothing Then
Set icadDoc = icadApp.Documents.Add
End If
Set Rectangle = icadDoc.modelspace.addlightweightpolyline(myPoints) '< This work
icadDoc.Application.ZoomExtents
Set Rectangle = Nothing
Set icadApp = Nothing
Set icadDoc = Nothing
End Sub