标题: Revit几何创建代码 [打印本页] 作者: panhao1 时间: 2010-9-24 17:52 标题: Revit几何创建代码 官网资源整理
调用库:
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 时间: 2010-9-24 17:53
挤出物体:
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 时间: 2010-9-24 17:54
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)
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 时间: 2010-9-24 17:55
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 时间: 2010-9-24 17:55
放样(单轴)
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 时间: 2010-9-24 17:56
放样
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 时间: 2010-9-24 17:57
其它函数两个
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 时间: 2010-9-25 20:55
啥意思,没看懂,请详细解释下。作者: 元未觉醒1984 时间: 2010-9-26 02:30
不错 学习了作者: eco 时间: 2010-9-26 09:10
没看懂~~~~~~作者: gzblake 时间: 2010-9-26 10:48
提示: 作者被禁止或删除 内容自动屏蔽作者: huangchang0528 时间: 2010-12-10 14:18
支持一个~~~~~~~~~~~~作者: wbrwbr2000 时间: 2010-12-10 21:34
不熟悉revitapi的看不懂。。。作者: thinksong 时间: 2011-12-31 08:09
围观学习中。。。作者: 顾且果 时间: 2012-3-1 08:46
【效率小额贷款】成立于2002年,拥有雄厚的资金,办理简单,低利息,免担保、操作明细。代办信用卡联系79711981 联系号码:13522264292