Archive for the ‘Microstration VBA’ Category

Chain model – simple simulation

Sunday, November 15th, 2009

Wrote a simple script that simulates chain models in Microstation. A series of chain segments of a specific length is defined. Some knots are fix others can move.

 

‘Simulation of a chain model
‘Sebastian Gmelin
’15.11.2009

Option Explicit

Const gravity As Double = 1 / 5
Const springforce As Double = 1 / 8
Const attrForce As Double = 3

Public Type sphere
    number As Long
    radius As Double
    center As Point3d
    newCenter As Point3d
    sElements(3) As Element
    numNeighbours As Long
    Neighbours(10) As Long
    connections(10) As Element
    moveable As Boolean
End Type

Dim spheres() As sphere

Function createSphere(pos As Point3d, rad As Double, number As Long, moveable As Boolean) As sphere
   
    Dim elem As Element
    Dim mat As Matrix3d
   
    createSphere.center = pos
    createSphere.newCenter = pos
    createSphere.radius = rad
    createSphere.moveable = moveable
    createSphere.number = number
    createSphere.numNeighbours = 0
   
    Set elem = CreateLineElement2(Nothing, pos, pos)
    elem.Color = 3
    If moveable Then elem.Color = 1
    elem.LineWeight = 8
    elem.LineStyle = ActiveDesignFile.LineStyles(1)
    ActiveModelReference.AddElement elem
    elem.Redraw
    Set createSphere.sElements(0) = elem
   
    mat = Matrix3dFromAxisAndRotationAngle(2, 0)
    Set elem = CreateEllipseElement2(Nothing, pos, rad, rad, mat, msdFillModeNotFilled)
    elem.Color = 6
    elem.LineWeight = 0
    elem.LineStyle = ActiveDesignFile.LineStyles(2)
    ActiveModelReference.AddElement elem
    elem.Redraw
    Set createSphere.sElements(1) = elem
   
    mat = Matrix3dFromAxisAndRotationAngle(1, Pi / 2)
    Set elem = CreateEllipseElement2(Nothing, pos, rad, rad, mat, msdFillModeNotFilled)
    elem.Color = 6
    elem.LineWeight = 0
    elem.LineStyle = ActiveDesignFile.LineStyles(2)
    ActiveModelReference.AddElement elem
    elem.Redraw
    Set createSphere.sElements(2) = elem
   
    mat = Matrix3dFromAxisAndRotationAngle(0, Pi / 2)
    Set elem = CreateEllipseElement2(Nothing, pos, rad, rad, mat, msdFillModeNotFilled)
    elem.Color = 6
    elem.LineWeight = 0
    elem.LineStyle = ActiveDesignFile.LineStyles(2)
    ActiveModelReference.AddElement elem
    elem.Redraw
    Set createSphere.sElements(3) = elem
   
End Function

Sub moveSphere(s As sphere, vec As Point3d)

    Dim i As Long
   
    s.center = Point3dAdd(s.center, vec)
   
    For i = 0 To UBound(s.sElements)
        Call s.sElements(i).Move(vec)
        s.sElements(i).Rewrite
        s.sElements(i).Redraw
        ‘ActiveDesignFile.Views(1).Redraw
    Next i
   
End Sub

Sub moveConnections()

    Dim s As Long
    Dim c As Long
   
    For s = 0 To UBound(spheres)
        For c = 0 To spheres(s).numNeighbours – 1
            Call spheres(s).connections(c).AsLineElement.ModifyVertex(0, spheres(s).center)
            Call spheres(s).connections(c).AsLineElement.ModifyVertex(1, spheres(spheres(s).Neighbours(c)).center)
            spheres(s).connections(c).Rewrite
            spheres(s).connections(c).Redraw
        Next c
    Next s

End Sub

Sub makeSphereFix(s As Long)

    spheres(s).moveable = False
    spheres(s).sElements(0).Color = 3
    spheres(s).sElements(0).Rewrite
    spheres(s).sElements(0).Redraw

End Sub

Sub makeSphereMoveAble(s As Long)

    spheres(s).moveable = True
    spheres(s).sElements(0).Color = 1
    spheres(s).sElements(0).Rewrite
    spheres(s).sElements(0).Redraw

End Sub

Sub drawConnections(s As Long)

    Dim elem As Element
    Dim points(1) As Point3d
    Dim i As Long
   
    For i = 0 To spheres(s).numNeighbours – 1
        points(0) = spheres(s).center
        points(1) = spheres(spheres(s).Neighbours(i)).center
        Set elem = CreateLineElement1(Nothing, points)
        elem.Color = 2
        elem.LineWeight = 2
        elem.LineStyle = ActiveDesignFile.LineStyles(1)
        ActiveModelReference.AddElement elem
        elem.Redraw
        Set spheres(s).connections(i) = elem
    Next i

End Sub

Sub calculateSphereMove(s As Long)

    Dim i As Long
    Dim k As Long
    Dim direction As Point3d
    Dim dist As Double
    Dim length As Double
    Dim grav As Boolean
    Dim vec As Point3d
    Dim tension As Double
   
    If spheres(s).moveable Then
    tension = 0
        For i = 0 To spheres(s).numNeighbours – 1
            direction = Point3dSubtract(spheres(spheres(s).Neighbours(i)).center, spheres(s).newCenter)
            dist = Abs(Point3dMagnitude(direction))
            ‘Debug.Print (“distance ” + CStr(dist))
            length = spheres(s).radius + spheres(spheres(s).Neighbours(i)).radius
            ‘Debug.Print (“length ” + CStr(length))
            tension = tension + dist – length
        Next i
        tension = tension / (spheres(s).numNeighbours)
        grav = True
        If tension > 0 Then
            spheres(s).newCenter = Point3dAdd(spheres(s).newCenter, Point3dFromXYZ(0, 0, -0.1 * gravity))
        Else
            spheres(s).newCenter = Point3dAdd(spheres(s).newCenter, Point3dFromXYZ(0, 0, -1 * gravity))
        End If
        vec = Point3dFromXYZ(0, 0, 0)
        For i = 0 To spheres(s).numNeighbours – 1
            direction = Point3dSubtract(spheres(spheres(s).Neighbours(i)).center, spheres(s).newCenter)
            dist = Abs(Point3dMagnitude(direction))
            ‘Debug.Print (“distance ” + CStr(dist))
            length = spheres(s).radius + spheres(spheres(s).Neighbours(i)).radius
            ‘Debug.Print (“length ” + CStr(length))
            If (dist – length) > 0 Then
                grav = False
                direction = Point3dScale(direction, attrForce * springforce * (dist – length) / (dist))
            Else
                direction = Point3dScale(direction, springforce * (dist – length) / (dist))
            End If
            vec = Point3dAdd(vec, direction)
        Next i
        spheres(s).newCenter = Point3dAdd(spheres(s).newCenter, vec)
    End If

End Sub

Sub moveSpheres()

    Dim i As Long
    Dim s As Long
    Dim vec As Point3d
   
    For s = 0 To UBound(spheres)
        vec = Point3dSubtract(spheres(s).newCenter, spheres(s).center)
        spheres(s).center = spheres(s).newCenter
   
        For i = 0 To UBound(spheres(s).sElements)
            Call spheres(s).sElements(i).Move(vec)
            spheres(s).sElements(i).Rewrite
            spheres(s).sElements(i).Redraw
            ‘ActiveDesignFile.Views(1).Redraw
        Next i
    Next s

End Sub

 

Sub Main()

    Dim i As Long
    Dim k As Long
    Dim s As Long
   
    Randomize

    ReDim spheres(99)
    For i = 0 To 9
        For k = 0 To 9
            spheres(i * 10 + k) = createSphere(Point3dFromXYZ(i, k, 0), 0.65, i * 10 + k, True)
        Next k
    Next i
   
    For i = 0 To 9
        For k = 0 To 9
            ‘spheres(i * 10 + k) = createSphere(Point3dFromXYZ(i, k, 0), rnd * 0.2 + 0.5, i * 10 + k, True)
            If i < 9 Then
                spheres(i * 10 + k).Neighbours(spheres(i * 10 + k).numNeighbours) = i * 10 + k + 10
                spheres(i * 10 + k).numNeighbours = spheres(i * 10 + k).numNeighbours + 1
            End If
            If k < 9 Then
                spheres(i * 10 + k).Neighbours(spheres(i * 10 + k).numNeighbours) = i * 10 + k + 1
                spheres(i * 10 + k).numNeighbours = spheres(i * 10 + k).numNeighbours + 1
            End If
            If i > 0 Then
                spheres(i * 10 + k).Neighbours(spheres(i * 10 + k).numNeighbours) = i * 10 + k – 10
                spheres(i * 10 + k).numNeighbours = spheres(i * 10 + k).numNeighbours + 1
            End If
            If k > 0 Then
                spheres(i * 10 + k).Neighbours(spheres(i * 10 + k).numNeighbours) = i * 10 + k – 1
                spheres(i * 10 + k).numNeighbours = spheres(i * 10 + k).numNeighbours + 1
            End If
            Call drawConnections(i * 10 + k)
        Next k
    Next i
   
    ‘Call makeSphereFix(0)
    Call makeSphereFix(9)
    ‘Call makeSphereFix(55)
    Call makeSphereFix(90)
    Call makeSphereFix(99)
   
    For i = 0 To 75
‘        Call moveSphere(spheres(Round(Rnd * 99)), Point3dFromXYZ(0, 0, Rnd * 0.5 – 0.25))
‘        Call moveConnections
        For s = 0 To UBound(spheres)
            Call calculateSphereMove(s)
        Next s
        Call moveSpheres
        Call moveConnections
        ActiveDesignFile.Views(1).Redraw
    Next i
   
End Sub

Share

Hyperbolic Paraboloids – math model

Wednesday, November 11th, 2009

Hyperbolic paraboloids (HP) are discribed by the formula
\frac{x^2}{a^2} - \frac{y^2}{b^2} - 2z = 0
The below script creates HPs in Microstation within a certain range of  x and y coordinates. The dashed lines indicate the regular grid on coordinate system. These are of parabolic shape. The thick diagonal lines are all straight. They are the reason why this shape is interesting for construction, as it can be discribed as a series of straight lines. Intersecting the surface with a horizontal plane creates hyperbolas (blue curves).

Hyperbolic paraboloid

Hyperbolic paraboloid

‘Hyperbolic Paraboloids
‘Sebastian Gmelin
’11.11.2009

Const a As Double = 2
Const b As Double = 2

Const range As Long = 8

Dim hp() As Point3d

Dim x As Double
Dim y As Double
Dim z As Double
   
Dim point As Point3d

Dim ele As element
Sub drawGrid()

Dim points() As Point3d

ReDim points(range * 2)

    For x = range * -1 To range
        For y = range * -1 To range
            points(y + range) = hp(x + range, y + range)
        Next y
        Set ele = CreateLineElement1(Nothing, points)
        ele.Color = 4
        ele.LineWeight = 0
        ActiveModelReference.AddElement ele
        ele.Redraw
    Next x
   
    For y = range * -1 To range
        For x = range * -1 To range
            points(x + range) = hp(x + range, y + range)
        Next x
        Set ele = CreateLineElement1(Nothing, points)
        ele.Color = 4
        ele.LineWeight = 0
        ActiveModelReference.AddElement ele
        ele.Redraw
    Next y

End Sub
Sub drawDiaGrid()

Dim points() As Point3d
Dim i As Long

    For i = 1 To range * 2
        x = range * -1
        ReDim points(i)
        For y = range – i To range
            points(y – range + i) = hp(x + y + i, y + range)
        Next y
        Set ele = CreateLineElement1(Nothing, points)
        ele.Color = 7
        ele.LineWeight = 1
        ActiveModelReference.AddElement ele
        ele.Redraw
       
        For y = i To 0 Step -1
            points(i – y) = hp(i – y, y)
        Next y
        Set ele = CreateLineElement1(Nothing, points)
        ele.Color = 7
        ele.LineWeight = 1
        ActiveModelReference.AddElement ele
        ele.Redraw
       
        If i < range * 2 Then
            y = range * -1
            ReDim points(range * 2 – i)
            For x = range * -1 + i To range
                points(x + range – i) = hp(x + range, y + range * 2 + x – i)
            Next x
            Set ele = CreateLineElement1(Nothing, points)
            ele.Color = 7
            ele.LineWeight = 1
            ActiveModelReference.AddElement ele
            ele.Redraw
           
            y = range
            ReDim points(range * 2 – i)
            For x = range * -1 + i To range
                points(x + range – i) = hp(x + range, y – x + i)
            Next x
            Set ele = CreateLineElement1(Nothing, points)
            ele.Color = 7
            ele.LineWeight = 1
            ActiveModelReference.AddElement ele
            ele.Redraw
        End If
    Next i
   
   
End Sub

Sub horizontalCut(cz As Double)

Dim points() As Point3d
Dim pointsNeg() As Point3d

ReDim points(range * 2)
ReDim pointsNeg(range * 2)
   
    If cz >= 0 Then
        For y = range * -1 To range
            x = Math.Sqr(a * a * (((y * y) / (b * b)) + 2 * cz))
            points(y + range) = Point3dFromXYZ(x, y, cz)
            pointsNeg(y + range) = Point3dFromXYZ(-1 * x, y, cz)
        Next y
    Else
        For x = range * -1 To range
            y = Math.Sqr(b * b * (((x * x) / (a * a)) – 2 * cz))
            points(x + range) = Point3dFromXYZ(x, y, cz)
            pointsNeg(x + range) = Point3dFromXYZ(x, -1 * y, cz)
        Next x
    End If

    Set ele = CreateLineElement1(Nothing, points)
    ele.Color = 5
    ele.LineWeight = 2
    ActiveModelReference.AddElement ele
    ele.Redraw
   
    Set ele = CreateLineElement1(Nothing, pointsNeg)
    ele.Color = 5
    ele.LineWeight = 2
    ActiveModelReference.AddElement ele
    ele.Redraw

End Sub

 

Sub Main()
   
    ReDim hp(range * 2, range * 2)
   
    For x = range * -1 To range
        For y = range * -1 To range
            z = (((x * x) / (a * a)) – ((y * y) / (b * b))) / 2
            point = Point3dFromXYZ(x, y, z)
            Set ele = CreateLineElement2(Nothing, point, point)
            ele.Color = 3
            ele.LineWeight = 10
            ActiveModelReference.AddElement ele
            ele.Redraw
            hp(x + range, y + range) = point
        Next y
    Next x
   
    drawGrid
    drawDiaGrid
    horizontalCut (range / 2)
    horizontalCut (range / -2)

End Sub

Share

Bezier Curves, algorithm of de Casteljau

Sunday, November 1st, 2009

I started reading on Curve models and geometries, different types of Spline algorithms. This is a first attempt to generate Bezier curvers using the algorithm of de Casteljau. The script uses a selected polyline as the control polygon of the curve. The Bezier is created in several steps to illustrate the process. It runs under Microstation MVBA.

Bezier curve of degree 3

Bezier curve of degree 3

Bezier curve of degree 4

Bezier curve of degree 4

Bezier curve of degree 5

Bezier curve of degree 5

Bezier curve of degree 8

Bezier curve of degree 8

‘Linestring Bezier Approximation after Casteljau’s algorithm
‘Sebastian Gmelin
’24.10.2009

‘draw and select linestring and run script

Const cDiv As Long = 5 ‘subdivision at which guidlines are drawn and a copy of the drawing set is created
Const div As Long = 50 ‘subdivision between cDiv for bezier spline points (total subdivision = cDiv * div)

Dim cPoints() As Point3d
Dim bPoints() As Point3d
Dim cSize As Point3d
Dim cLine As Element
Private Sub ScanDesignFile()
‘scan active designfile for selected linestrings
    Dim oElEnum As ElementEnumerator
    Dim oElem As Element

    ‘get collection of selected elements
    Set oElEnum = ActiveModelReference.GetSelectedElements
    ActiveModelReference.UnselectAllElements
   
    ‘go through selection set
    While oElEnum.MoveNext
        Set oElem = oElEnum.Current
        ‘check if active element is linestring
        If (oElem.IsVertexList) Then
            Debug.Print (“Linestring”)
            cPoints = oElem.AsVertexList.GetVertices ‘save collection of vertices
            Set cLine = oElem
        End If
    Wend
End Sub

Private Sub getSize()
‘get linestring size for element copies offset

Dim i As Long
Dim min As Point3d
Dim max As Point3d
Dim lineString As Element

    min = Point3dFromXYZ(1E+17, 1E+17, 1E+17)
    max = Point3dFromXYZ(-1E+17, -1E+17, -1E+17)
   
    For i = 0 To UBound(cPoints)
        If cPoints(i).X > max.X Then max.X = cPoints(i).X
        If cPoints(i).Y > max.Y Then max.Y = cPoints(i).Y
        If cPoints(i).Z > max.Z Then max.Z = cPoints(i).Z
        If cPoints(i).X < min.X Then min.X = cPoints(i).X
        If cPoints(i).Y < min.Y Then min.Y = cPoints(i).Y
        If cPoints(i).Z < min.Z Then min.Z = cPoints(i).Z
    Next
   
    cSize = Point3dFromXYZ(0, max.Y – min.Y, 0)
    cSize.Y = cSize.Y * -1.2
   
End Sub

Sub Casteljau()

Dim i As Long
Dim k As Double
Dim p As Long
Dim points() As Point3d ‘last parent point collection
Dim dPoints() As Point3d ‘division points
Dim mPoints() As Point3d ‘points to draw
Dim lineString As Element
Dim color As Long
Dim count As Long
Dim moveCount As Long

ReDim bPoints(0)
bPoints(0) = cPoints(0)
count = 0
moveCount = 0

For k = 1 / (div * cDiv) To 1 Step 1 / (div * cDiv) ‘k is scale factor of divisions
    points = cPoints
    dPoints = cPoints
    color = 48
    ‘calculate divisions
    While UBound(dPoints) > 1
    ‘points is the collection of vertices of the parent linestring
    ‘dPoints is the child linestring at scalefactor k
        For i = 0 To UBound(points) – 1
            dPoints(i) = Point3dAdd(Point3dScale(Point3dSubtract(points(i + 1), points(i)), k), points(i))
        Next i
        ReDim Preserve dPoints(UBound(points) – 1)
        ‘draw guidlines
        If count = div Then
            mPoints = dPoints
            ‘calculate offset
            For p = 0 To UBound(mPoints)
                mPoints(p) = Point3dAdd(mPoints(p), Point3dScale(cSize, moveCount))
            Next
            ‘draw line
            Set lineString = CreateLineElement1(Nothing, mPoints)
            lineString.color = color
            lineString.LineStyle = ActiveDesignFile.LineStyles(3)
            ActiveModelReference.AddElement lineString
            lineString.Redraw
            color = color + 48
        End If
        points = dPoints
    Wend
    count = count + 1
    ‘draw progress of bezier curve
    If count > div Then
        count = 0
        ‘copy control polygon
        Set lineString = ActiveModelReference.CopyElement(cLine)
        Call lineString.Move(Point3dScale(cSize, moveCount))
        ActiveModelReference.AddElement lineString
        lineString.Redraw
        moveCount = moveCount + 1
        ‘calculate offset of beziers pline
        mPoints = bPoints
        For p = 0 To UBound(mPoints)
            mPoints(p) = Point3dAdd(mPoints(p), Point3dScale(cSize, moveCount – 1))
        Next
        ‘draw bezier progress
        Set lineString = CreateLineElement1(Nothing, mPoints)
        lineString.color = 3
        lineString.LineWeight = 2
        ActiveModelReference.AddElement lineString
        lineString.Redraw
    End If
    ‘add calculated division point to collection of bezier points
    ReDim Preserve bPoints(UBound(bPoints) + 1)
    bPoints(UBound(bPoints)) = Point3dAdd(Point3dScale(Point3dSubtract(points(1), points(0)), k), points(0))
Next k

‘draw final bezier curve
mPoints = bPoints
For p = 0 To UBound(mPoints)
    mPoints(p) = Point3dAdd(mPoints(p), Point3dScale(cSize, moveCount – 1))
Next
Set lineString = CreateLineElement1(Nothing, mPoints)
lineString.color = 3
lineString.LineWeight = 2
ActiveModelReference.AddElement lineString
lineString.Redraw

End Sub
Sub Main()

    If ActiveModelReference.AnyElementsSelected Then
        ScanDesignFile
        getSize
        Casteljau
    End If

End Sub

more Bezier curves

more Bezier curves

more Bezier curves

more Bezier curves

more Bezier curves

more Bezier curves

more Bezier curves

more Bezier curves

more Bezier curves

more Bezier curves

Share

Johannes Itten – “Tower of Fire”,parametric model

Wednesday, October 21st, 2009

Having seen a rebuilt of Itten’s “Tower of Fire” at the Bauhaus exhibition, I started swcripting a parametric model of the tower in the spirit of the workshop we’re planning to do next year. The VBA script runs in Microstation and is modified by the following parameters:

  • cSize As Double = edgeLength of the bottom cube
  • cAngle As Double = rotation in plan between each cube
  • cNumber As Long = number of cubes / levels
  • cScale As Double = the bottom radii of the cones equals the diagnal conrner distance by default. This is scaled by cScale parameter
  • uSeg As Long = Number of linear panels on cone
  • vSeg As Long = Number of circular panels on cone
  • cRad As Double = Radius of panel frames

Images of rebuilts of the tower:

Examples of towers using different parameters:
tower of fire 01

tower of fire 01

tower of fire 01 top view

tower of fire 01 top view

tower of fire 02

tower of fire 02

tower of fire 02 top view

tower of fire 02 top view

tower of fire 03

tower of fire 03

tower of fire 03 top view

tower of fire 03 top view

Source code for Microstation MVBA:

‘Draw a “tower of fire”
‘Parametric approach to Johannes Itten’s design
‘Sebastian Gmelin
’19.10.2009

Option Explicit

Const cSize As Double = 60
Const cAngle As Double = 3
Const cNumber As Long = 40
Const cScale As Double = 2
Const uSeg As Long = 10
Const vSeg As Long = 1
Const cRad As Double = 0.05

Public Type cube
    height As Double
    startPoint As Point3d
    endPoint As Point3d
    direction As Point3d
    botVertex(5) As Point3d
    topVertex(5) As Point3d
End Type

Dim cubes() As cube
Sub Main()
    Dim i As Long
    Dim k As Long
    Dim p As Long
    Dim q As Long
    Dim size As Double
    Dim direction As Point3d
    Dim startPoint As Point3d
    Dim endPoint As Point3d
    Dim height As Double
    Dim cOffset As Double
    Dim conePoints(4) As Point3d
    Dim cSpans() As Point2d
   
    Dim cSurface As New BsplineSurface
    Dim cCurves(2) As New BsplineCurve
    Dim isoCurves() As New BsplineCurve
    Dim cPath As New BsplineCurve
       
    Dim line As Element
    Dim coneEdge(2) As Element
    Dim cLine(3) As Element
    Dim cArc As Element
    Dim cSurfElement As BsplineSurfaceElement
    Dim cSpline As BsplineCurveElement
   
    ReDim cubes(cNumber)
    
    size = cSize
    direction = Point3dFromXYZ(1, 0, 0)
    startPoint = Point3dFromXYZ(size / -2, size / 2, 0)
    endPoint = Point3dFromXYZ(size / 2, size / 2, 0)
    height = Point3dDistance(endPoint, startPoint)
   
    For i = 1 To cNumber
        Call createBox(startPoint, endPoint)
       
        cOffset = Atn(cAngle * 3.141 / 180) * height
        height = Point3dDistance(endPoint, startPoint)
       
        ‘store data
        cubes(i).height = height
        cubes(i).startPoint = startPoint
        cubes(i).endPoint = endPoint
        cubes(i).direction = direction
        cubes(i).botVertex(1) = startPoint
        cubes(i).botVertex(2) = endPoint
        cubes(i).botVertex(3) = Point3dSubtract(endPoint, Point3dCrossProduct(Point3dSubtract(endPoint, startPoint), Point3dFromXYZ(0, 0, 1)))
        cubes(i).botVertex(4) = Point3dSubtract(startPoint, Point3dCrossProduct(Point3dSubtract(endPoint, startPoint), Point3dFromXYZ(0, 0, 1)))
        cubes(i).botVertex(0) = cubes(i).botVertex(4)
        cubes(i).botVertex(5) = cubes(i).botVertex(1)
        For k = 0 To 5
            cubes(i).topVertex(k) = cubes(i).botVertex(k)
            cubes(i).topVertex(k).z = cubes(i).botVertex(k).z + height
        Next
       
        ‘draw testpoints
        CadInputQueue.SendCommand “ACTIVE STYLE 1″
       
        Set line = CreateLineElement2(Nothing, cubes(i).botVertex(1), cubes(i).topVertex(3))
        ActiveModelReference.AddElement line
        line.Redraw
       
        Set line = CreateLineElement2(Nothing, cubes(i).botVertex(2), cubes(i).topVertex(4))
        ActiveModelReference.AddElement line
        line.Redraw
       
        Set line = CreateLineElement2(Nothing, cubes(i).botVertex(3), cubes(i).topVertex(1))
        ActiveModelReference.AddElement line
        line.Redraw
       
        Set line = CreateLineElement2(Nothing, cubes(i).botVertex(4), cubes(i).topVertex(2))
        ActiveModelReference.AddElement line
        line.Redraw
       
        ‘change data for next cube
        startPoint = Point3dSubtract(startPoint, Point3dScale(Point3dNormalize(Point3dCrossProduct(direction, Point3dFromXYZ(0, 0, 1))), cOffset))
        endPoint = Point3dSubtract(endPoint, Point3dScale(Point3dNormalize(direction), cOffset))
        direction = Point3dSubtract(endPoint, startPoint)
        startPoint.z = startPoint.z + height
        endPoint.z = endPoint.z + height
    Next
       
    For i = 2 To cNumber
        For k = 1 To 4
            SetCExpressionValue “tcb->symbology.color”, 0, “MGDSHOOK”
            CadInputQueue.SendCommand “ACTIVE STYLE 2″
            conePoints(0) = cubes(i).topVertex(k)
            conePoints(1) = cubes(i – 1).topVertex(k)
            conePoints(2) = cubes(i).topVertex(k + 1)
            conePoints(3) = Point3dScale(Point3dAdd(conePoints(1), conePoints(2)), 0.5)
            conePoints(4) = Point3dAdd(conePoints(3), Point3dScale(Point3dNormalize(Point3dCrossProduct(Point3dSubtract(conePoints(3), conePoints(0)), Point3dSubtract(conePoints(2), conePoints(1)))), cubes(i).height * cScale))
            
            Set coneEdge(1) = CreateLineElement2(Nothing, cubes(i – 1).topVertex(k), cubes(i).topVertex(k))
            ActiveModelReference.AddElement coneEdge(1)
            coneEdge(1).Redraw
            Set coneEdge(2) = CreateLineElement2(Nothing, cubes(i).topVertex(k), cubes(i).topVertex(k + 1))
            ActiveModelReference.AddElement coneEdge(2)
            coneEdge(2).Redraw
           
            Set cLine(1) = CreateLineElement2(Nothing, conePoints(1), conePoints(2))
            ActiveModelReference.AddElement cLine(1)
            cLine(1).Redraw
            Set cLine(1) = CreateLineElement2(Nothing, conePoints(0), conePoints(3))
            ActiveModelReference.AddElement cLine(1)
            cLine(1).Redraw
            Set cLine(1) = CreateLineElement2(Nothing, conePoints(3), conePoints(4))
            ActiveModelReference.AddElement cLine(1)
            cLine(1).Redraw
           
            Set cArc = CreateArcElement3(Nothing, conePoints(1), conePoints(4), conePoints(2))
            ActiveModelReference.AddElement cArc
            cArc.Redraw
           
            Call cCurves(0).FromElement(coneEdge(1))
            Call cCurves(1).FromElement(coneEdge(2))
            Call cCurves(2).FromElement(cArc)
           
            SetCExpressionValue “tcb->symbology.color”, k, “MGDSHOOK”
            CadInputQueue.SendCommand “ACTIVE STYLE 0″
            Call cSurface.FromRailsAndSweptSections(cCurves(0), cCurves(1), cCurves(2), Nothing)
            Set cSurfElement = CreateBsplineSurfaceElement1(Nothing, cSurface)
            ActiveModelReference.AddElement cSurfElement
            cSurfElement.Redraw
           
            ‘create Network U
            For q = 0 To uSeg
                isoCurves = cSurface.ExtractIsoparametricCurve(cSpans, q / uSeg, msdBsplineSurfaceU)
                For p = LBound(isoCurves) To UBound(isoCurves)
                    Set cSpline = CreateBsplineCurveElement1(Nothing, isoCurves(p))
                    ActiveModelReference.AddElement cSpline
                    cSpline.Redraw
                    Call createTube(cRad, isoCurves(p))
                Next p
            Next q
           
            ‘create Network V
            For q = 0 To vSeg
                isoCurves = cSurface.ExtractIsoparametricCurve(cSpans, q / vSeg, msdBsplineSurfaceV)
                For p = LBound(isoCurves) To UBound(isoCurves)
                    Set cSpline = CreateBsplineCurveElement1(Nothing, isoCurves(p))
                    ActiveModelReference.AddElement cSpline
                    cSpline.Redraw
                    Call createTube(cRad, isoCurves(p))
                Next p
            Next q
        Next k
    Next i

End Sub
Sub createBox(startPoint As Point3d, endPoint As Point3d)

    CadInputQueue.SendCommand “ACTIVE STYLE 0″
    SetCExpressionValue “tcb->symbology.color”, 0, “MGDSHOOK”
   
‘   Start a command
    CadInputQueue.SendCommand “MODELER BLOCK”

‘   Set a variable associated with a dialog box
    SetCExpressionValue “tcb->ms3DToolSettings.block.axisMode”, 0, “FEATURESOLID”
    SetCExpressionValue “tcb->ms3DToolSettings.block.length.value”, (ActiveModelReference.UORsPerMasterUnit * Abs(Point3dDistance(startPoint, endPoint))), “FEATURESOLID”
    SetCExpressionValue “tcb->ms3DToolSettings.block.width.value”, (ActiveModelReference.UORsPerMasterUnit * Abs(Point3dDistance(startPoint, endPoint))), “FEATURESOLID”
    SetCExpressionValue “tcb->ms3DToolSettings.block.height.value”, (ActiveModelReference.UORsPerMasterUnit * Abs(Point3dDistance(startPoint, endPoint))), “FEATURESOLID”
    SetCExpressionValue “tcb->ms3DToolSettings.block.height.locked”, 0, “FEATURESOLID”
    SetCExpressionValue “tcb->ms3DToolSettings.block.width.locked”, 0, “FEATURESOLID”
    SetCExpressionValue “tcb->ms3DToolSettings.block.length.locked”, 0, “FEATURESOLID”

    CadInputQueue.SendDataPoint startPoint, 1

‘   Send a keyin that can be a command string
    CadInputQueue.SendKeyin “AccuDraw Rotate Top”

    CadInputQueue.SendDataPoint endPoint, 1

    CadInputQueue.SendDataPoint Point3dSubtract(startPoint, Point3dCrossProduct(Point3dSubtract(endPoint, startPoint), Point3dFromXYZ(0, 0, 1))), 1
   
    CadInputQueue.SendDataPoint Point3dAdd(startPoint, Point3dFromXYZ(0, 0, Abs(Point3dDistance(startPoint, endPoint)))), 1

    CadInputQueue.SendCommand “CHOOSE ELEMENT”

    CommandState.StartDefaultCommand
End Sub

Sub createTube(rad As Double, path As BsplineCurve)
    Dim Frame As Matrix3d
    Dim Curvature As Double
    Dim Torsion As Double
    Dim Parameter As Double
    Dim LinearNormal As Point3d
    Dim Normal As Point3d
    Dim cPoint As Point3d
    Dim circ As Element
    Dim Rot As Matrix3d
    Dim line As Element
    Dim x As Point3d
    Dim y As Point3d
    Dim z As Point3d
    Dim startPoint As Point3d
    Dim endPoint As Point3d
   
    Dim cSurface As New BsplineSurface
    Dim cSurfElement As BsplineSurfaceElement
    Dim cSection As New BsplineCurve
       
    endPoint = path.EvaluatePointFrame(Frame, Curvature, Torsion, 1, LinearNormal)
    startPoint = path.EvaluatePointFrame(Frame, Curvature, Torsion, 0, LinearNormal)
    cPoint = startPoint
   
    y = Point3dNormalize(Point3dCrossProduct(Frame.RowY, Frame.RowX))
    z = Point3dNormalize(Frame.RowX)
    x = Point3dNormalize(Point3dCrossProduct(y, z))
   
    Rot = Matrix3dFromPoint3dColumns(x, y, z)
   
    Set line = CreateLineElement2(Nothing, cPoint, Point3dAdd(cPoint, x))
    line.Color = 1
    ActiveModelReference.AddElement line
    line.Redraw
   
    Set line = CreateLineElement2(Nothing, cPoint, Point3dAdd(cPoint, y))
    line.Color = 2
    ActiveModelReference.AddElement line
    line.Redraw
   
    Set line = CreateLineElement2(Nothing, cPoint, Point3dAdd(cPoint, z))
    line.Color = 3
    ActiveModelReference.AddElement line
    line.Redraw
   
    Set circ = CreateEllipseElement2(Nothing, cPoint, rad, rad, Rot)
    ActiveModelReference.AddElement circ
    circ.Redraw
   
    Call cSection.FromElement(circ)
    SetCExpressionValue “tcb->symbology.color”, 6, “MGDSHOOK”
    CadInputQueue.SendCommand “ACTIVE STYLE 0″
    Call cSurface.FromRailAndSweptSection(path, cSection)
    Set cSurfElement = CreateBsplineSurfaceElement1(Nothing, cSurface)
    ActiveModelReference.AddElement cSurfElement
    cSurfElement.Redraw
       
End Sub

Share