mirror of
https://github.com/jeremytammik/RevitSdkSamples.git
synced 2026-08-14 16:54:18 +00:00
813 lines
30 KiB
VB.net
813 lines
30 KiB
VB.net
#Region "Copyright"
|
|
''
|
|
'' (C) Copyright 2009-2010 by Autodesk, Inc.
|
|
''
|
|
'' Permission to use, copy, modify, and distribute this software in
|
|
'' object code form for any purpose and without fee is hereby granted,
|
|
'' provided that the above copyright notice appears in all copies and
|
|
'' that both that copyright notice and the limited warranty and
|
|
'' restricted rights notice below appear in all supporting
|
|
'' documentation.
|
|
''
|
|
'' AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
|
|
'' AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
|
|
'' MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
|
|
'' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
|
|
'' UNINTERRUPTED OR ERROR FREE.
|
|
''
|
|
'' Use, duplication, or disclosure by the U.S. Government is subject to
|
|
'' restrictions set forth in FAR 52.227-19 (Commercial Computer
|
|
'' Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
|
|
'' (Rights in Technical Data and Computer Software), as applicable.
|
|
''
|
|
'' Written by M.Harada
|
|
''
|
|
#End Region
|
|
|
|
#Region "Imports"
|
|
'' Import the following name spaces in the project properties/references.
|
|
'' Note: VB.NET has a slighly different way of recognizing name spaces than C#.
|
|
'' if you explicitely set them in each .vb file, you will need to specify full name spaces.
|
|
|
|
'Imports System.Linq '' this is in System.Core
|
|
'Imports Autodesk.Revit
|
|
'Imports Autodesk.Revit.DB
|
|
'Imports Autodesk.Revit.UI
|
|
'Imports Autodesk.Revit.ApplicationServices
|
|
|
|
#End Region
|
|
|
|
#Region "Description"
|
|
''' <summary>
|
|
''' Revit Family Creation API Lab - 2
|
|
'''
|
|
''' This command defines a column family, and creates a column family with a L-shape profile.
|
|
''' In order to define a L-shape profile, we will need additional reference plans, dimensions and parameters
|
|
'''
|
|
''' Objective:
|
|
''' ----------
|
|
'''
|
|
''' In the previous lab, we have learned the following:
|
|
'''
|
|
''' 0. set up family environment
|
|
''' 1. create a solid
|
|
''' 2. set alignment
|
|
''' 3. add types
|
|
'''
|
|
''' In this lab, we will learn the following:
|
|
'''
|
|
''' 4. add reference planes
|
|
''' 5. add parameters
|
|
''' 6. add dimensions
|
|
'''
|
|
''' To test this lab, open a family template "Metric Column.rft", and run a command.
|
|
'''
|
|
''' Context:
|
|
''' --------
|
|
'''
|
|
''' In the previous rfa lab (lab1), we have defined a column family, using a rectangle profile.
|
|
''' In this lab, we will modify the profile to L-shape like the follow sketch shows:
|
|
'''
|
|
''' 5 Tw 4
|
|
''' +-+
|
|
''' | | 3 h = height
|
|
''' Depth | +---+ 2
|
|
''' +-----+ Td
|
|
''' 0 1
|
|
''' 6 Width
|
|
'''
|
|
''' in addition to what we have learned in the first lab, we will do the following:
|
|
''' 1. add reference planes along (1) 2-3 and (2)3-4.
|
|
''' 2. add parameters, Tw and Td
|
|
''' 3. add dimensions and label with parameters Tw and Td
|
|
'''
|
|
''' Desclaimer: code in these labs is written for the purpose of learning the Revit family API.
|
|
''' In practice, there will be much room for performance and usability improvement.
|
|
''' For code readability, minimum error checking.
|
|
''' </summary>
|
|
#End Region
|
|
|
|
<Autodesk.Revit.Attributes.Transaction(Autodesk.Revit.Attributes.TransactionMode.Automatic)> _
|
|
<Autodesk.Revit.Attributes.Regeneration(Autodesk.Revit.Attributes.RegenerationOption.Automatic)> _
|
|
Public Class RvtCmd_FamilyCreateColumnLShape
|
|
Implements IExternalCommand
|
|
|
|
'' member variables for top level access to the Revit database
|
|
''
|
|
Dim _rvtApp As Application
|
|
Dim _rvtDoc As Document
|
|
|
|
'' command main
|
|
''
|
|
Public Function Execute( _
|
|
ByVal commandData As ExternalCommandData, _
|
|
ByRef message As String, _
|
|
ByVal elements As ElementSet) _
|
|
As Result _
|
|
Implements IExternalCommand.Execute
|
|
|
|
'' objects for the top level access
|
|
''
|
|
_rvtApp = commandData.Application.Application
|
|
_rvtDoc = commandData.Application.ActiveUIDocument.Document
|
|
|
|
'' (0) This command works in the context of family editor only.
|
|
'' We also check if the template is for an appropriate category if needed.
|
|
'' Here we use a Column(i.e., Metric Column.rft) template.
|
|
'' Although there is no specific checking about metric or imperial, our lab only works in metric for now.
|
|
''
|
|
If Not isRightTemplate(BuiltInCategory.OST_Columns) Then
|
|
MsgBox("Please open Metric Column.rft")
|
|
Return Result.Failed
|
|
End If
|
|
|
|
'' (1.1) add reference planes
|
|
addReferencePlanes()
|
|
|
|
'' (1.2) create a simple extrusion. This time we create a L-shape.
|
|
Dim pSolid As Extrusion = createSolid()
|
|
|
|
'' (2.1) add alignment
|
|
addAlignments(pSolid)
|
|
|
|
'' (3.1) add parameters
|
|
addParameters()
|
|
|
|
'' (3.2) add dimensions
|
|
addDimensions()
|
|
|
|
'' (3.3) add types
|
|
addTypes()
|
|
|
|
'' finally, return
|
|
Return Result.Succeeded
|
|
|
|
End Function
|
|
|
|
'' ============================================
|
|
'' (0) checks if we have a correct template
|
|
'' ============================================
|
|
Function isRightTemplate(ByVal targetCategory As BuiltInCategory) As Boolean
|
|
|
|
'' This command works in the context of family editor only.
|
|
''
|
|
If Not _rvtDoc.IsFamilyDocument Then
|
|
MsgBox("This command works only in the family editor.")
|
|
Return False
|
|
End If
|
|
|
|
'' Check the template for an appropriate category here if needed.
|
|
''
|
|
Dim cat As Category = _rvtDoc.Settings.Categories.Item(targetCategory)
|
|
If _rvtDoc.OwnerFamily Is Nothing Then
|
|
MsgBox("This command only works in the family context.")
|
|
Return False
|
|
End If
|
|
If Not cat.Id.Equals(_rvtDoc.OwnerFamily.FamilyCategory.Id) Then
|
|
MsgBox("Category of this family document does not match the context required by this command.")
|
|
Return False
|
|
End If
|
|
|
|
'' if we come here, we should have a right one.
|
|
Return True
|
|
|
|
End Function
|
|
|
|
'' ============================================
|
|
'' (1.1) add reference planes
|
|
'' ============================================
|
|
Sub addReferencePlanes()
|
|
|
|
''
|
|
'' we are defining a simple L-shaped profile like the following:
|
|
''
|
|
'' 5 tw 4
|
|
'' +-+
|
|
'' | | 3 h = height
|
|
'' d | +---+ 2
|
|
'' +-----+ td
|
|
'' 0 1
|
|
'' 6 w
|
|
''
|
|
''
|
|
'' we want to add ref planes along (1) 2-3 and (2)3-4.
|
|
'' Name them "OffsetH" and "OffsetV" respectively. (H for horizontal, V for vertical).
|
|
''
|
|
Dim tw As Double = mmToFeet(150) ' thickness added for Lab2. Hard-coding for simplicity.
|
|
Dim td As Double = mmToFeet(150)
|
|
|
|
''
|
|
'' (1) add a horizonal ref plane 2-3.
|
|
''
|
|
'' get a plan view
|
|
Dim pViewPlan As View = findElement(GetType(ViewPlan), "Lower Ref. Level")
|
|
|
|
'' we have predefined ref plane: Left/Right/Front/Back
|
|
'' get the ref plane at Front, which is aligned to line 2-3
|
|
Dim refFront As ReferencePlane = findElement(GetType(ReferencePlane), "Front")
|
|
|
|
'' get the bubble and free ends from front ref plane and offset by td.
|
|
''
|
|
Dim p1 As XYZ = refFront.BubbleEnd
|
|
Dim p2 As XYZ = refFront.FreeEnd
|
|
Dim pBubbleEnd As New XYZ(p1.X, p1.Y + td, p1.Z)
|
|
Dim pFreeEnd As New XYZ(p2.X, p2.Y + td, p2.Z)
|
|
|
|
'' create the new one
|
|
''
|
|
Dim refPlane As ReferencePlane = _rvtDoc.FamilyCreate.NewReferencePlane(pBubbleEnd, pFreeEnd, XYZ.BasisZ, pViewPlan)
|
|
refPlane.Name = "OffsetH"
|
|
|
|
''
|
|
'' (2) do the same to add a vertical ref plane.
|
|
''
|
|
|
|
'' find the ref plane at left, which is aligned to line 3-4
|
|
Dim refLeft As ReferencePlane = findElement(GetType(ReferencePlane), "Left")
|
|
|
|
'' get the bubble and free ends from front ref plane and offset by td.
|
|
''
|
|
p1 = refLeft.BubbleEnd
|
|
p2 = refLeft.FreeEnd
|
|
pBubbleEnd = New XYZ(p1.X + tw, p1.Y, p1.Z)
|
|
pFreeEnd = New XYZ(p2.X + tw, p2.Y, p2.Z)
|
|
|
|
'' create the new one
|
|
''
|
|
refPlane = _rvtDoc.FamilyCreate.NewReferencePlane(pBubbleEnd, pFreeEnd, XYZ.BasisZ, pViewPlan)
|
|
refPlane.Name = "OffsetV"
|
|
|
|
End Sub
|
|
|
|
'' ============================================
|
|
'' (1.2) create a simple solid by extrusion with L-shape profile
|
|
'' ============================================
|
|
Function createSolid() As Extrusion
|
|
|
|
''
|
|
'' (1) define a simple L-shape profile
|
|
''
|
|
'Dim pProflie As CurveArrArray = createBox()
|
|
Dim pProfile As CurveArrArray = createProfileLShape() '' Lab2
|
|
|
|
''
|
|
'' (2) create a sketch plane
|
|
''
|
|
'' we need to know the template. If you look at the template (Metric Column.rft) and "Front" view,
|
|
'' you will see "Reference Plane" at "Lower Ref. Level". We are going to create an extrusion there.
|
|
'' findElement() is a helper function that find an element of the given type and name. see below.
|
|
''
|
|
Dim pRefPlane As ReferencePlane = findElement(GetType(ReferencePlane), "Reference Plane") ' need to know from the template
|
|
Dim pSketchPlane As SketchPlane = _rvtDoc.FamilyCreate.NewSketchPlane(pRefPlane.Plane)
|
|
|
|
'' (3) height of the extrusion
|
|
''
|
|
'' same as profile, you will need to know your template. unlike UI, the alightment will not adjust the geometry.
|
|
'' You will need to have the exact location in order to set alignment.
|
|
'' Here we hard code for simplicity. 4000 is the distance between Lower and Upper Ref. Level.
|
|
'' as an exercise, try changing those values and see how it behaves.
|
|
''
|
|
Dim dHeight As Double = mmToFeet(4000) '' distance between Lower and Upper Ref Level.
|
|
|
|
'' (4) create an extrusion here. at this point. just an box, nothing else.
|
|
''
|
|
Dim bIsSolid As Boolean = True ' as oppose to void.
|
|
Dim pSolid As Extrusion = _rvtDoc.FamilyCreate.NewExtrusion(bIsSolid, pProfile, pSketchPlane, dHeight)
|
|
|
|
Return pSolid
|
|
|
|
End Function
|
|
|
|
'' ============================================
|
|
'' (1.2a) create a simple L-shaped profile
|
|
'' ============================================
|
|
Function createProfileLShape() As CurveArrArray
|
|
|
|
''
|
|
'' define a simple L-shaped profile
|
|
''
|
|
'' 5 tw 4
|
|
'' +-+
|
|
'' | | 3 h = height
|
|
'' d | +---+ 2
|
|
'' +-----+ td
|
|
'' 0 1
|
|
'' 6 w
|
|
''
|
|
|
|
'' sizes (hard coded for simplicity)
|
|
'' note: these need to match reference plane. otherwise, alignment won't work.
|
|
'' as an exercise, try changing those values and see how it behaves.
|
|
''
|
|
Dim w As Double = mmToFeet(600) '' those are hard coded for simplicity here. in practice, you may want to find out from the references)
|
|
Dim d As Double = mmToFeet(600)
|
|
Dim tw As Double = mmToFeet(150) '' thickness added for Lab2
|
|
Dim td As Double = mmToFeet(150)
|
|
|
|
'' define vertices
|
|
''
|
|
Const nVerts As Integer = 6 '' the number of vertices
|
|
Dim pts() As XYZ = {New XYZ(-w / 2, -d / 2, 0), New XYZ(w / 2, -d / 2, 0), New XYZ(w / 2, -d / 2 + td, 0), _
|
|
New XYZ(-w / 2 + tw, -d / 2 + td, 0), New XYZ(-w / 2 + tw, d / 2, 0), New XYZ(-w / 2, d / 2, 0), _
|
|
New XYZ(-w / 2, -d / 2, 0)} ' the last one is to make the loop simple
|
|
|
|
'' define a loop. define individual edges and put them in a curveArray
|
|
''
|
|
Dim pLoop As CurveArray = _rvtApp.Create.NewCurveArray
|
|
Dim lines(nVerts - 1) As Line
|
|
For i As Integer = 0 To nVerts - 1
|
|
lines(i) = _rvtApp.Create.NewLineBound(pts(i), pts(i + 1))
|
|
pLoop.Append(lines(i))
|
|
Next
|
|
|
|
'' then, put the loop in the curveArrArray as a profile
|
|
''
|
|
Dim pProfile As CurveArrArray = _rvtApp.Create.NewCurveArrArray
|
|
pProfile.Append(pLoop)
|
|
'' if we come here, we have a profile now.
|
|
|
|
Return pProfile
|
|
|
|
End Function
|
|
|
|
'' ============================================
|
|
'' (1.2b) create a simple rectangular profile
|
|
'' ============================================
|
|
Function createProfileRectangle() As CurveArrArray
|
|
|
|
''
|
|
'' define a simple rectangular profile
|
|
''
|
|
'' 3 2
|
|
'' +---+
|
|
'' | | d h = height
|
|
'' +---+
|
|
'' 0 1
|
|
'' 4 w
|
|
''
|
|
|
|
'' sizes (hard coded for simplicity)
|
|
'' note: these need to match reference plane. otherwise, alignment won't work.
|
|
'' as an exercise, try changing those values and see how it behaves.
|
|
''
|
|
Dim w As Double = mmToFeet(600) ' hard coded for simplicity here. in practice, you may want to find out from the references)
|
|
Dim d As Double = mmToFeet(600)
|
|
|
|
'' define vertices
|
|
''
|
|
Const nVerts As Integer = 4 '' the number of vertices
|
|
Dim pts() As XYZ = {New XYZ(-w / 2, -d / 2, 0), New XYZ(w / 2, -d / 2, 0), New XYZ(w / 2, d / 2, 0), New XYZ(-w / 2, d / 2, 0), New XYZ(-w / 2, -d / 2, 0)} ' the last one is to make the loop simple
|
|
|
|
'' define a loop. define individual edges and put them in a curveArray
|
|
''
|
|
Dim pLoop As CurveArray = _rvtApp.Create.NewCurveArray
|
|
Dim lines(nVerts - 1) As Line
|
|
For i As Integer = 0 To nVerts - 1
|
|
lines(i) = _rvtApp.Create.NewLineBound(pts(i), pts(i + 1))
|
|
pLoop.Append(lines(i))
|
|
Next
|
|
|
|
'' then, put the loop in the curveArrArray as a profile
|
|
''
|
|
Dim pProfile As CurveArrArray = _rvtApp.Create.NewCurveArrArray
|
|
pProfile.Append(pLoop)
|
|
'' if we come here, we have a profile now.
|
|
|
|
Return pProfile
|
|
|
|
End Function
|
|
|
|
'' ============================================
|
|
'' (2.1) add alignments
|
|
'' ============================================
|
|
Sub addAlignments(ByVal pBox As Extrusion)
|
|
|
|
''
|
|
'' (1) we want to constrain the upper face of the column to the "Upper Ref Level"
|
|
''
|
|
|
|
'' which direction are we looking at?
|
|
''
|
|
Dim pView As View = findElement(GetType(View), "Front")
|
|
|
|
'' find the upper ref level
|
|
'' findElement() is a helper function. see below.
|
|
''
|
|
Dim upperLevel As Level = findElement(GetType(Level), "Upper Ref Level")
|
|
Dim ref1 As Reference = upperLevel.PlaneReference
|
|
|
|
'' find the face of the box
|
|
'' findFace() is a helper function. see below.
|
|
''
|
|
Dim upperFace As PlanarFace = findFace(pBox, New XYZ(0, 0, 1)) ' find a face whose normal is z-up.
|
|
Dim ref2 As Reference = upperFace.Reference
|
|
|
|
'' create alignments
|
|
''
|
|
_rvtDoc.FamilyCreate.NewAlignment(pView, ref1, ref2)
|
|
|
|
''
|
|
'' (2) do the same for the lower level
|
|
''
|
|
|
|
'' find the lower ref level
|
|
'' findElement() is a helper function. see below.
|
|
''
|
|
Dim lowerLevel As Level = findElement(GetType(Level), "Lower Ref. Level")
|
|
Dim ref3 As Reference = lowerLevel.PlaneReference
|
|
|
|
'' find the face of the box
|
|
'' findFace() is a helper function. see below.
|
|
''
|
|
Dim lowerFace As PlanarFace = findFace(pBox, New XYZ(0, 0, -1)) ' find a face whose normal is z-down.
|
|
Dim ref4 As Reference = lowerFace.Reference
|
|
|
|
'' create alignments
|
|
''
|
|
_rvtDoc.FamilyCreate.NewAlignment(pView, ref3, ref4)
|
|
|
|
''
|
|
'' (3) same idea for the width and depth.
|
|
''
|
|
'' get the plan view
|
|
'' note: same name maybe used for different view types. either one should work.
|
|
Dim pViewPlan As View = findElement(GetType(ViewPlan), "Lower Ref. Level")
|
|
|
|
'' find reference planes
|
|
''
|
|
Dim refRight As ReferencePlane = findElement(GetType(ReferencePlane), "Right")
|
|
Dim refLeft As ReferencePlane = findElement(GetType(ReferencePlane), "Left")
|
|
Dim refFront As ReferencePlane = findElement(GetType(ReferencePlane), "Front")
|
|
Dim refBack As ReferencePlane = findElement(GetType(ReferencePlane), "Back")
|
|
Dim refOffsetV As ReferencePlane = findElement(GetType(ReferencePlane), "OffsetV") ' added for L-shape
|
|
Dim refOffsetH As ReferencePlane = findElement(GetType(ReferencePlane), "OffsetH") ' added for L-shape
|
|
|
|
|
|
'' find the face of the box
|
|
'' note: findFace needs to be enhanced for this as face normal is not enough to determine the face.
|
|
''
|
|
Dim faceRight As PlanarFace = findFace(pBox, New XYZ(1, 0, 0), refRight) ' modified for L-shape
|
|
Dim faceLeft As PlanarFace = findFace(pBox, New XYZ(-1, 0, 0))
|
|
Dim faceFront As PlanarFace = findFace(pBox, New XYZ(0, -1, 0))
|
|
Dim faceBack As PlanarFace = findFace(pBox, New XYZ(0, 1, 0), refBack) ' modified for L-shape
|
|
Dim faceOffsetV As PlanarFace = findFace(pBox, New XYZ(1, 0, 0), refOffsetV) ' added for L-shape
|
|
Dim faceOffsetH As PlanarFace = findFace(pBox, New XYZ(0, 1, 0), refOffsetH) ' added for L-shape
|
|
|
|
'' create alignments
|
|
''
|
|
_rvtDoc.FamilyCreate.NewAlignment(pViewPlan, refRight.Reference, faceRight.Reference)
|
|
_rvtDoc.FamilyCreate.NewAlignment(pViewPlan, refLeft.Reference, faceLeft.Reference)
|
|
_rvtDoc.FamilyCreate.NewAlignment(pViewPlan, refFront.Reference, faceFront.Reference)
|
|
_rvtDoc.FamilyCreate.NewAlignment(pViewPlan, refBack.Reference, faceBack.Reference)
|
|
_rvtDoc.FamilyCreate.NewAlignment(pViewPlan, refOffsetV.Reference, faceOffsetV.Reference)
|
|
_rvtDoc.FamilyCreate.NewAlignment(pViewPlan, refOffsetH.Reference, faceOffsetH.Reference)
|
|
|
|
|
|
End Sub
|
|
|
|
'' ============================================
|
|
'' (3.1) add parameters
|
|
'' ============================================
|
|
Sub addParameters()
|
|
|
|
'' parameter group for Dimension is PG_GEOMETRY in API
|
|
''
|
|
Dim paramTw As FamilyParameter = _rvtDoc.FamilyManager.AddParameter("Tw", BuiltInParameterGroup.PG_GEOMETRY, ParameterType.Length, False)
|
|
Dim paramTd As FamilyParameter = _rvtDoc.FamilyManager.AddParameter("Td", BuiltInParameterGroup.PG_GEOMETRY, ParameterType.Length, False)
|
|
|
|
'' give initial values
|
|
''
|
|
Dim tw As Double = mmToFeet(150.0) ' hard coded for simplicity
|
|
Dim td As Double = mmToFeet(150.0)
|
|
_rvtDoc.FamilyManager.Set(paramTw, tw)
|
|
_rvtDoc.FamilyManager.Set(paramTd, td)
|
|
|
|
End Sub
|
|
|
|
'' ============================================
|
|
'' (3.2) add dimensions
|
|
'' ============================================
|
|
Sub addDimensions()
|
|
|
|
'' find the plan view
|
|
''
|
|
Dim pViewPlan As View = findElement(GetType(ViewPlan), "Lower Ref. Level")
|
|
|
|
'' find reference planes
|
|
''
|
|
Dim refLeft As ReferencePlane = findElement(GetType(ReferencePlane), "Left")
|
|
Dim refFront As ReferencePlane = findElement(GetType(ReferencePlane), "Front")
|
|
Dim refOffsetV As ReferencePlane = findElement(GetType(ReferencePlane), "OffsetV") ' added for L-shape
|
|
Dim refOffsetH As ReferencePlane = findElement(GetType(ReferencePlane), "OffsetH") ' added for L-shape
|
|
|
|
''
|
|
'' (1) add dimension between the reference planes 'Left' and 'OffsetV', and label it as 'Tw
|
|
''
|
|
|
|
'' define a dimension line
|
|
''
|
|
Dim p0 As XYZ = refLeft.FreeEnd
|
|
Dim p1 As XYZ = refOffsetV.FreeEnd
|
|
Dim pLine As Line = _rvtApp.Create.NewLineBound(p0, p1)
|
|
|
|
'' define references
|
|
''
|
|
Dim pRefArray As New ReferenceArray
|
|
pRefArray.Append(refLeft.Reference)
|
|
pRefArray.Append(refOffsetV.Reference)
|
|
|
|
'' create a dimension
|
|
''
|
|
Dim pDimTw As Dimension = _rvtDoc.FamilyCreate.NewDimension(pViewPlan, pLine, pRefArray)
|
|
|
|
'' add label to the dimension
|
|
''
|
|
Dim paramTw As FamilyParameter = _rvtDoc.FamilyManager.Parameter("Tw")
|
|
pDimTw.Label = paramTw
|
|
|
|
''
|
|
'' (2) do the same for dimension between 'Front' and 'OffsetH', and lable it as 'Td
|
|
''
|
|
|
|
'' define a dimension line
|
|
''
|
|
p0 = refFront.FreeEnd
|
|
p1 = refOffsetH.FreeEnd
|
|
pLine = _rvtApp.Create.NewLineBound(p0, p1)
|
|
|
|
'' define references
|
|
''
|
|
pRefArray = New ReferenceArray
|
|
pRefArray.Append(refFront.Reference)
|
|
pRefArray.Append(refOffsetH.Reference)
|
|
|
|
'' create a dimension
|
|
''
|
|
Dim pDimTd As Dimension = _rvtDoc.FamilyCreate.NewDimension(pViewPlan, pLine, pRefArray)
|
|
|
|
'' add label to the dimension
|
|
''
|
|
Dim paramTd As FamilyParameter = _rvtDoc.FamilyManager.Parameter("Td")
|
|
pDimTd.Label = paramTd
|
|
|
|
End Sub
|
|
|
|
'' ============================================
|
|
'' (3.3) add types
|
|
'' ============================================
|
|
Sub addTypes()
|
|
|
|
'' addType(name, Width, Depth)
|
|
''
|
|
'addType("600x900", 600.0, 900.0)
|
|
'addType("1000x300", 1000.0, 300.0)
|
|
'addType("600x600", 600.0, 600.0)
|
|
|
|
'' addType(name, Width, Depth, Tw, Td)
|
|
''
|
|
addType("600x900", 600.0, 900.0, 150, 225)
|
|
addType("1000x300", 1000.0, 300.0, 250, 75)
|
|
addType("600x600", 600.0, 600.0, 150, 150)
|
|
|
|
End Sub
|
|
|
|
'' add one type (version 2)
|
|
''
|
|
Sub addType(ByVal name As String, ByVal w As Double, ByVal d As Double, ByVal tw As Double, ByVal td As Double)
|
|
|
|
'' get the family manager from the current doc
|
|
Dim pFamilyMgr As FamilyManager = _rvtDoc.FamilyManager
|
|
|
|
'' add new types with the given name
|
|
''
|
|
Dim type1 As FamilyType = pFamilyMgr.NewType(name)
|
|
|
|
'' look for 'Width' and 'Depth' parameters and set them to the given value
|
|
''
|
|
Dim paramW As FamilyParameter = pFamilyMgr.Parameter("Width")
|
|
Dim valW As Double = mmToFeet(w)
|
|
If paramW IsNot Nothing Then
|
|
pFamilyMgr.Set(paramW, valW)
|
|
End If
|
|
|
|
Dim paramD As FamilyParameter = pFamilyMgr.Parameter("Depth")
|
|
Dim valD As Double = mmToFeet(d)
|
|
If paramD IsNot Nothing Then
|
|
pFamilyMgr.Set(paramD, valD)
|
|
End If
|
|
|
|
'' let's set "Tw' and 'Td
|
|
''
|
|
Dim paramTw As FamilyParameter = pFamilyMgr.Parameter("Tw")
|
|
Dim valTw As Double = mmToFeet(tw)
|
|
If paramTw IsNot Nothing Then
|
|
pFamilyMgr.Set(paramTw, valTw)
|
|
End If
|
|
|
|
Dim paramTd As FamilyParameter = pFamilyMgr.Parameter("Td")
|
|
Dim valTd As Double = mmToFeet(td)
|
|
If paramTd IsNot Nothing Then
|
|
pFamilyMgr.Set(paramTd, valTd)
|
|
End If
|
|
|
|
End Sub
|
|
|
|
'' add one type (version 1)
|
|
''
|
|
Sub addType(ByVal name As String, ByVal w As Double, ByVal d As Double)
|
|
|
|
'' get the family manager from the current doc
|
|
Dim pFamilyMgr As FamilyManager = _rvtDoc.FamilyManager
|
|
|
|
'' add new types with the given name
|
|
''
|
|
Dim type1 As FamilyType = pFamilyMgr.NewType(name)
|
|
|
|
'' look for 'Width' and 'Depth' parameters and set them to the given value
|
|
''
|
|
'' first 'Width
|
|
''
|
|
Dim paramW As FamilyParameter = pFamilyMgr.Parameter("Width")
|
|
Dim valW As Double = mmToFeet(w)
|
|
If paramW IsNot Nothing Then
|
|
pFamilyMgr.Set(paramW, valW)
|
|
End If
|
|
|
|
'' same idea for 'Depth
|
|
''
|
|
Dim paramD As FamilyParameter = pFamilyMgr.Parameter("Depth")
|
|
Dim valD As Double = mmToFeet(d)
|
|
If paramD IsNot Nothing Then
|
|
pFamilyMgr.Set(paramD, valD)
|
|
End If
|
|
|
|
End Sub
|
|
''============================================
|
|
''
|
|
'' Helper functions
|
|
''
|
|
''============================================
|
|
#Region "Helper Functions"
|
|
|
|
'' ============================================
|
|
'' helper function: given a solid, find a planar face with
|
|
'' the given normal (version 2)
|
|
'' this is a slightly enhanced version which checks if the
|
|
'' face is on the given reference plane.
|
|
'' ============================================
|
|
Function findFace( _
|
|
ByVal pBox As Extrusion, _
|
|
ByVal normal As XYZ, _
|
|
ByVal refPlane As ReferencePlane _
|
|
) As PlanarFace
|
|
|
|
'' get the geometry object of the given element
|
|
''
|
|
Dim op As New Options
|
|
op.ComputeReferences = True
|
|
Dim geomObjs As GeometryObjectArray = pBox.Geometry(op).Objects
|
|
|
|
'' loop through the array and find a face with the given normal
|
|
''
|
|
For Each geomObj As GeometryObject In geomObjs
|
|
|
|
If TypeOf geomObj Is Solid Then '' solid is what we are interested in.
|
|
|
|
Dim pSolid As Solid = geomObj
|
|
Dim faces As FaceArray = pSolid.Faces
|
|
|
|
For Each pFace As Face In faces
|
|
Dim pPlanarFace As PlanarFace = pFace
|
|
If Not (pPlanarFace Is Nothing) Then
|
|
'' check to see if they have same normal
|
|
If pPlanarFace.Normal.IsAlmostEqualTo(normal) Then
|
|
|
|
'' additionally, we want to check if the face is on the reference plane
|
|
''
|
|
Dim p0 As XYZ = refPlane.BubbleEnd
|
|
Dim p1 As XYZ = refPlane.FreeEnd
|
|
Dim pCurve As Line = _rvtApp.Create.NewLineBound(p0, p1)
|
|
Dim res As SetComparisonResult = pPlanarFace.Intersect(pCurve)
|
|
If res = SetComparisonResult.Subset Then
|
|
Return (pPlanarFace) '' we found the face
|
|
End If
|
|
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
ElseIf TypeOf geomObj Is GeometryInstance Then
|
|
|
|
'' will come back later as needed.
|
|
|
|
ElseIf TypeOf geomObj Is Curve Then
|
|
|
|
'' will come nack later as needed.
|
|
|
|
ElseIf TypeOf geomObj Is Mesh Then
|
|
|
|
'' will come back later as needed.
|
|
|
|
Else
|
|
'' what else do we have?
|
|
|
|
End If
|
|
Next
|
|
|
|
'' if we come here, we did not find any.
|
|
Return Nothing
|
|
|
|
End Function
|
|
|
|
'' ============================================
|
|
'' helper function: find a planar face with the given normal (version 1)
|
|
'' this only work with a simple rectangilar box.
|
|
'' ============================================
|
|
Function findFace(ByVal pBox As Extrusion, ByVal normal As XYZ) As PlanarFace
|
|
|
|
'' get the geometry object of the given element
|
|
''
|
|
Dim op As New Options
|
|
op.ComputeReferences = True
|
|
Dim geomObjs As GeometryObjectArray = pBox.Geometry(op).Objects
|
|
|
|
'' loop through the array and find a face with the given normal
|
|
''
|
|
For Each geomObj As GeometryObject In geomObjs
|
|
|
|
If TypeOf geomObj Is Solid Then '' solid is what we are interested in.
|
|
|
|
Dim pSolid As Solid = geomObj
|
|
Dim faces As FaceArray = pSolid.Faces
|
|
|
|
For Each pFace As Face In faces
|
|
Dim pPlanarFace As PlanarFace = pFace
|
|
If Not (pPlanarFace Is Nothing) Then
|
|
If pPlanarFace.Normal.IsAlmostEqualTo(normal) Then '' we found the face
|
|
Return (pPlanarFace)
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
ElseIf TypeOf geomObj Is GeometryInstance Then
|
|
|
|
'' will come back later as needed.
|
|
|
|
ElseIf TypeOf geomObj Is Curve Then
|
|
|
|
'' will come nack later as needed.
|
|
|
|
ElseIf TypeOf geomObj Is Mesh Then
|
|
|
|
'' will come back later as needed.
|
|
|
|
Else
|
|
'' what else do we have?
|
|
|
|
End If
|
|
Next
|
|
|
|
'' if we come here, we did not find any.
|
|
Return Nothing
|
|
|
|
End Function
|
|
|
|
'' ============================================
|
|
'' helper function: find an element of the given type and the name.
|
|
'' You can use this, for example, to find Reference or Level with the given name.
|
|
'' ============================================
|
|
Function findElement(ByVal targetType As Type, ByVal targetName As String) As Element
|
|
|
|
'' get the elements of the given type
|
|
''
|
|
Dim collector = New FilteredElementCollector(_rvtDoc)
|
|
collector.WherePasses(New ElementClassFilter(targetType))
|
|
|
|
'' parse the collection for the given name
|
|
'' using LINQ query here.
|
|
''
|
|
Dim targetElems = From element In collector Where element.Name.Equals(targetName) Select element
|
|
Dim elems As List(Of Element) = targetElems.ToList()
|
|
|
|
If elems.Count > 0 Then '' we should have only one with the given name.
|
|
Return elems(0)
|
|
End If
|
|
|
|
'' cannot find it.
|
|
Return Nothing
|
|
|
|
End Function
|
|
|
|
'' ============================================
|
|
'' convert millimeter to feet
|
|
'' ============================================
|
|
Function mmToFeet(ByVal mmVal As Double) As Double
|
|
|
|
Return mmVal / 304.8 '' * 0.00328;
|
|
|
|
End Function
|
|
|
|
#End Region
|
|
|
|
End Class
|