Refresh DWG Underlay

[Anonymous]

Hi all,

I want to use the DWG underlay in our company. Till now I update the process by hand, but I've tried to write a programm in vba.

The main problem with the underlay is, when we change the contour in Autocad (a block with polylines) we often have to explode the polylines and add new one. When we safe this file, the DWG underlay projection lost their reference.

Now I want a Programm with this Steps:

-Refresh the active part

-select all lines in the sketch DWG Underlay

-Delete all these lines

-Project the new contour

I don't know how i can select the projected lines. Maybe someone could help me.

Here is the code that I have till now:

Public Sub Aktualisieren()
  
'Aktives Bauteil Verwenden (active part)
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim partDef As PartComponentDefinition
    Set partDef = oDoc.ComponentDefinition
    
    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oDoc.ComponentDefinition
    
'Fehlermeldung Deaktivieren (deaktivate the Error)
    ThisApplication.SilentOperation = True
       
'Aktualisieren (Update the Sketch)
    oDoc.Update
    
  ' Zugriff auf das Command Manager Objekt (command manager)
   Dim oCommandMgr As CommandManager
   Set oCommandMgr = ThisApplication.CommandManager
   
        
'Referenz zur Skizzen Kollektion, ist eine Skizze Vorhanden
' Set a reference to the Sketches collection. This assumes
' that a part document containing a sketch is active.
    Dim oSketches As PlanarSketches
    Set oSketches = ThisApplication.ActiveDocument.ComponentDefinition.Sketches

' Überprüft ob "Skizze DWG Underlay" vorhanden ist. (is there a sketch with the name "DWG Underlay")
    On Error Resume Next
    Dim oSk1 As PlanarSketch
    Set oSk1 = oSketches.Item("DWG Underlay")
    If Err Then
      MsgBox "Eine Skizze mit dem Namen ""DWG Underlay"" muss existieren."
      Exit Sub
    End If
    On Error GoTo 0

'Skizze 1 Bearbeiten (edit sketch)
    oSk1.Edit

    
'Alles Auswählen (Select all project entities)
    Dim oTransGeom As TransientGeometry
    Set oTransGeom = ThisApplication.TransientGeometry

    'Dim oSketchObjects As ImportedDWGLayer
    'Set oSketchObjects = partDef.ReferenceComponents.ImportedComponents.Add
    'Dim oLines As SketchEntity

'Wählt alle Linien us
    For Each oLines In oSk1.SketchLines
    Call oSketchObjects.Add(oLines)
    Next
  
   ' Call oSk1.Delete(oLines)
    
'Neue Geometrie Projezieren (project new entities)

    'Skizze Schließen
    'oSk1.ExitEdit
    
'Fehlermeldungen Aktivieren (Muss wieder angeschaltet werden)
    ThisApplication.SilentOperation = False
    
End Sub

Kind regards

Franky