建築部材・設備部材のIFCデータ生成用サンプルプログラム

処理内容
IFC2x3に準拠し、案件、敷地、建物、階を各1と建築部材、設備部材を複数作る

利用環境
1) Microsoft Excel 2010
2) Secom IFCsvrR300

参考文献
1) IFCについては「IFC2x3仕様書」など
2) ExcelおよびVBAについては市販の参考書など
3) IFCsvrR300については付属のマニュアルなど

注意事項
1) エラー処理は省略
2) 要部のみを記載しているため、必要応じて適宜詳細を追加する
3) str(文字)やval(数字)、i(配列要素指定数)、条件式などには適切な値を設定する
4) アトリビュートにOPTIONALの記載があるものは、IFCの仕様上では設定は必須ではないが、まれに仕様外の合意によって必須とされるものがある
5) 【本体】のクラスから【派生】のクラスがある場合、本体のクラスを作る→アトリビュートに派生のクラスを作る→本体のクラスのアトリビュートから派生のクラスを取得する、という方法を記載しているが、派生のクラスを取得できない場合には、本体のクラスを作る→派生のクラスを作る→本体のクラスのアトリビュートに派生のクラスを設定する、という方法で回避する

'--------------------------------------------------------------------------------
'■■■■■■■■■■
'変数を宣言する
'■■■■■■■■■■
Option Explicit

'■■■■■■■■■■
'主処理:モデル(IFCデータ)を作る
'■■■■■■■■■■
Sub MakeIfcModel()
    
'IFCデータを扱うオブジェクトを作る
    Dim objIFCsvr As Object
    Set objIFCsvr = CreateObject("IFCsvr.R300")

'IFCデータを作る
    Dim objDesign As Object
    Set objDesign = objIFCsvr.NewDesign(str, "ifc2x3") 'str:ファイル名

'案件を作る
    Dim objProject As IFCsvr.Entity
    Set objProject = objDesign.Add("IfcProject")
'↑objDesign.Add(クラス名)はインスタンスを作るために多用される構文
    Call SetProject(objProject)
'案件と敷地を関連付ける
    Dim objRelAggregates As IFCsvr.Entity
    Set objRelAggregates = objDesign.Add("IfcRelAggregates")
    Call SetRelAggregates(objRelAggregates, objProject)

'敷地を作る
    Dim objSite As IFCsvr.Entity
    Set objSite = objDesign.Add("IfcSite")
    Call SetSite(objSite)
'案件と敷地を関連付ける
    Call AddRelAggregates(objRelAggregates, objSite)
'敷地と建物を関連付ける
    'Dim objRelAggregates As IFCsvr.Entity
    Set objRelAggregates = objDesign.Add("IfcRelAggregates")
    Call SetRelAggregates(objAggregates, objSite)

'建物を作る
    Dim objBuilding As IFCsvr.Entity
    Set objBuilding = objDesign.Add("IfcBuilding")
    Call SetBuilding(objBuilding)
'敷地と建物を関連付ける
    Call AddRelAggregates(objRelAggregates, objBuilding)
'建物と階を関連付ける
    'Dim objRelAggregates As IFCsvr.Entity
    Set objRelAggregates = objDesign.Add("IfcRelAggregates")
    Call SetRelAggregates(objAggregates, objBuilding)

'階を作る
    Dim objBuildingStorey As IFCsvr.Entity
    Set objBuildingStorey = objDesign.Add("IfcBuildingStorey")
    Call SetBuildingStorey(objBuildingStorey)
'建物と階を関連付ける
    Call AddRelAggregates(objRelAggregates, objBuildingStorey)
'階と部材を関連付ける (!関連付けの要素が変わる)
    Dim objRelContainedInSpatialStructure
    Set objRelContainedInSpatialStructure = objDesign.Add("IfcRelContainedInSpatialStructure")
    Call SetRelContainedInSS(objRelContainedInSpatialStructure, objBuildingStorey)

Do
'建築部材を作る
    Dim objBuildingElement As IFCsvr.Entity
   Set objBuildingElement = objDesign.Add("IfcBuildingElement")
'↑IfcBuildingElementは抽象クラスなので、実際にはIfcBeam(梁)、IfcColumn(柱)などのクラスを使う
   Call SetBuildingElement(objBuildingElement)
'階と部材を関連付ける
    Call AddRelContainedInSS(objRelContainedInSpatialStructure, objBuildingElement)
If条件式then Exit Do
Loop

Do
'設備部材を作る
    Dim objDistributionFlowElement As IFCsvr.Entity
    Set objDistributionFlowElement = objDesign.Add("IfcDistributionFlowElement")
'↑IfcDistributionFlowElementは抽象クラスなので、実際にはIfcFlowSegment(直管)などのクラスを使う
    Call SetDistributionFlowElement(objDistributionFlowElement)
'階と部材を関連付ける
    Call AddRelContainedInSS(objRelContainedInSpatialStructure, objDistributionFlowElemen)
'プロパティセットを作る
    Dim objPropertySet As IFCsvr.Entity
    Set objPropertySet = objDesign.Add("IfcPropertySet")
'プロパティセットと設備部材を関連付ける
    Dim objRelDefinesByProperties As IFCsvr.Entity
    Set objRelDefinesByProperties = objDesign.Add("IfcRelDefinesByProperties")
    Call SetRelDefinesByProperties(objRelDefinesByProperties, objPropertySet)
    Call AddRelDefinesByProperties(objRelDefinesByProperties, objDistributionFlowElement)
If条件式then Exit Do
Loop

Do
'開口を作る
    Dim objOpeningElement As IFCsvr.Entity
   Set objOpeningElement = objDesign.Add("IfcOpenigElement")
'↑開口のクラスの中から、ここではIfcOpenigElementを使う
    Call SetOpeningElement(objOpeningElement)
'部材と開口を関連付ける(建築部材に設備部材を挿入する場合を想定)
    Dim objRelVoidsElement As IFCsvr.Entity
    Set objRelVoidsElement = objDesign.Add("IfcRelVoidsElement")
    Call SetRelVoidsElement(objRelVoidsElement, objBuildingElement)
    Call AddRelVoidsElement(objRelVoidsElement, objOpeningElement)
    Dim objRelFillsElement As IFCsvr.Entity
    Set objRelFillsElement = objDesign.Add("IfcRelFillsElement")
    Call SetRelFillsElement(objRelFillsElement, objOpeningElement)
    Call AddRelFillsElement(objRelFillsElement, objDistributionFlowElement)
If条件式then Exit Do
Loop

'IFCデータを保存する
    objDesign.Save

'変数を開放する
    Set objIFCsvr = Nothing
    Set objDesign = Nothing
    Set objProject = Nothing
    '以下略

End Sub

'--------------------------------------------------------------------------------
'■■■■■■■■■■
'案件を作る
'■■■■■■■■■■
Sub SetProject(objProject As IFCsvr.Entity)
'クラス構造
'IfcRoot*(*は抽象クラスや選択クラスなど、実際には下位のクラスが使われるクラスを示す)
'└IfcObjectDifinition*
'  └IfcObject*
'    └IfcProject
With objProject
'【本体】
'IfcRoot由来
    .Attributes("GlobalId").Value = objIFCsvr.EncodeBase64(objIFCsvr.GenGUID()) 'IIfcGloballyUniqueId
'↑Attributes(アトリビュート名)はアトリビュートを設定・参照するために多用される構文
    .Attributes("OwnerHistory").Value = objDesign.Add("IfcOwnerHistory") '所有履歴
.Attributes("Name").Value = str 'OPTIONAL/IfcLabel/名称
    .Attributes("Description").Value = str 'OPTIONAL/IfcText/説明
'IfcObject由来
    .Attributes("ObjectType").Value = str 'OPTIONAL/IfcLabel/区分
'IfcProject 
    .Attributes("LongName").Value = str 'OPTIONAL/IfcLabel/詳細名称
    .Attributes("Phase").Value = str 'OPTIONAL/IfcLabel/段階
    Boolresult = .Attributes("RepresentationContexts").AddItem(objDesign.Add("IfcRepresentationContext")) 
'SET [1:?](1以上)/表現背景
'↑IfcRepresentationContextは抽象クラスなので、実際にはIfcGeometricRepresentationContextを使う
    .Attributes("UnitsInContext").Value = objDesign.Add("IfcUnitAssignment") '単位背景
'【派生】
'所有履歴
    Dim objOwnerHistory As IFCsvr.Entity
    Set objOwnerHistory = .Attributes("OwnerHistory").Value
    Call SetOwnerHistory(objOwnerHistory)
'表現背景
    Dim objGeometricRepresentationContext As IFCsvr.Entity
    Set objGeometricRepresentationContext = .Attributes("RepresentationContexts").Value.Item(i)
    Call SetGeometricRepresentationContext(objGeometricRepresentationContext)
'単位背景
    Dim objUnitAssignment As IFCsvr.Entity
    Set objUnitAssignment = .Attributes("UnitsInContext").Value
    Call SetUnitAssignment(objUnitAssignment)
End With
End Sub

'■■■■■■■■■■
'敷地を作る
'■■■■■■■■■■
Sub SetSite(objSite As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcObjectDifinition*
'  └IfcObject*
'    └IfcProduct*
'      └IfcSpatialStructureElement*
'        └IfcSite,IfcBuilding,IfcBuildingStorey,他
With objSite
'【本体】
'IfcRoot由来
    '略
'IfcObject由来
    '略
'IfcProduct由来
    .Attributes("ObjectPlacement").Value = objDesign.Add("IfcObjectPlacement") 'OPTIONAL/位置
'↑IfcObjectPlacementは抽象クラスなので、実際にはIfcLocalPlacementなどのクラスを使う
    .Attributes("Representation").Value = objDesign.Add("IfcProductRepresentation") 'OPTIONAL/形状表現
'↑IfcProductRepresentationは抽象クラスなので、実際にはIfcProductDefinitionShapeなどのクラスを使う
'IfcSpatialStructureElement由来
    .Attributes("LongName").Value = str 'OPTIONAL/IfcLabel/詳細名称
    .Attributes("CompositionType").Value = str 'IfcElementCompositionEnum(COMPLEX,ELEMENT,PARTIAL)
'IfcSite
'↓北緯、西経、海抜高さは敷地の原点を地球上で特定するもので、敷地自体の原点は(0,0,0)とする
    Boolresult = .Attributes("RefLatitude").AddItem(val)
'OPTIONAL/IfcCompoundPlaneAngleMeasure(LIST [3:4](3以上4以下) OF INTEGER)/北緯(度)
    Boolresult = .Attributes("RefLatitude").AddItem(val) '同上/北緯(分)
    Boolresult = .Attributes("RefLatitude").AddItem(val) '同上/北緯(秒)
    Boolresult = .Attributes("RefLatitude").AddItem(val) '同上/北緯(百万分の1秒) 
    Boolresult = .Attributes("RefLongitude").AddItem(val)
'OPTIONAL/IfcCompoundPlaneAngleMeasure(LIST [3:4] OF INTEGER)/西経(度)
    Boolresult = .Attributes("RefLongitude").AddItem(val) '同上/西経(分)
    Boolresult = .Attributes("RefLongitude").AddItem(val) '同上/西経(秒)
    Boolresult = .Attributes("RefLongitude").AddItem(val) '同上/西経(百万分の1秒)
    .Attributes("RefElevation").Value = val 'OPTIONAL/IfcLengthMeasure/海抜高さ
    .Attributes("LandTitleNumber").Value = str 'OPTIONAL/IfcLabel/地域番号(郵便番号)
    .Attributes("SiteAddress").Value = objDesign.Add("IfcAddress") 'OPTIONAL/住所
'↑IfcAddressは抽象クラスなので、実際にはIfcPostalAddressなどのクラスを使う
'【派生】
'所有履歴
    '略
'位置
    Dim objLocalPlacement As IFCsvr.Entity
    Set objLocalPlacement = .Attributes("ObjectPlacement").Value
    Call SetLocalPlacement(objLocalPlacement)
'形状表現
    Dim objProductDefinitionShape As IFCsvr.Entity
    Set objProductDefinitionShape = .Attributes("Representation").Value
    Call SetProductDefinitionShape(objProductDefinitionShape) '→「形状を作る」へ
'住所
    Dim objPostalAddress As IFCsvr.Entity
    Set objPostalAddress =.Attributes("SiteAddress").Value
    Call SetPostalAddress(objPostalAddress)
End With
End Sub

'■■■■■■■■■■
'建物を作る
'■■■■■■■■■■
Sub SetBuilding(objBuilding As IFCsvr.Entity)
With objBuilding
'【本体】
'IfcRoot由来
    '略
'IfcObject由来
    '略
'IfcProduct由来
    '略
'IfcSpatialStructureElement由来
    '略
'IfcBuilding
    .Attributes("ElevationOfRefHeight").Value = val 'OPTIONAL/IfcLengthMeasure/GL
    .Attributes("ElevationOfTerrain").Value = val 'OPTIONAL/IfcLengthMeasure/敷地高さ
    .Attributes("BuildingAddress").Value = objDesign.Add("IfcPostalAddress") 'OPTIONAL/住所
'【派生】
'所有履歴
    '略
'座標系
    '略
'形状表現
    '略
'住所
    '略
End With
End Sub

'■■■■■■■■■■
'階を作る
'■■■■■■■■■■
Sub SetBuildingStorey(objBuildingStorey As IFCsvr.Entity)
With objBuildingStorey
'【本体】
'IfcRoot由来
    '略
'IfcObject由来
    '略
'IfcProduct由来
    '略
'IfcSpatialStructureElement由来
    '略
'IfcBuildingStorey
    .Attributes("Elevation").Value = str 'OPTIONAL/IfcLengthMeasure/GLからの高さ
'【派生】
'所有履歴
    '略
'座標系
    '略
'形状表現
    '略
End With
End Sub

'■■■■■■■■■■
'建築部材を作る
'■■■■■■■■■■
Sub SetBuildingElement(objBuildingElement As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcObjectDifinition*
'  └IfcObject*
'    └IfcProduct*
'      └IfcElement*
'        └IfcBuildingElement*
'          └IfcColumn,IfcBeam,IfcSlab,IfcWall,IfcWindow,IfcDoor,IfcPlate,IfcFooting,他
With objBuildingElement
'【本体】
'IfcRoot由来
    '略
'IfcObject由来
    '略
'IfcProduct由来
    '略
'IfcElement由来
    .Attributes("Tag").Value = str 'OPTIONAL/IfcIdentifier
'↑上記の他、例えば下記のように、要素によって個別のアトリビュートが追加される
Select Case 要素
Case IfcSlab '床
    .Attributes("PredefinedType").Value = str
'OPTIONAL/IfcSlabTypeEnum(FLOOR,ROOF,LANDING,BASESLAB,USERDEFINED,NOTDEFINED)
Case IfcCovering '天井
    .Attributes("PredefinedType").Value = str
'OPTIONAL/IfcCoveringTypeEnum(CEILING,FLOORING,CLADDING,ROOFING,INSULATION,MEMBRANE,SLEEVING,WRAPPING,USERDEFINED,NOTDEFINED)
Case IfcWindow,IfcDoor '窓またはドア
    .Attributes("OverallHeight").Value = val 'OPTIONAL/IfcPositiveLengthMeasure/高さ
    .Attributes("OverallWidth").Value = val 'OPTIONAL/IfcPositiveLengthMeasure/巾
Case IfcFooting '基礎
    .Attributes("PredefinedType").Value = str
'IfcFootingTypeEnum(FOOTING_BEAM,PAD_FOOTING,PILE_CAP,STRIP_FOOTING,USERDEFINED,NOTDEFINED)
Case 以下略
End Select
'【派生】
'所有履歴
    '略
'座標
    '略
'形状表現
    '略
End With
End Sub

'■■■■■■■■■■
'設備部材を作る
'■■■■■■■■■■
Sub SetDistributionFlowElement (objDistributionFlowElement As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcObjectDifinition*
'  └IfcObject*
'    └IfcProduct*
'      └IfcElement*
'        └IfcDistributionElement*
'          └IfcDistributionFlowElement*
'            └IfcFlowTerminal,IfcFlowSegment,IfcFlowFitting,IfcFlowController,IfcFlowMovindDevice,他
With objDistributionFlowElement
'【本体】
'↓建築部材とほぼ同じ
'IfcRoot由来
    '略
'IfcObject由来
    '略
'IfcProduct由来
    '略
'IfcElement由来
    '略
'【派生】
'所有履歴
    '略
'座標系
    '略
'形状
    '略
End With
End Sub

'■■■■■■■■■■
'開口を作る
'■■■■■■■■■■
Sub SetOpeningElement(objOpeningElement As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcObjectDifinition*
'  └IfcObject*
'    └IfcProduct*
'      └IfcElement*
'        └IfcFeatureElement*
'          └IfcFeatureElementSubtraction*
'            └IfcOpeningElement
With objOpeningElement
'【本体】
'↓建築部材とほぼ同じ
'IfcRoot由来
    '略
'IfcObject由来
    '略
'IfcProduct由来
    '略
'IfcElement由来
    '略
'【派生】
'所有履歴
    '略
'座標
    '略
'形状表現
    '略
End With
End Sub

'--------------------------------------------------------------------------------
'■■■■■■■■■■
'プロパティセットを作る
'■■■■■■■■■■
Sub SetPropertySet(objPropertySet As As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcPropertyDefinition*
'  └IfcPropertySetDefinition*
'    └IfcPropertySet
With objPropertySet
'【本体】
'IfcRoot由来
    '略
'IfcPropertySet
    Boolresult = .Attributes("HasProperties").AddItem(objDesign.Add("IfcProperty")) 'LIST [1:?]
'↑IfcPropertyは抽象クラスなので、実際にはIfcPropertySingleValueなどのクラスを使う
'【派生】
'所有履歴
    '略
'プロパティ
    Dim objPropertySingleValue As IFCsvr.Entity
    Set objPropertySingleValue =.Attributes("IfcPropertySingleValue").Value
    Call SetPropertySingleValue(objPropertySingleValue)
End With
End Sub

'■■■■■■■■■■
'プロパティを作る
'■■■■■■■■■■
Sub SetPropertySingleValue(objPropertySingleValue As IFCsvr.Entity)
'クラス構造
'IfcProperty*
'└IfcSimpleProperty*
'  └IfcPropertySingleValue,IfcPropertyListValue,IfcPropertyTableValue,他
With objPropertySingleValue
'【本体】
'IfcProperty由来
    .Attributes("Name").Value = str 'IfcIdentifier/名称
    .Attributes("Description").Value = str 'OPTIONAL/IfcText/説明
'IfcPropertySingleValue
    Boolresult = .Attributes("NominalValue").SetSelectValue(str, "IfcText") '値/文字の場合
    .Attributes("Unit").Value = objDesign.Add("IfcUnit") 'OPTIONAL/単位
'【派生】
'単位
    '略
End With
End Sub

'--------------------------------------------------------------------------------
'■■■■■■■■■■
'関連付けを作る(IfcProjectとIfcSpatialStructureElement間)
'■■■■■■■■■■
Sub SetRelAggregates(objRelAggregates As IFCsvr.Entity,objRelating As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcRelationship*
'  └IfcRelDecomposes*
'    └IfcRelAggregates
With objRelAggregates
'【本体】
'IfcRoot由来
    '略
'IfcRelDecomposes由来
    .Attributes("RelatingObject").Value = objRelating 'IfcObjectDefinition/親
    'Boolresult = .Attributes("RelatedObjects").AddItem(objRelated) 'SET [1:?] OF IfcObjectDefinition /子
'【派生】
'所有履歴
    '略
End With
End Sub

Sub AddRelAggregates(objRelAggregates As IFCsvr.Entity,objRelated As IFCsvr.Entity)
With objRelAggregates
    '.Attributes("RelatingObject").Value = objRelating '親
    Boolresult = .Attributes("RelatedObjects").AddItem(objRelated) 'SET [1:?]/子
End With
End Sub

'■■■■■■■■■■
'関連付けを作る(IfcSpatialStructureElementとIfcProduct間)
'■■■■■■■■■■
Sub SetRelContainedInSS(objRelContainedInSpatialStructure As IFCsvr.Entity,objRelating As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcRelationship*
'  └IfcRelConnects*
'    └IfcRelContainedInSpatialStructure
With objRelContainedInSpatialStructure
'【本体】
'IfcRoot由来
    '略
'IfcRelContainedInSpatialStructure
    'Boolresult = .Attributes("RelatedElements").AddItem(objRelated) 'SET [1:?] OF IfcProduct/子
    .Attributes("RelatingStructure").Value = objRelating
'IfcSpatialStructureElement(ONEOF(IfcSite,IfcBuilding,IfcBuildingStorey,IfcSpace))/親
'【派生】
'所有履歴
    '略
End With
End Sub

Sub AddRelContainedInSS(objRelContainedInSpatialStructure As IFCsvr.Entity, objRelated As IFCsvr.Entity)
With objRelContainedInSpatialStructure
    Boolresult = .Attributes("RelatedElements").AddItem(objRelated) 'SET [1:?] OF IfcProduct/子
    '.Attributes("RelatingStructure").Value = objRelating
End With
End Sub

'■■■■■■■■■■
'関連付けを作る(IfcElementとIfcOpeningElement間、部材に開口を挿入する)
'■■■■■■■■■■
Sub SetRelVoidsElement(objRelVoidsElement As IFCsvr.Entity,objRelating As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcRelationship*
'  └IfcRelConnects*
'    └IfcRelVoidsElement
With objRelVoidsElement
'【本体】
'IfcRoot由来
    '略
'IfcRelVoidsElement
    .Attributes("RelatingBuildingElement").Value = objRelating 'IfcElement/親
    'Boolresult = .Attributes("RelatedOpeningElement").AddItem(objRelated) 
'SET [1:?] OF IfcFeatureElementSubtraction /子
'【派生】
'所有履歴
    '略
End With
End Sub

Sub AddRelVoidsElement(objRelVoidsElement As IFCsvr.Entity,objRelated As IFCsvr.Entity)
With objRelRelVoidsElement
    '.Attributes("RelatingBuildingElement").Value = objRelating 'IfcElement/親
    Boolresult = .Attributes("RelatedOpeningElement").AddItem(objRelated) 'IfcFeatureElementSubtraction /子
End With
End Sub

'■■■■■■■■■■
'関連付けを作る(IfcOpeningElementとIfcElement間、開口に部材を挿入する)
'■■■■■■■■■■
Sub SetRelFillsElement(objRelFillsElement As IFCsvr.Entity,objRelating As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcRelationship*
'  └IfcRelConnects*
'    └IfcRelFillsElement
With objRelFillsElement
'【本体】
'IfcRoot由来
    '略
'IfcRelFillsElement
    .Attributes("RelatingOpeningElement").Value = objRelating 'IfcOpeningElement/親
    'Boolresult = .Attributes("RelatedBuildingElement").AddItem(objRelated) 'IfcElement/子
'【派生】
'所有履歴
    '略
End With
End Sub

Sub AddRelFillsElement(objRelFillsElement As IFCsvr.Entity,objRelated As IFCsvr.Entity)
With objRelFillsElement
    '.Attributes("RelatingOpeningElement").Value = objRelating 'IfcOpeningElement/親
    Boolresult = .Attributes("RelatedBuildingElement").AddItem(objRelated) 'IfcElement/子
End With
End Sub

'■■■■■■■■■■
'関連付けを作る(IfcObject-IfcPropertySet)
'■■■■■■■■■■
Sub SetRelDefinesByProperties(objRelDefinesByProperties As IFCsvr.Entity,objRelating As IFCsvr.Entity)
'クラス構造
'IfcRoot*
'└IfcRelationship*
'  └IfcRelDefines*
'    └IfcRelDefinesByProperties,IfcRelDefinesByType
With objRelDefinesByProperties
'【本体】
'IfcRoot由来
    '略
'IfcRelDefines由来
    'Boolresult = .Attributes("RelatedObjects").AddItem(objRelated) 'SET [1:?] OF IfcObject/子
'IfcRelDefinesByProperties
    .Attributes("RelatingPropertyDefinition").Value = objRelating 'IfcPropertySetDefinition/親
'【派生】
'所有履歴
    '略
End With
End Sub

Sub AddRelDefinesByProperties(objRelDefinesByProperties As IFCsvr,objRelated As IFCsvr.Entity)
With objRelDefinesByProperties
'IfcRelDefines由来
    Boolresult = .Attributes("RelatedObjects").AddItem(objRelated) 'SET [1:?] OF IfcObject/子
'IfcRelDefinesByProperties
    '.Attributes("RelatingPropertyDefinition").Value = objRelating 'IfcPropertySetDefinition/親
End With
End Sub

'--------------------------------------------------------------------------------
'■■■■■■■■■■
'所有履歴を作る
'■■■■■■■■■■
Sub SetOwnerHistory(objOwnerHistory As IFCsvr.Entity)
With objOwnerHistory
'【本体】
'IfcOwnerHistory
    .Attributes("OwningUser").Value = objDesign.Add("IfcPersonAndOrganization")'人と組織
    .Attributes("OwningApplication").Value = objDesign.Add("IfcApplication") 'アプリケーション
    .Attributes("State").Value = str 
'OPTIONAL/IfcStateEnum(READWRITE,READONLY,LOCKED,READWRITELOCKED,READONLYLOCKED)
    .Attributes("ChangeAction").Value = str
'IfcChangeActionEnum(NOCHANGE,MODIFIED,ADDED,DELETED,MODIFIEDADDED,MODIFIEDDELETED)
    .Attributes("LastModifiedDate").Value = objIFCsvr.GetUTCSecond()'OPTIONAL/IfcTimeStamp(INTEGER)
    .Attributes("LastModifyingUser").Value = objDesign.Add("IfcPersonAndOrganization")
'OPTIONAL/人と組織
    .Attributes("LastModifyingApplication").Value = objDesign.Add("IfcApplication")
'OPTIONAL/アプリケーション
    .Attributes("CreationDate").Value = objIFCsvr.GetUTCSecond() 'IfcTimeStamp(INTEGER)
End With
'【派生】
'人と組織
    Dim objPersonAndOrganization As IFCsvr.Entity
    Set objPersonAndOrganization = .Attributes("OwningUser").Value
    Call SetPersonAndOrganization(objPersonAndOrganization)
'アプリケーション
    Dim objApplication As IFCsvr.Entity
    Set objApplication = .Attributes("OwningApplication").Value
    Call SetApplication(objApplication)
End With
End Sub

'■■■■■■■■■■
'人と組織を作る
'■■■■■■■■■■
Sub SetPersonAndOrganization(objPersonAndOrganization As IFCsvr.Entity)
With objPersonAndOrganization
'【本体】
'IfcPersonAndOrganization
    .Attributes("ThePerson").Value = objDesign.Add("IfcPerson")'人
    .Attributes("TheOrganization").Value = objDesign.Add("IfcOrganization")'組織
    boolResult = .Attributes("Roles").AddItem(objDesign.Add("IfcActorRole")) 'OPTIONAL/LIST [1:?]/役割
'【派生】
'人
    Dim objPerson As IFCsvr.Entity
    Set objPerson = .Attributes("ThePerson").Value
    Call SetPerson(objPerson)
'組織
    Dim objOrganization As IFCsvr.Entity
    Set objOrganization = .Attributes("TheOrganization").Value.Item(i)
    Call SetOrganization(objOrganization)
'役割
    Dim objActorRole As IFCsvr.Entity
    Set objActorRole = .Attributes("Roles").Value.Item(i) 
    Call SetActorRole(objActorRole)
End With
End Sub

'■■■■■■■■■■
'人を作る
'■■■■■■■■■■
Sub SetPerson(objPerson As IFCsvr.Entity)
With objPerson
'【本体】
'IfcPerson
    .Attributes("Id").Value = str 'OPTIONAL/IfcIdentifier
    .Attributes("FamilyName").Value = str 'OPTIONAL/IfcLabel
    .Attributes("GivenName").Value = str 'OPTIONAL/IfcLabel
    boolResult = .Attributes("MiddleNames").AddItem(str) 'OPTIONAL/LIST [1:?] OF IfcLabel
    boolResult = .Attributes("PrefixTitles").AddItem(str) 'OPTIONAL/LIST [1:?] OF IfcLabel
    boolResult = .Attributes("SuffixTitles").AddItem(str) 'OPTIONAL/LIST [1:?] OF IfcLabel
    boolresult = .Attributes("Roles").AddItem(objDesign.Add("IfcActorRole")) 'OPTIONAL/LIST [1:?]/役割
    boolResult = .Attributes("Addresses").AddItem(objDesign.Add("IfcAddress")) 'OPTIONAL/LIST [1:?]/住所
'↑IfcAddressは抽象クラスなので、実際にはIfcPostalAddressなどのクラスを使う
'【派生】
'役割
    '略
'住所
    '略
End With
End Sub

'■■■■■■■■■■
'組織を作る
'■■■■■■■■■■
Sub SetOrganization(objOrganization As IFCsvr.Entity)
With objOrganization
'【本体】
'IfcOrganization
    .Attributes("Id").Value = str 'OPTIONAL/IfcIdentifier
    .Attributes("Name").Value = str 'OPTIONAL/IfcLabel
    .Attributes("Description").Value = str 'OPTIONAL/ IfcText
    Boolresult = .Attributes("Roles").AddItem(objDesign.Add("IfcActorRole")) 'OPTIONAL/LIST [1:?]/役割
    boolResult = .Attributes("Addresses").AddItem(objDesign.Add("IfcAddress")) 'OPTIONAL/LIST [1:?]/住所
'↑IfcAddressは抽象クラスなので、実際にはIfcPostalAddressなどのクラスを使う
'【派生】
'役割
    '略
'住所
    '略
End With
End Sub

'■■■■■■■■■■
'役割を作る
'■■■■■■■■■■
Sub SetActorRole(objActorRole As IFCsvr.Entity)
With objActorRole
'【本体】
'IfcActorRole
    .Attributes("Role").Value = str
'IfcRoleEnum(SUPPLIER,MANUFACTURER,CONTRACTOR,SUBCONTRACTOR,ARCHITECT,STRUCTURALENGINEER,COSTENGINEER,CLIENT,BUILDINGOWNER,BUILDINGOPERATOR,MECHANICALENGINEER,ELECTRICALENGINEER,PROJECTMANAGER,FACILITIESMANAGER,CIVILENGINEER,COMISSIONINGENGINEER,ENGINEER,OWNER,CONSULTANT,CONSTRUCTIONMANAGER,FIELDCONSTRUCTIONMANAGER,RESELLER,USERDEFINED)
    .Attributes("UserDefinedRole").Value = str 'OPTIONAL/IfcLabel
    .Attributes("Description").Value = str 'OPTIONAL/IfcText
'【派生】
'なし
End With
End Sub

'■■■■■■■■■■
'アプリケーションを作る
'■■■■■■■■■■
Sub SetApplication(objApplication As IFCsvr.Entity)
With objApplication
'【本体】
'IfcApplication
    .Attributes("Role").Value = str
'IfcRoleEnum(SUPPLIER,MANUFACTURER,CONTRACTOR,SUBCONTRACTOR,ARCHITECT,STRUCTURALENGINEER,COSTENGINEER,CLIENT,BUILDINGOWNER,BUILDINGOPERATOR,MECHANICALENGINEER,ELECTRICALENGINEER,PROJECTMANAGER,FACILITIESMANAGER,CIVILENGINEER,COMISSIONINGENGINEER,ENGINEER,OWNER,CONSULTANT,CONSTRUCTIONMANAGER,FIELDCONSTRUCTIONMANAGER,RESELLER,USERDEFINED)
    .Attributes("UserDefinedRole").Value = str 'OPTIONAL/IfcLabel
    .Attributes("Description").Value = str 'OPTIONAL/IfcText
'【派生】
'なし
End With
End Sub

'■■■■■■■■■■
'住所を作る
'■■■■■■■■■■
Sub SetPostalAddress (objPostalAddress As IFCsvr.Entity)
'クラス構造
'IfcAddress*
'└IfcPostalAddress,IfcTelecomAddress
With objPostalAddress
'【本体】
'IfcAddress由来
    .Attributes("Purpose").Value = str 
'OPTIONAL/IfcAddressTypeEnum(OFFICE,SITE,HOME,DISTRIBUTIONPOINT,USERDEFINED)
    .Attributes("Description").Value = str 'OPTIONAL/IfcText
    .Attributes("UserDefinedPurpose").Value = str 'OPTIONAL/IfcLabel
'IfcPostalAddress
    .Attributes("InternalLocation").Value = str 'OPTIONAL/IfcLabel
    Boolresult = .Attributes("AddressLines").AddItem(str) 'OPTIONAL/ LIST [1:?] OF IfcLabel
    .Attributes("PostalBox").Value = str 'OPTIONAL/IfcLabel
    .Attributes("Town").Value = str ' OPTIONAL/Ifclabel
    .Attributes("Region").Value = str 'OPTIONAL/IfcLabel
    .Attributes("PostalCode").Value = str 'OPTIONAL/IfcLabel
    .Attributes("Country").Value = str 'OPTIONAL/IfcLabel
'【派生】
'なし
End With
End Sub

'--------------------------------------------------------------------------------
'■■■■■■■■■■
'単位背景を作る
'■■■■■■■■■■
Sub SetUnitAssignment(objUnitAssignment As IFCsvr.Entity)
With objUnitAssignment
'【本体】
'IfcUnitAssignment
    Boolresult = .Attributes("Units").AddItem(objDesign.Add("IfcUnit")) 
'SET [1:?] (IfcDerivedUnit,IfcNamedUnit,IfcMonetaryUnit) /単位
'↑IfcUnitは抽象クラスなので、実際にはIfcNamedUnitや IfcDerivedUnitなどのクラスを使う
'【派生】
'単位
'標準(既定義)単位の場合
 '↓IfcNamedUnit は抽象クラスなので、実際には IfcSIUnitなどのクラスを使う
   Dim objSIUnit As IFCsvr.Entity
    Set objSIUnit = .Attributes("Units").Value.Item(i) 
    Call SetSIUnit(objSIUnit)
'組立(未定義)単位の場合
    Dim objDerivedUnit As IFCsvr.Entity
    Set objDerivedUnit = .Attributes("Units").Value.Item(i) 
    Call SetDerivedUnit(objDerivedUnit)
End With
End Sub

'■■■■■■■■■■
'組立単位を作る
'■■■■■■■■■■
Sub SetDerivedUnit(objSIUnit As IFCsvr.Entity)
With objDerivedUnit
'【本体】
'IfcDerivedUnit
'↓例えば、熱貫流率としてw/m2Kを設定する場合は、"Elements"(組立単位要素)にw、m2、Kを、"UnitType"にTHERMALTRANSMITTANCEUNITを、"UserDefinedTypeにw/m2Kを設定する
    Boolresult = .Attributes("Elements").AddItem(objDesign.Add("IfcDerivedUnitElement")) 'SET [1:?]
    .Attributes("UnitType").Value = str 
'IfcDerivedUnitEnum(ANGULARVELOCITYUNIT,COMPOUNDPLANEANGLEUNIT,DYNAMICVISCOSITYUNIT,HEATFLUXDENSITYUNIT,INTEGERCOUNTRATEUNIT,ISOTHERMALMOISTURECAPACITYUNIT,KINEMATICVISCOSITYUNIT,LINEARVELOCITYUNIT,MASSDENSITYUNIT,MASSFLOWRATEUNIT,MOISTUREDIFFUSIVITYUNIT,MOLECULARWEIGHTUNIT,SPECIFICHEATCAPACITYUNIT,THERMALADMITTANCEUNIT,THERMALCONDUCTANCEUNIT,THERMALRESISTANCEUNIT,THERMALTRANSMITTANCEUNIT,VAPORPERMEABILITYUNIT,VOLUMETRICFLOWRATEUNIT,ROTATIONALFREQUENCYUNIT,TORQUEUNIT,MOMENTOFINERTIAUNIT,LINEARMOMENTUNIT,LINEARFORCEUNIT,PLANARFORCEUNIT,MODULUSOFELASTICITYUNIT,SHEARMODULUSUNIT,LINEARSTIFFNESSUNIT,ROTATIONALSTIFFNESSUNIT,MODULUSOFSUBGRADEREACTIONUNIT,ACCELERATIONUNIT,CURVATUREUNIT,HEATINGVALUEUNIT,IONCONCENTRATIONUNIT,LUMINOUSINTENSITYDISTRIBUTIONUNIT,MASSPERLENGTHUNIT,MODULUSOFLINEARSUBGRADEREACTIONUNIT,MODULUSOFROTATIONALSUBGRADEREACTIONUNIT,PHUNIT,ROTATIONALMASSUNIT,SECTIONAREAINTEGRALUNIT,SECTIONMODULUSUNIT,SOUNDPOWERUNIT,SOUNDPRESSUREUNIT,TEMPERATUREGRADIENTUNIT,THERMALEXPANSIONCOEFFICIENTUNIT,WARPINGCONSTANTUNIT,WARPINGMOMENTUNIT,USERDEFINED);  
    .Attributes("UserDefinedType").Value = str 'OPTIONAL/IfcLabel
'【派生】
'組立単位要素
    Dim objDerivedUnitElement As IFCsvr.Entity
    Set objDerivedUnitElement = .Attributes("Elements").Value.Item(i)
    Call SetDerivedUnitElement(objDerivedUnitElement)
End With
End Sub

'■■■■■■■■■■
'組立単位要素を作る
'■■■■■■■■■■
Sub SetDerivedUnitElement (objDerivedUnitElement As IFCsvr.Entity)
With objDerivedUnitElement
'【本体】
'DerivedUnitElement
'↓例えば、熱貫流率としてw/m2Kを設定する場合は、"Unit"にIfcSIUnitのw、m2、Kを、"Exponent"にそれぞれ1,-1,-1を設定する
'IfcDerivedUnitElement
    .Attributes("Unit").Value = objDesign.Add("IfcNamedUnit")
'↑IfcNamedUnitは抽象クラスなので、実際にはIfcSIUnitなどのクラスを使う
    .Attributes("Exponent").Value = val 'Integer
'【派生】
'なし
End With
End Sub

'■■■■■■■■■■
'SI単位を作る
'■■■■■■■■■■
Sub SetSIUnit(objSIUnit As IFCsvr.Entity)
'クラス構造
'IfcNamedUnit*
'└IfcSIUnit,IfcConversionBasedUnit,IfcContextDependentUnit
With objSIUnit
'【本体】
'IfcSIUnit
'↓例えば、m2を設定する場合は、"UnitType"にAREAUNITを、"Name"にSQUARE_METREを設定する 
    .Attributes("UnitType").Value = str
'IfcUnitEnum(ABSORBEDDOSEUNIT,AMOUNTOFSUBSTANCEUNIT,AREAUNIT,DOSEEQUIVALENTUNIT,ELECTRICCAPACITANCEUNIT,ELECTRICCHARGEUNIT,ELECTRICCONDUCTANCEUNIT,ELECTRICCURRENTUNIT,ELECTRICRESISTANCEUNIT,ELECTRICVOLTAGEUNIT,ENERGYUNIT,FORCEUNIT,FREQUENCYUNIT,ILLUMINANCEUNIT,INDUCTANCEUNIT,LENGTHUNIT,LUMINOUSFLUXUNIT,LUMINOUSINTENSITYUNIT,MAGNETICFLUXDENSITYUNIT,MAGNETICFLUXUNIT,MASSUNIT,PLANEANGLEUNIT,POWERUNIT,PRESSUREUNIT,RADIOACTIVITYUNIT,SOLIDANGLEUNIT,THERMODYNAMICTEMPERATUREUNIT,TIMEUNIT,VOLUMEUNIT,USERDEFINED)
    .Attributes("Prefix").Value = str
'OPTIONAL/IfcSIPrefix(EXA,PETA,TERA,GIGA,MEGA,KILO,HECTO,DECA,DECI,CENTI,MILLI,MICRO,NANO,PICO,FEMTO,ATTO)
    .Attributes("Name").Value = str
'IfcSIUnitName(AMPERE,BECQUEREL,CANDELA,COULOMB,CUBIC_METRE,DEGREE_CELSIUS,FARAD,GRAM,GRAY,HENRY,HERTZ,JOULE,KELVIN,LUMEN,LUX,METRE,MOLE,NEWTON,OHM,PASCAL,RADIAN,SECOND,SIEMENS,SIEVERT,SQUARE_METRE,STERADIAN,TESLA,VOLT,WATT,WEBER)
'【派生】
'なし
End With
End Sub

'--------------------------------------------------------------------------------
'■■■■■■■■■■
'位置を作る
'■■■■■■■■■■
Sub SetLocalPlacement(objLocalPlacement As IFCsvr.Entity)
'クラス構造
'IfcObjectPlacement
'└IfcLocalPlacement
With objLocalPlacement
'【本体】
    .Attributes("PlacementRelTo").Value = objDesign.Add("IfcObjectPlacement") 'OPTIONAL/位置
    '↑ローカル座標を設定するには、上位のIfcObjectPlacement を参照し、例えば、建築部材や設備部材の場合は階を、階は建物を、建物は敷地を参照する
    .Attributes("RelativePlacement").Value = objDesign.Add("IfcAxis2Placement") '座標系
    '↑IfcAxis2Placementは抽象クラスなので、実際にはIfAxis2Placement3DやIfAxis2Placement2Dのクラスを使う
'【派生】
'座標系
'3次元の場合
    Dim objAxis2Placement3D  As IFCsvr.Entity
    Set objAxis2Placement3D = .Attributes("RelativePlacement").Value
    Call SetAxis2Placement3D(objAxis2Placement3D)
'2次元の場合
    Dim objAxis2Placement2D  As IFCsvr.Entity
    Set objAxis2Placement2D = .Attributes("RelativePlacement").Value
    Call SetAxis2Placement2D(objAxis2Placement2D)
End With
End Sub

'■■■■■■■■■■
'3D座標系を作る
'■■■■■■■■■■
Sub SetAxis2placement3D(objAxis2placement3D As IFCsvr.Entity)
'クラス構造
'IfcRepresentationItem*
'└IfcGeometricRepresentationItem*
'  └IfcPlacement*
'    └IfcAxis2placement*
'      └IfcAxis2placement3D, IfcAxis2placement2D
'【本体】
With objAxis2Placement3D
'IfcPlacement
    .Attributes("Location").Value = objDesign.Add("IfcCartesianPoint") '点
'IfcAxis2placement3D
    .Attributes("Axis").Value = objDesign.Add("IfcDirection") 'OPTIONAL/方位(Z軸) 
    .Attributes("RefDirection").Value = objDesign.Add("IfcDirection") 'OPTIONAL/方位(X軸)
'【派生】
'点
    '略
'方位
    '略
End With
End Sub

'■■■■■■■■■■
'2D座標系を作る
'■■■■■■■■■■
Sub SetAxis2placement2D(objAxis2placement2D As IFCsvr.Entity)
'クラス構造
'IfcRepresentationItem*
'└IfcGeometricRepresentationItem*
'  └IfcPlacement*
'    └IfcAxis2placement*
'      └IfcAxis2placement3D, IfcAxis2placement2D
'【本体】
With objAxis2Placement2D
'IfcPlacement
    .Attributes("Location").Value = objDesign.Add("IfcCartesianPoint") '点
'IfcAxis2placement3D
    .Attributes("RefDirection").Value = objDesign.Add("IfcDirection") 'OPTIONAL/方位(X軸)
'【派生】
'点
    '略
'方位
    '略
End With
End Sub

'■■■■■■■■■■
'ベクトルを作る
'■■■■■■■■■■
Sub SetDirection(objDirection As IFCsvr.Entity)
'クラス構造
'IfcRepresentationItem*
'└IfcGeometricRepresentationItem*
'  └IfcDirection
With objDirection
'【本体】
'IfcDirection
    Boolresult = .Attributes("DirectionRatios").SetItem(CDbl(val), 1) 'LIST [2:3] OF REAL/ベクトル値
    Boolresult = .Attributes("DirectionRatios").SetItem(CDbl(val), 2)
    Boolresult = .Attributes("DirectionRatios").SetItem(CDbl(val), 3)
'【派生】
'なし
End With
End Sub

'--------------------------------------------------------------------------------
'■■■■■■■■■■
'表現背景を作る
'■■■■■■■■■■
Sub SetGeometricRepresentationContext(objDirection As IFCsvr.Entity)
'クラス構造
'IfcRepresentationContext*
'└IfcGeometricRepresentationContext
With objGeometricRepresentationContext
'【本体】
'IfcRepresentationContext由来
    .Attributes("ContextIdentifier").Value = str 'OPTIONAL/ IfcLabel
    .Attributes("ContextType").Value = str 'OPTIONAL/IfcLabel
'↑実際には必須(Plan:2次元またはModel:3次元)
'IfcGeometricRepresentationContext
    .Attributes("CoordinateSpaceDimension").Value = val 'IfcDimensionCount(1,2,3)/次元
'↑ContextTypeがPlanなら2、Modelなら3
    .Attributes("Precision").Value = CDbl(val) 'OPTIONAL/REAL/精度
    .Attributes("WorldCoordinateSystem").Value = objDesign.Add("IfcAxis2Placement") '座標系
'↑IfcAxis2Placementは抽象クラスなので、実際にはContextTypeがPlanならIfcAxis2Placement2D 、ModelならIfcAxis2Placement3Dのクラスを使う
    .Attributes("TrueNorth").Value = objDesign.Add("IfcDirection") 'OPTIONAL/方位
'↑北方向とy軸の差のベクトル、y軸が北なら(0,0)とする
'【派生】
'座標系
Dim objAxis2Placement As IFCsvr.Entity
Set objAxis2Placement = .Attributes("WorldCoordinateSystem").Value
Call SetAxis2Placement(objAxis2Placement)
'方位
Dim objDirection As IFCsvr.Entity
Set objDirection = .Attributes("WorldCoordinateSystem").Value
Call SetDirection(objDirection)
'略
End With
End Sub

'■■■■■■■■■■
'形状を作る
'■■■■■■■■■■
Sub SetProductDefinitionShape (objProductDefinitionShape As IFCsvr.Entity)
'クラス構造
'IfcProductRepresentation*
'└IfcProductDefinitionShape
With objProductDefinitionShape
'【本体】
'IfcProductRepresentation由来
    .Attributes("Name").Value = str 'OPTIONAL/IfcLabel
    .Attributes("Description").Value = str 'OPTIONAL/IfcText
    Boolresult = .Attributes("Representations").AddItem(objDesign.Add("IfcShapeRepresentation")) 
'LIST [1:?]/ 形状表現
'【派生】
'形状表現
    Dim objShapeRepresentation As IFCsvr.Entity
    Set objShapeRepresentation = .Attributes("Representations").Value
    Call SetShapeRepresentation(objShapeRepresentation)
End With
End Sub

'■■■■■■■■■■
'形状表現を作る
'■■■■■■■■■■
Sub SetShapeRepresentation(objShapeRepresentation As IFCsvr.Entity)
'クラス構造
'IfcRepresentation*
'└IfcShapeModel*
'  └IfcShapeRepresentation
With objShapeRepresentation
'【本体】
'IfcRepresentation由来
    .Attributes("ContextOfItems").Value = objDesign.Add("IfcRepresentationContext") '形状背景
'↑IfcRepresentationContextは抽象クラスなので、実際にはIfcGeometricRepresentationContextなどのクラスを使う
    .Attributes("RepresentationIdentifier").Value = str 'OPTIONAL/IfcLabel
'↑実際には必須、"Body"とする
.Attributes("RepresentationType").Value = str 'OPTIONAL/IfcLabel
'↑実際には必須、面モデルの場合は"SurfaceModel"、立体モデルの場合は"SweptSolid"とする
    Boolresult = .Attributes("Items").AddItem(objDesign.Add("IfcRepresentationItem")) '形状項目
'↑IfcRepresentationItemは抽象クラスなので、実際にはIfcFaceBasedSurfaceModelやIfcSolidModelなどのクラスを使う
'【派生】
'表現背景
'略
'形状項目
'面形状の場合
    Dim objFaceBasedSurfaceModel As IFCsvr.Entity
    Set objFaceBasedSurfaceModel = .Attributes("Items").Value
    Call SetFaceBasedSurfaceModel(objFaceBasedSurfaceModel)
'立体形状の場合
    Dim objExtrudedAreaSolid As IFCsvr.Entity
    Set objExtrudedAreaSolid = .Attributes("Items").Value
    Call SetExtrudedAreaSolid (objExtrudedAreaSolid)
End With
End Sub

'■■■■■■■■■■
'面形状を作る
'■■■■■■■■■■
Sub SetFaceBasedSurfaceModel(objFaceBasedSurfaceModel As IFCsvr.Entity)
'クラス構造
'IfcRepresentationItem*
'└IfcGeometricRepresentationItem*
'  └IfcFaceBasedSurfaceModel,IfcSolidModel,他
With objFaceBasedSurfaceModel
'【本体】
'IfcFaceBasedSurfaceModel 
Do
    Boolresult =.Attributes("FbsmFaces").AddItem(objConnectedFaceSet) 'SET [1:?]/面集合
If 条件式 Then Exit Do
Loop
'【派生】
'面集合
    Dim objConnectedFaceSet As IFCsvr.Entity
    Set objConnectedFaceSet = .Attributes("FbsmFaces").Value
    Call SetConnectedFaceSet(objConnectedFaceSet)
End With
End Sub

'■■■■■■■■■■
'面集合を作る
'■■■■■■■■■■
'クラス構造
'IfcRepresentationItem*
'└IfcTopologicalRepresentationItem*
'  └IfcConnectedFaceSet
Sub SetConnectedFaceSet(objConnectedFaceSet As IFCsvr.Entity)
With objConnectedFaceSet
'【本体】
'IfcConnectedFaceSet
Do
    Boolresult = .Attributes("CfsFaces").AddItem(objDesign.Add("IfcFace")) 'SET [1:?]/面 
If 条件式 Then Exit Do
Loop
'【派生】
'面
    Dim objFace As IFCsvr.Entity
    Set objFace = .Attributes("CfsFaces").Value
    Call SetFace(objFace)
End With
End Sub

'■■■■■■■■■■
'面を作る
'■■■■■■■■■■
Sub SetFace(objFace As IFCsvr.Entity)
'クラス構造
'IfcRepresentationItem*
'└IfcTopologicalRepresentationItem*
'  └IfcFace
With objFace
'【本体】
'IfcFace
Do
    Boolresult = .Attributes("Bounds").AddItem(objDesign.Add("IfcFaceOuterBound")) 'SET [1:?]/境界
If 条件式 Then Exit Do
Loop
'【派生】
'境界
    Dim objFaceOuterBound As IFCsvr.Entity
    Set objFaceOuterBound = .Attributes("Bounds").Value
    Call SetFaceOuterBound(objFaceOuterBound)
End With
End Sub

'■■■■■■■■■■
'境界を作る
'■■■■■■■■■■
Sub SetFaceOuterBound(objFaceOuterBound As IFCsvr.Entity)
'クラス構造
'IfcRepresentationItem*
'└IfcTopologicalRepresentationItem*
'  └IfcFaceBound*
'    └IfcFaceOuterBound
With objFaceOuterBound
'【本体】
'IfcFaceBound
    objFaceOuterBound.Attributes("Bound").Value = objDesign.Add("IfcPolyLoop") '折れ線
    objFaceOuterBound.Attributes("Orientation").Value = Boolean True
'【派生】
'折れ線
    Dim objPolyLoop As IFCsvr.Entity
    Set objPolyLoop = .Attributes("Bound").Value
    Call SetPolyLoop(objPolyLoop)
End With
End Sub

'■■■■■■■■■■
'折れ線を作る
'■■■■■■■■■■
Sub SetPolyLoop(objPolyLoop As IFCsvr.Entity)
'クラス構造
'IfcRepresentationItem*
'└IfcTopologicalRepresentationItem*
'  └IfcRoop*
'    └IfcPolyLoop,IfcVertexLoop,IfcEdgeLoop
With objPolyLoop
'【本体】
'IfcPolyLoop
Do
    Boolresult = .Attributes("Polygon").AddItem(objDesign.Add("IfcCartesianPoint")) 'LIST [3:?]/点
If 条件式 Then Exit Do
Loop
'【派生】
'点
    Dim objCartesianPoint As IFCsvr.Entity
    Set objCartesianPoint = .Attributes("Polygon").Value
    Call SetCartesianPoint(objCartesianPoint)
End With
End Sub

'■■■■■■■■■■
'点を作る
'■■■■■■■■■■
Sub SetCartesianPoint(objCartesianPoint As IFCsvr.Entity)
With objCartesianPoint
'【本体】
'IfcCartesianPoint
    Boolresult = .Attributes("Coordinates").SetItem(CDbl(val),1) 'LIST [1:3] OF IfcLengthMeasure/座標値
    Boolresult = .Attributes("Coordinates").SetItem(CDbl(val),2)
    Boolresult = .Attributes("Coordinates").SetItem(CDbl(val),3)
'【派生】
'なし
End With
End Sub

'■■■■■■■■■■
'押し出し立体形状を作る
'■■■■■■■■■■
Sub SetExtrudedAreaSolid(objExtrudedAreaSolid As IFCsvr.Entity)
'クラス構造
'IfcRepresentationItem*
'└IfcGeometricRepresentationItem*
'  └IfcSolidModel*
'    └IfcSweptAreaSolid*
'      └IfcExtrudedAreaSolid
With objExtrudedAreaSolid
'【本体】
'IfcSweptAreaSolid由来
    .Attributes("SweptArea").Value = objDesign.Add("IfcProfileDef") '押し出し面
'↑IfcProfileDefは抽象クラスなので、実際にはIfcRectanglePlofileDefやIfcCircleProfileDefなどのクラスを使う
    .Attributes("Position").Value = objDesign.Add("IfcAxis2Placement3D") '座標系
'IfcExtrudedAreaSolid
    .Attributes("ExtrudedDirection").Value = objDesign.Add("IfcDirection") '方位
    .Attributes("Depth").Value = val 'IfcPositiveLengthMeasure/押し出し長さ
End With

'【派生】
'押し出し面
    Dim objRectanglePlofileDef As IFCsvr.Entity
    Set objRectanglePlofileDef = .Attributes("SweptArea ").Value
    Call SetRectanglePlofileDef(objRectanglePlofileDef)
'座標系
'略
'方位
'略
End With
End Sub

'■■■■■■■■■■
'押し出し面を作る
'■■■■■■■■■■
Sub SetRectanglePlofileDef(objRectanglePlofileDef As IFCsvr.Entity)
'クラス構造
'IfcProfileDef*
'└IfcParameterizedProfileDef*
'  └IfcRectangleProfileDef
With IfcRectangleProfileDef
'【本体】
'IfcProfileDef由来
    .Attributes("ProfileType").Value = str 'IfcProfileTypeEnum(CURVE,AREA)/形状区分
    .Attributes("ProfileName").Value = str 'OPTIONAL/IfcLabel
'IfcParameterizedProfileDef由来
    .Attributes("Position").Value = objDesign.Add("IfcAxis2Placement2D") '座標系
'IfcRectangleProfileDef
    .Attributes("XDim").Value = val ' IfcPositiveLengthMeasure
    .Attributes("YDim").Value = val ' IfcPositiveLengthMeasure
'【派生】
'座標系
'略
End With
End Sub