How to do " Union operation " for Box and Cylinder using VBA in EXCELL

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I am trying to do constructive solid geometry (Boolean operation ) using VBA in EXCEL, say a box and cylinder and then do "Union" operation
I am able to create the Box and Cylinder. But I can't do "Union Operation"
The code, i am using is shown below:
Private Sub CommandButton1_Click()
Dim BoxObject As Acad3DSolid
Dim CylinderObject As Acad3DSolid
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
Dim n As Integer
Dim myapp As Object
Dim mydwg As AcadDocument
Dim acad As AcadApplication 'Create ACAD variable of type AcadApplication?
Dim Coords(0 To 2) As Double 'This is an array of double precision floating point numbers
On Error GoTo errorhandler
Set myapp = GetObject(, "Autocad.application")
errorhandler:
If Err.Description <> "" Then
Err.Clear
Set myapp = CreateObject("autocad.application")
End If
On Error Resume Next 'This tells VBA to ignore errors
Set acad = GetObject(, "AutoCAD.Application")
On Error GoTo 0 'This tells VBA to go back to NOT ignoring errors
If acad Is Nothing Then 'Check to see if the above worked
Set acad = New AcadApplication 'Set the ACAD variable to equal a new instance of ?AutoCAD
acad.Visible = True 'Once loaded, set AutoCAD® to be visible
End If
myapp.Visible = True
Dim BoxCenter(0 To 2) As Double
Dim BoxLength As Double, BoxWidth As Double
Dim BoxHeight As Double
Dim CylinderCenter(0 To 2) As Double
Dim CylinderXDistance As Double, CylinderYDistance As Double
Dim CylinderHeight As Double
BoxCenter(0) = Sheet1.Cells(3, 14)
BoxCenter(1) = Sheet1.Cells(4, 14)
BoxCenter(2) = Sheet1.Cells(5, 14)
BoxLength = Sheet1.Cells(6, 14)
BoxWidth = Sheet1.Cells(7, 14)
BoxHeight = Sheet1.Cells(8, 14)
acad.ActiveDocument.ModelSpace.AddBox BoxCenter, BoxLength, BoxWidth, BoxHeight
CylinderCenter(0) = Sheet1.Cells(10, 14)
CylinderCenter(1) = Sheet1.Cells(11, 14)
CylinderCenter(2) = Sheet1.Cells(12, 14)
cylinderRadius = Sheet1.Cells(13, 14)
CylinderHeight = Sheet1.Cells(14, 14)
acad.ActiveDocument.ModelSpace.AddCylinder CylinderCenter, cylinderRadius, CylinderHeight
Dim ViewDirection(0 To 2) As Double
ViewDirection(0) = 3#
ViewDirection(1) = -2.5
ViewDirection(2) = 1.5
Set mydwg = myapp.ActiveDocument
Sheet1.Cells(1, 5).Value = mydwg.Name
For n = 2 To 10
startPoint(0) = Sheet1.Cells(n, 1) 'Put the Column 1 value into the Coords array
startPoint(1) = Sheet1.Cells(n, 2) 'Put the Column 2 value into the Coords a
startPoint(2) = Sheet1.Cells(n, 3)
endPoint(0) = Sheet1.Cells(n + 1, 1) 'Put the Column 1 value into the Coords array
endPoint(1) = Sheet1.Cells(n + 1, 2) 'Put the Column 2 value into the Coords a
endPoint(2) = Sheet1.Cells(n + 1, 3)
acad.ActiveDocument.ModelSpace.AddLine startPoint, endPoint
Next
startPoint(0) = 25#
startPoint(1) = 25#
startPoint(2) = 0#
endPoint(0) = 30#
endPoint(1) = 30#
endPoint(2) = 0#
acad.ActiveDocument.ModelSpace.AddLine startPoint, endPoint
Dim length As Double, width As Double, height As Double
Dim center(0 To 2) As Double
Dim cylinderObj As Acad3DSolid
CylinderCenter(0) = 0#: CylinderCenter(1) = 0#: CylinderCenter(2) = 0#
cylinderRadius = 5#
CylinderHeight = 20#
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ZoomAll
End Sub