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
#2You 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
#4Hello,
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
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
Re: DIMENSIONS FROM VBA TO INTELLICAD
#5Hi,
Your code works as-is, please check your data file, maybe the value of cells in the excel file is invalid or empty.
Try to use this:
https://www.dropbox.com/s/caxtjfzgng65l ... .xlsm?dl=0
Your code works as-is, please check your data file, maybe the value of cells in the excel file is invalid or empty.
Try to use this:
https://www.dropbox.com/s/caxtjfzgng65l ... .xlsm?dl=0
Re: DIMENSIONS FROM VBA TO INTELLICAD
#6I can see how yours worked but mine did not. Here is what happened to mine (bear in mind I am not a proficient user in Intellicad).
- Attachments
-
- Result.PNG (7.58 KiB) Viewed 2764 times