Revit几何创建代码

panhao1

官网资源整理
调用库：
Imports Autodesk.Revit
Imports Autodesk.Revit.DB
成员变量：
   Private m_revit As Autodesk.Revit.ApplicationServices.Application
    Private m_thisDoc As ThisDocument
    Private m_familyDocument As Autodesk.Revit.DB.Document
    Private m_creationFamily As Autodesk.Revit.Creation.FamilyItemFactory = Nothing
    Private m_isCreateFamilyDoc As Boolean = False
    Private m_errCount As Integer = 0
    Private m_errorInfo As String = ""

panhao1

挤出物体：
  Private Sub CreateExtrusion()
        Try
            '#Region "Create rectangle profile"
            Dim curveArrArray As CurveArrArray = m_revit.Create.NewCurveArrArray()
            Dim curveArray1 As CurveArray = m_revit.Create.NewCurveArray()
            Dim curveArray2 As CurveArray = m_revit.Create.NewCurveArray()
            Dim curveArray3 As CurveArray = m_revit.Create.NewCurveArray()

            Dim normal As Autodesk.Revit.DB.XYZ = Autodesk.Revit.DB.XYZ.BasisZ
            Dim sketchPlane As Autodesk.Revit.DB.SketchPlane = CreateSketchPlane(normal, Autodesk.Revit.DB.XYZ.Zero)

            ' create one rectangular extrusion
            Dim p0 As Autodesk.Revit.DB.XYZ = Autodesk.Revit.DB.XYZ.Zero
            Dim p1 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(10, 0, 0)
            Dim p2 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(10, 10, 0)
            Dim p3 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 10, 0)
            Dim line1 As Line = m_revit.Create.NewLineBound(p0, p1)
            Dim line2 As Line = m_revit.Create.NewLineBound(p1, p2)
            Dim line3 As Line = m_revit.Create.NewLineBound(p2, p3)
            Dim line4 As Line = m_revit.Create.NewLineBound(p3, p0)
            curveArray1.Append(line1)
            curveArray1.Append(line2)
            curveArray1.Append(line3)
            curveArray1.Append(line4)

            curveArrArray.Append(curveArray1)
            '#End Region
            ' here create rectangular extrusion
            Dim rectExtrusion As Extrusion = m_creationFamily.NewExtrusion(True, curveArrArray, sketchPlane, 10)
            ' move to proper place
            Dim transPoint1 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(-16, 0, 0)
            m_familyDocument.Move(rectExtrusion, transPoint1)
        Catch e As Exception
            m_errCount += 1
            m_errorInfo += "Unexpected exceptions occur in CreateExtrusion: " & e.ToString() & vbCr & vbLf
        End Try
    End Sub

panhao1

Blend 物体

Private Sub CreateBlend()
        Try
            '#Region "Create top and base profiles"
            Dim topProfile As CurveArray = m_revit.Create.NewCurveArray()
            Dim baseProfile As CurveArray = m_revit.Create.NewCurveArray()

            Dim normal As Autodesk.Revit.DB.XYZ = Autodesk.Revit.DB.XYZ.BasisZ
            Dim sketchPlane As Autodesk.Revit.DB.SketchPlane = CreateSketchPlane(normal, Autodesk.Revit.DB.XYZ.Zero)

            ' create one blend
            Dim p00 As Autodesk.Revit.DB.XYZ = Autodesk.Revit.DB.XYZ.Zero
            Dim p01 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(10, 0, 0)
            Dim p02 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(10, 10, 0)
            Dim p03 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 10, 0)
            Dim line01 As Line = m_revit.Create.NewLineBound(p00, p01)
            Dim line02 As Line = m_revit.Create.NewLineBound(p01, p02)
            Dim line03 As Line = m_revit.Create.NewLineBound(p02, p03)
            Dim line04 As Line = m_revit.Create.NewLineBound(p03, p00)

            baseProfile.Append(line01)
            baseProfile.Append(line02)
            baseProfile.Append(line03)
            baseProfile.Append(line04)

            Dim p10 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(5, 2, 10)
            Dim p11 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(8, 5, 10)
            Dim p12 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(5, 8, 10)
            Dim p13 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(2, 5, 10)
            Dim line11 As Line = m_revit.Create.NewLineBound(p10, p11)
            Dim line12 As Line = m_revit.Create.NewLineBound(p11, p12)
            Dim line13 As Line = m_revit.Create.NewLineBound(p12, p13)
            Dim line14 As Line = m_revit.Create.NewLineBound(p13, p10)

            topProfile.Append(line11)
            topProfile.Append(line12)
            topProfile.Append(line13)
            topProfile.Append(line14)
            '#End Region
            ' here create rectangular blend
            Dim blend As Blend = m_creationFamily.NewBlend(True, topProfile, baseProfile, sketchPlane)
            ' move to proper place
            Dim transPoint1 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 11, 0)
            m_familyDocument.Move(blend, transPoint1)
        Catch e As Exception
            m_errCount += 1
            m_errorInfo += "Unexpected exceptions occur in CreateBlend: " & e.ToString() & vbCr & vbLf
        End Try
    End Sub

panhao1

Revolut物体

Private Sub CreateRevolution()
        Try
            '#Region "Create rectangular profile"
            Dim curveArrArray As CurveArrArray = m_revit.Create.NewCurveArrArray()
            Dim curveArray As CurveArray = m_revit.Create.NewCurveArray()

            Dim normal As Autodesk.Revit.DB.XYZ = Autodesk.Revit.DB.XYZ.BasisZ
            Dim sketchPlane As Autodesk.Revit.DB.SketchPlane = CreateSketchPlane(normal, Autodesk.Revit.DB.XYZ.Zero)

            ' create one rectangular profile revolution
            Dim p0 As Autodesk.Revit.DB.XYZ = Autodesk.Revit.DB.XYZ.Zero
            Dim p1 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(10, 0, 0)
            Dim p2 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(10, 10, 0)
            Dim p3 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 10, 0)
            Dim line1 As Line = m_revit.Create.NewLineBound(p0, p1)
            Dim line2 As Line = m_revit.Create.NewLineBound(p1, p2)
            Dim line3 As Line = m_revit.Create.NewLineBound(p2, p3)
            Dim line4 As Line = m_revit.Create.NewLineBound(p3, p0)

            Dim pp As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(1, -1, 0)
            Dim axis1 As Line = m_revit.Create.NewLineBound(Autodesk.Revit.DB.XYZ.Zero, pp)
            curveArray.Append(line1)
            curveArray.Append(line2)
            curveArray.Append(line3)
            curveArray.Append(line4)

            curveArrArray.Append(curveArray)
            '#End Region
            ' here create rectangular revolution
            Dim revolution1 As Revolution = m_creationFamily.NewRevolution(True, curveArrArray, sketchPlane, axis1, -Math.PI, 0)
            ' move to proper place
            Dim transPoint1 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 32, 0)
            m_familyDocument.Move(revolution1, transPoint1)
        Catch e As Exception
            m_errCount += 1
            m_errorInfo += "Unexpected exceptions occur in CreateRevolution: " & e.ToString() & vbCr & vbLf
        End Try
    End Sub

panhao1

放样（单轴）
Private Sub CreateSweep()
        Try
            '#Region "Create rectangular profile and path curve"
            Dim arrarr As CurveArrArray = m_revit.Create.NewCurveArrArray()
            Dim arr As CurveArray = m_revit.Create.NewCurveArray()

            Dim normal As Autodesk.Revit.DB.XYZ = Autodesk.Revit.DB.XYZ.BasisZ
            Dim sketchPlane As Autodesk.Revit.DB.SketchPlane = CreateSketchPlane(normal, Autodesk.Revit.DB.XYZ.Zero)

            Dim pnt1 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 0, 0)
            Dim pnt2 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(2, 0, 0)
            Dim pnt3 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(1, 1, 0)
            arr.Append(m_revit.Create.NewArc(pnt2, 1.0R, 0.0R, 180.0R, Autodesk.Revit.DB.XYZ.BasisX, Autodesk.Revit.DB.XYZ.BasisY))
            arr.Append(m_revit.Create.NewArc(pnt1, pnt3, pnt2))
            arrarr.Append(arr)
            Dim profile As SweepProfile = m_revit.Create.NewCurveLoopsProfile(arrarr)

            Dim pnt4 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(10, 0, 0)
            Dim pnt5 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 10, 0)
            Dim curve As Curve = m_revit.Create.NewLineBound(pnt4, pnt5)

            Dim curves As CurveArray = m_revit.Create.NewCurveArray()
            curves.Append(curve)
            '#End Region
            ' here create rectangular sweep
            Dim sweep1 As Sweep = m_creationFamily.NewSweep(True, curves, sketchPlane, profile, 0, ProfilePlaneLocation.Start)
            ' move to proper place
            Dim transPoint1 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(11, 0, 0)
            m_familyDocument.Move(sweep1, transPoint1)
        Catch e As Exception
            m_errCount += 1
            m_errorInfo += "Unexpected exceptions occur in CreateSweep: " & e.ToString() & vbCr & vbLf
        End Try
    End Sub

panhao1

放样
Private Sub CreateSweptBlend()
        Try
            '#Region "Create top and bottom profiles and path curve"
            Dim pnt1 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 0, 0)
            Dim pnt2 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(1, 0, 0)
            Dim pnt3 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(1, 1, 0)
            Dim pnt4 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 1, 0)
            Dim pnt5 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 0, 1)

            Dim arrarr1 As CurveArrArray = m_revit.Create.NewCurveArrArray()
            Dim arr1 As CurveArray = m_revit.Create.NewCurveArray()
            arr1.Append(m_revit.Create.NewLineBound(pnt1, pnt2))
            arr1.Append(m_revit.Create.NewLineBound(pnt2, pnt3))
            arr1.Append(m_revit.Create.NewLineBound(pnt3, pnt4))
            arr1.Append(m_revit.Create.NewLineBound(pnt4, pnt1))
            arrarr1.Append(arr1)

            Dim pnt6 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0.5, 0, 0)
            Dim pnt7 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(1, 0.5, 0)
            Dim pnt8 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0.5, 1, 0)
            Dim pnt9 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 0.5, 0)
            Dim arrarr2 As CurveArrArray = m_revit.Create.NewCurveArrArray()
            Dim arr2 As CurveArray = m_revit.Create.NewCurveArray()
            arr2.Append(m_revit.Create.NewLineBound(pnt6, pnt7))
            arr2.Append(m_revit.Create.NewLineBound(pnt7, pnt8))
            arr2.Append(m_revit.Create.NewLineBound(pnt8, pnt9))
            arr2.Append(m_revit.Create.NewLineBound(pnt9, pnt6))
            arrarr2.Append(arr2)

            Dim bottomProfile As SweepProfile = m_revit.Create.NewCurveLoopsProfile(arrarr1)
            Dim topProfile As SweepProfile = m_revit.Create.NewCurveLoopsProfile(arrarr2)

            Dim pnt10 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(5, 0, 0)
            Dim pnt11 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(0, 20, 0)
            Dim curve As Curve = m_revit.Create.NewLineBound(pnt10, pnt11)

            Dim normal As Autodesk.Revit.DB.XYZ = Autodesk.Revit.DB.XYZ.BasisZ
            Dim sketchPlane As Autodesk.Revit.DB.SketchPlane = CreateSketchPlane(normal, Autodesk.Revit.DB.XYZ.Zero)
            '#End Region
            ' here create rectangular sweep blend
            Dim newSweptBlend1 As SweptBlend = m_creationFamily.NewSweptBlend(True, curve, sketchPlane, bottomProfile, topProfile)
            ' move to proper place
            Dim transPoint1 As Autodesk.Revit.DB.XYZ = m_revit.Create.NewXYZ(11, 32, 0)
            m_familyDocument.Move(newSweptBlend1, transPoint1)
        Catch e As Exception
            m_errCount += 1
            m_errorInfo += "Unexpected exceptions occur in CreateSweptBlend: " & e.ToString() & vbCr & vbLf
        End Try
    End Sub

panhao1

其它函数两个
Private Function GetElement(Of T As Autodesk.Revit.DB.Element)(ByVal eid As Integer) As T
        Dim elementId As New Autodesk.Revit.DB.ElementId(eid)
        Return TryCast(m_familyDocument.Element(elementId), T)
    End Function


    Friend Function CreateSketchPlane(ByVal normal As Autodesk.Revit.DB.XYZ, ByVal origin As Autodesk.Revit.DB.XYZ) As Autodesk.Revit.DB.SketchPlane
        ' First create a Geometry.Plane which need in NewSketchPlane() method
        Dim geometryPlane As Autodesk.Revit.DB.Plane = m_revit.Create.NewPlane(normal, origin)
        If geometryPlane Is Nothing Then
            ' assert the creation is successful
            Throw New Exception("Create the geometry plane failed.")
        End If
        ' Then create a sketch plane using the Geometry.Plane
        Dim plane As Autodesk.Revit.DB.SketchPlane = m_creationFamily.NewSketchPlane(geometryPlane)
        ' throw exception if creation failed
        If plane Is Nothing Then
            Throw New Exception("Create the sketch plane failed.")
        End If
        Return plane
    End Function

maya88

啥意思，没看懂，请详细解释下。

元未觉醒1984

不错 学习了

eco

没看懂~~~~~~

huangchang0528

支持一个~~~~~~~~~~~~

wbrwbr2000

不熟悉revitapi的看不懂。。。

thinksong

围观学习中。。。

顾且果

【效率小额贷款】成立于2002年，拥有雄厚的资金，办理简单，低利息，免担保、操作明细。代办信用卡联系79711981 联系号码：13522264292