DIMENSIONS FROM VBA TO INTELLICAD

#1
Hello,

I have written the code below which works perfectly drawing four shed elevations, however, I want to also include dimensions. How would I go about this please?


Option Explicit
Sub DrawBorder()
Dim icadApp As Object
Dim icadDoc As Object

Dim icadLibrary As Object
Dim myPoints As Object


Dim Shed As Object

'****** Launch icad application****
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 ActiveSheet.Range("E39"), ActiveSheet.Range("F39")
myPoints.Add ActiveSheet.Range("E40"), ActiveSheet.Range("F40")
myPoints.Add ActiveSheet.Range("E41"), ActiveSheet.Range("F41")
myPoints.Add ActiveSheet.Range("E42"), ActiveSheet.Range("F42")
myPoints.Add ActiveSheet.Range("E39"), ActiveSheet.Range("F39")

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 Shed = icadDoc.ModelSpace.AddLightWeightPolyline(myPoints)

icadApp.zoomextents

Set Shed = Nothing
Set icadApp = Nothing
Set icadDoc = Nothing

End Sub

Re: DIMENSIONS FROM VBA TO INTELLICAD

#2
You can start with AddDimAligned:

Code: Select all

Sub DrawBorder()
    Dim icadApp As Object
    Dim icadDoc As Object
    
    Dim icadLibrary As Object
    Dim myPoints As Object
    
    
    Dim Shed As Object
    
    '****** Launch icad application****
    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 ActiveSheet.Range("E39"), ActiveSheet.Range("F39")
    myPoints.Add ActiveSheet.Range("E40"), ActiveSheet.Range("F40")
    myPoints.Add ActiveSheet.Range("E41"), ActiveSheet.Range("F41")
    myPoints.Add ActiveSheet.Range("E42"), ActiveSheet.Range("F42")
    myPoints.Add ActiveSheet.Range("E39"), ActiveSheet.Range("F39")
    
    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 Shed = icadDoc.ModelSpace.AddLightWeightPolyline(myPoints)
    
    
    ' add dimAligned
    Dim pt1 As Object
    Dim pt2 As Object
    Dim txtPt As Object
    Dim aliDim As Object
    
    Set pt1 = icadLibrary.CreatePoint(ActiveSheet.Range("E39"), ActiveSheet.Range("F39"))
    Set pt2 = icadLibrary.CreatePoint(ActiveSheet.Range("E40"), ActiveSheet.Range("F40"))
    Set txtPt = icadLibrary.CreatePoint(ActiveSheet.Range("E41"), ActiveSheet.Range("F41"))
    
    Set aliDim = icadDoc.ModelSpace.AddDimAligned(pt1, pt2, txtPt)
    
    
    icadApp.zoomextents
    
    Set Shed = Nothing
    Set icadApp = Nothing
    Set icadDoc = Nothing

End Sub

Re: DIMENSIONS FROM VBA TO INTELLICAD

#4
Hello,

I have tried the code you wrote and it doesn't appear to work. Have I done something wrong? I have attached the code again here.


Option Explicit
Sub DrawBorder()
Dim icadApp As Object
Dim icadDoc As Object

Dim icadLibrary As Object
Dim myPoints As Object


Dim Shed As Object

'****** Launch icad application****
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 ActiveSheet.Range("E39"), ActiveSheet.Range("F39")
myPoints.Add ActiveSheet.Range("E40"), ActiveSheet.Range("F40")
myPoints.Add ActiveSheet.Range("E41"), ActiveSheet.Range("F41")
myPoints.Add ActiveSheet.Range("E42"), ActiveSheet.Range("F42")
myPoints.Add ActiveSheet.Range("E39"), ActiveSheet.Range("F39")

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 Shed = icadDoc.ModelSpace.AddLightWeightPolyline(myPoints)

' add dimAligned
Dim pt1 As Object
Dim pt2 As Object
Dim txtPt As Object
Dim aliDim As Object

Set pt1 = icadLibrary.CreatePoint(ActiveSheet.Range("E39"), ActiveSheet.Range("F39"))
Set pt2 = icadLibrary.CreatePoint(ActiveSheet.Range("E40"), ActiveSheet.Range("F40"))
Set txtPt = icadLibrary.CreatePoint(ActiveSheet.Range("E41"), ActiveSheet.Range("F41"))

Set aliDim = icadDoc.ModelSpace.AddDimAligned(pt1, pt2, txtPt)


icadApp.zoomextents

Set Shed = Nothing
Set icadApp = Nothing
Set icadDoc = Nothing

End Sub