EXCEL VBA to INTELLICAD

#1
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

#2
Hi,

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