IFCsvr ActiveX Object Reference

Sample 6

[IFCsvr Home ]
Previous Chapter: Sample 5
Next Chapter: IFCsvr Home

Handling SELECT TYPE aggregation

This example works on Excel VBA module.

Public Sub test_SELECT_TYPE_API_Unit()
  Dim objIfcSiUnit(3) As Object
  Dim objIfcDerivedUnit As Object
  Dim objIfcUnitAssignment As Object
  Dim str1 As String
  Dim str2 As String
  Dim str3 As String
  Dim str4 As String
  Dim str5 As String
  str1 = "IfcSiUnit"
  str2 = "IfcDerivedUnit"
  str3 = "IfcUnitAssignment"  ' TYPE name of IfcUnit SELECT TYPE (IfcNamedUnit, 
  str4 = "IfcNamedUnit"       '                                   IfcDerivedUnit)
  str5 = "Units"              ' Attribute name of IfcUnitAssignment
  ' ============================================================
  Set objIFCsvr = CreateObject("IFCsvr.R200")
  Set objDesign = objIFCsvr.newDesign("test.ifc")
  objDesign.FileDirectory ThisWorkbook.Path
  Set objIfcSiUnit(1) = objDesign.Add(str1)
  Set objIfcSiUnit(2) = objDesign.Add(str1)
  Set objIfcSiUnit(3) = objDesign.Add(str1)
  Set objIfcDerivedUnit = objDesign.Add(str2)
  With objIfcSiUnit(1)
    .Attributes("UnitType").Value = "AreaUnit"
    .Attributes("Name").Value = "SQUARE_METRE"
  End With
  With objIfcSiUnit(2)
    .Attributes("UnitType").Value = "VolumeUnit"
    .Attributes("Name").Value = "CUBIC_METRE"
  End With
  With objIfcSiUnit(3)
    .Attributes("UnitType").Value = "LengthUnit"
    .Attributes("Prefix").Value = "MILLI"
    .Attributes("Name").Value = "METRE"
  End With
  Set objIfcUnitAssignment = objDesign.Add(str3)
  With objIfcUnitAssignment
     .Attributes(str5).AddSelectItem objIfcSiUnit(1), str4
     .Attributes(str5).AddSelectItem objIfcSiUnit(2), str4
     .Attributes(str5).AddSelectItem objIfcSiUnit(3), str4
  End With

  objIfcUnitAssignment.Attributes(str5).SetSelectItem objIfcDerivedUnit, str2, 1
  objIfcUnitAssignment.Attributes(str5).DeleteItem 2
  objIfcUnitAssignment.Attributes(str5).AddSelectItem objIfcSiUnit(2), str4
  Set objIfcUnitAssignment = Nothing
  Set objIfcSiUnit(1) = Nothing
  Set objIfcSiUnit(2) = Nothing
  Set objIfcSiUnit(3) = Nothing
  Set objDesign = Nothing
  Set objIFCsvr = Nothing

End Sub
This results in like this:



| IFCsvr Home | Previous Chapter | Next Chapter |

Copyright (c) 1999 SECOM Co., Ltd. Intelligent Systems Lab. All Rights Reserved.