Imports System.Runtime.InteropServices
Public Class CreatePMIDimensions
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim objApplication As SolidEdgeFramework.Application = Nothing
Dim ObjDoc As SolidEdgeFramework.SolidEdgeDocument = Nothing
Dim objPartDoc As SolidEdgePart.PartDocument = Nothing
Dim objdims As SolidEdgeFrameworkSupport.Dimensions = Nothing
Dim objDim As SolidEdgeFrameworkSupport.Dimension = Nothing
Dim objOrigDim As SolidEdgeFrameworkSupport.Dimension = Nothing
Dim objPMI As SolidEdgeFrameworkSupport.PMI = Nothing
Dim objEdges As SolidEdgeGeometry.Edges = Nothing
Dim objLinearEdge1 As SolidEdgeGeometry.Edge = Nothing
Dim objLinearEdge2 As SolidEdgeGeometry.Edge = Nothing
Dim objDimPlane As SolidEdgePart.RefPlane = Nothing
Dim objDimInitData As SolidEdgeFrameworkSupport.DimInitData = Nothing
Dim dblStartPoint1(0) As Double
Dim dblEndPoint1(0) As Double
Dim dblStartPoint2(0) As Double
Dim dblEndPoint2(0) As Double
Dim dblStartPoint3(0) As Double
Dim dblEndPoint3(0) As Double
Try
'Get the application with specific settings
objApplication = Marshal.GetActiveObject("SolidEdge.Application")
'Need a Part file with a block in it.
objPartDoc = objApplication.ActiveDocument
'Get the PMI object from the document
Call objPartDoc.PMI_ByModelState(PMIObj:=objPMI)
'Get the dimensions collection from the PMI object
objdims = objPMI.Dimensions
objEdges = objPartDoc.Models.Item(1).ExtrudedProtrusions.Item(1).Edges(SolidEdgeGeometry.FeatureTopologyQueryTypeConstants.igQueryAll)
If Not objEdges Is Nothing Then
objLinearEdge1 = objEdges.Item(1)
objLinearEdge2 = objEdges.Item(2)
End If
objDimPlane = objPartDoc.RefPlanes.Item(2)
objDimInitData = objdims.DimInitData
'linear distance between
Call objDimInitData.ClearParents()
Call objDimInitData.SetType(SolidEdgeFrameworkSupport.DimTypeConstants.igDimTypeLinear)
Call objDimInitData.SetAxisMode(SolidEdgeFrameworkSupport.DimAxisModeConstants.igDimAxisModeDefault)
Call objDimInitData.SetPlane(objDimPlane)
Call objDimInitData.SetNumberOfParents(2)
Call objLinearEdge1.GetEndPoints(StartPoint:=dblStartPoint1, EndPoint:=dblEndPoint1)
Call objLinearEdge2.GetEndPoints(StartPoint:=dblStartPoint2, EndPoint:=dblEndPoint2)
Call objDimInitData.SetParentByIndex(0, objLinearEdge1, True, False, False, False, dblStartPoint1(0), dblStartPoint1(1), dblStartPoint1(2))
Call objDimInitData.SetParentByIndex(1, objLinearEdge2, True, False, False, False, dblStartPoint2(0), dblStartPoint2(1), dblStartPoint2(2))
objDim = objdims.AddDimension(DimInitData:=objDimInitData)
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
End Class