Zobrazit plnou verzi příspěvku: Inventor vba

fillchr
25.03.2018, 14:49
Prosím vás nevedel by mi niekto poradiť prečo mi nepremietne všetky entity do roviny ale len niektoré? Ďakujem veľmi peknepožitý kód:Sub CreateImportedDWGComponentSample()
Dim oDoc As PartDocument
Set oDoc = ThisApplication.Documents.Add(kPartDocumentObject)

Dim oCompDef As PartComponentDefinition
Set oCompDef = oDoc.ComponentDefinition

Dim oRefComponents As ReferenceComponents
Set oRefComponents = oCompDef.ReferenceComponents

' Create a ImportedComponentDefinition based on an AutoCAD file.
Dim oImportedCompDef As ImportedComponentDefinition
Set oImportedCompDef = oRefComponents.ImportedComponents.CreateDefinition("C:\Temp\ACADDWG.dwg")

Dim oImportedDWGDef As ImportedDWGComponentDefinition

If oImportedCompDef.Type = kImportedDWGComponentDefinitionObject Then
Set oImportedDWGDef = oImportedCompDef
Else
End
End If

Dim oMatrix As Matrix
Set oMatrix = ThisApplication.TransientGeometry.CreateMatrix
oMatrix.SetTranslation ThisApplication.TransientGeometry.CreateVector(0, 0, 10)

oImportedDWGDef.Transformation = oMatrix

' Create the ImportedComponent
Dim oImportedComponent As ImportedComponent
Set oImportedComponent = oRefComponents.ImportedComponents.Add(oImportedDWGDef)

Dim oImportedDWGComponent As ImportedDWGComponent

If oImportedComponent.Type = kImportedDWGComponentObject Then
Set oImportedDWGComponent = oImportedComponent

Dim oSk As PlanarSketch
Set oSk = oCompDef.Sketches.Add(oCompDef.WorkPlanes(3))

' Get the DWGBlockDefinition for model space.
Dim oDWGModelSpaceDef As DWGBlockDefinition
Set oDWGModelSpaceDef = oImportedDWGComponent.ModelSpaceDefinition

' Project DWG entities to planar sketch.
Dim oDWGEntity As DWGEntity
For Each oDWGEntity In oDWGModelSpaceDef.Entities

Call oSk.AddByProjectingEntity(oDWGEntity)
Next
End If
End Sub