SliceSolid in VBA

[gaplek]

Hi..

I have SliceSolid command (3D object) in my VBA program.

using this command :

 

Set 3DSolidObject = 3DSolidObject.SliceSolid(PlanePoint1, _
PlanePoint2, PlanePoint3, Negative)

 

it is difficult to select the properly point that i need.

when i select 3 points, the cutting direction is different with what i want.

Is there any way to adjust its cutting direction for 3D slice solid?

 

and then, how to make a view (such as : front view, right view etc) using VBA?

i think, it will make easier in point selection.

 

thank you

[ASMI]

Add 3 named views to Views collection and use SetView method for temporary setting of view for current viewport or 4 splitted viewports (1-st- original view, 2nd - XY-plane view, 3-rd - XZ-plane view, 4-th - YZ-plane view. For viewport split use Split method.

[rocheey]

Hi..

I have SliceSolid command (3D object) in my VBA program.

using this command :

 

Set 3DSolidObject = 3DSolidObject.SliceSolid(PlanePoint1, _
PlanePoint2, PlanePoint3, Negative)

 

it is difficult to select the properly point that i need.

when i select 3 points, the cutting direction is different with what i want.

Is there any way to adjust its cutting direction for 3D slice solid?

 

thank you

 

Its hard to tell exactly what the problem is - are you snapping to the wrong point in 3d space? Or is your direction backards?

 

What I used to do, when sectioning solids, was to make an interface up. The following code was quickly cobbled together using code stolen from the help files. It draws a 3d solid, sets the shading mode, then draws a rectangular hatch as your "plane" to section with.

 

Drop a userform into a project, add two scroll bars to the form, using the default names of "ScrollBar1" and "ScrollBar2"., and drop the code below onto the form code. then run the code.

The First scroll bar rotates the view of the solid, the second scrollbar rotates the hatch in 3d space.

 

I didnt have time to put all the event code in there, the scrollbars wil only work when holding the mouse down on them and moving it, but you should get the idea.

 

   Dim hatchObj As AcadHatch
Private Sub ScrollBar1_Change()
   Dim NewDirection(0 To 2) As Double
   NewDirection(0) = -1: NewDirection(1) = ScrollBar1.Value / 100: NewDirection(2) = 1
   ThisDrawing.ActiveViewport.Direction = NewDirection
   ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport

End Sub
Private Sub ScrollBar1_Scroll()
   Dim NewDirection(0 To 2) As Double
   NewDirection(0) = -1: NewDirection(1) = ScrollBar1.Value / 100: NewDirection(2) = 1
   ThisDrawing.ActiveViewport.Direction = NewDirection
   ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
End Sub

Private Sub ScrollBar2_Scroll()
   Dim rotatePt1(0 To 2) As Double
   Dim rotatePt2(0 To 2) As Double
   Dim rotateAngle As Double

   rotateAngle = CDbl(ScrollBar2.Tag)
   rotateAngle = (rotateAngle - ScrollBar2.Value) / 1000

   ScrollBar2.Tag = ScrollBar2.Value


   rotatePt1(0) = 0: rotatePt1(1) = -10: rotatePt1(2) = 0
   rotatePt2(0) = 0: rotatePt2(1) = 10: rotatePt2(2) = 0
   hatchObj.Rotate3D rotatePt1, rotatePt2, rotateAngle
   ThisDrawing.Regen acAllViewports

End Sub
Private Sub UserForm_Initialize()
   ' set extents of scrollbar
   ScrollBar1.Min = -100
   ScrollBar1.Max = 100
   ScrollBar1.SmallChange = 1
   ScrollBar1.LargeChange = 10
   ScrollBar1.Value = 0

   ScrollBar2.Min = 0
   ScrollBar2.Max = 31415
   ScrollBar2.SmallChange = 10
   ScrollBar2.LargeChange = 100
   ScrollBar2.Value = 0
   ScrollBar2.Tag = 0


   setupsolid
End Sub

Sub setupsolid()
   ' Draw a Box in Modelspace: from the help file
   Dim boxObj As Acad3DSolid
   Dim length As Double, width As Double, height As Double
   Dim center(0 To 2) As Double
   Dim ViewCenter(1) As Double: ViewCenter(0) = 0#: ViewCenter(1) = 0#


   ' Define the box
   center(0) = 0#: center(1) = 0#: center(2) = 0
   length = 5#: width = 7: height = 10#

   ' Create the box (3DSolid) object in model space
   Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)

   ' Draw a hatched rectangle to be our current plane
   AddHatch
   ' set mode to shaded
   ThisDrawing.SendCommand "vscurrent c "


  ' Change the viewing direction of the viewport to better see the box
   Dim NewDirection(0 To 2) As Double
   NewDirection(0) = -1: NewDirection(1) = 0: NewDirection(2) = 1
   ThisDrawing.ActiveViewport.Direction = NewDirection
   ThisDrawing.ActiveViewport.center = ViewCenter
   ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
   ZoomAll

End Sub
Sub AddHatch()
   ' This example creates an associative gradient hatch in model space.

   Dim patternName As String
   Dim PatternType As Long
   Dim bAssociativity As Boolean

   ' Define the hatch
   patternName = "ANSI37"
   bAssociativity = False

   ' Create the non-associative Hatch object in model space
   Set hatchObj = ThisDrawing.ModelSpace.AddHatch(0, patternName, bAssociativity, acHatchObject)
   hatchObj.color = acRed

   ' Create the outer boundary for the hatch (a rectangle)
   Dim plineObj As AcadPolyline
   Dim points(0 To 11) As Double

   ' Define the 2D polyline points
   points(0) = -6: points(1) = -6: points(2) = 0
   points(3) = -6: points(4) = 6: points(5) = 0
   points(6) = 6: points(7) = 6: points( = 0
   points(9) = 6: points(10) = -6: points(11) = 0
   Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
   plineObj.Closed = True

   ' Create a lightweight Polyline object in model space

   Dim outerLoop(0 To 0) As AcadEntity
   Set outerLoop(0) = plineObj

   ' Append the outerboundary to the hatch object, and display the hatch
   hatchObj.AppendOuterLoop (outerLoop)
   hatchObj.Evaluate
   plineObj.Delete


   ThisDrawing.Regen True
End Sub