Add a Dimstyle

What is the easiest way to copy a DimStyle from a .dwt to a drawing? I'm using acad 2002. I've tried the copyFrom method but I get an error saying something about a duplicate record being added. I suspect it's because the dimstyle being copied has the same name as the 1 being created - this is a requirement, the name must remain the same.

 

I think the trick is using a collection.

Option Explicit

Const strDwgFile As String = "C:\TedDimStyle.dwg"
Const strDimStyle As String = "TEDDY"

Public Sub CopyDimstyle()
Dim docExt As New AxDbDocument
Dim docCurr As AcadDocument
Dim objCollection(0 To 0) As Object
Dim retObjects As Variant

Set docCurr = ThisDrawing
docExt.Open strDwgFile
Set objCollection(0) = docExt.DimStyles.Item(strDimStyle)
retObjects = docExt.CopyObjects(objCollection, docCurr.DimStyles)

Set docExt = Nothing
Set docCurr = Nothing

End Sub


- Ted

CAD Specialist, WD Partners

using acad 2002. I've tried the copyFrom method but I get an error saying
something about a duplicate record being added. I suspect it's because the
dimstyle being copied has the same name as the 1 being created - this is a
requirement, the name must remain the same.

 

I personally have a routine that uses ObjectDBX to copy dimstyles, text styles etc from a source template drawing.

The code would read something like this, which is from a module in my own program:

Private Sub Dim_style_set()
Dim dimstyle As AcadDimStyle
Dim newstyle As AcadDimStyle
Dim dimstylecoll As AcadDimStyles
Dim stylename As String
Dim styleexists As Boolean

styleexists = False
'source from a global variable defined ouside the sub.
stylename = txt_dimstyle_name.Text
styleexists = False
Set dimstylecoll = ThisDrawing.Dimstyles

'Iterate through the textstyles collection, and check to see if the 'style name already exists. If it does then set newstyle to the existing style name.
On Error GoTo error

For Each dimstyle In dimstylecoll
If stylename = dimstyle.Name Then
styleexists = True
Set newstyle = dimstyle
End If
Next
'If layerexists = False then the layer does not exist, so import the style from the default source.

If styleexists = False Then
'Import the textstyle using objectdbx.
'First create the object.
Dim objdwg As AxDbDocument
Set objdwg = New AxDbDocument
Dim objects(0 To 0) As Object
'Now open the drawing.
objdwg.Open "c:/PRC_Custom/dims-text/PRC_DIMS-TEXT_STYLES.dwg"
Set objects(0) = objdwg.Dimstyles.Item(stylename)
objdwg.CopyObjects objects, ThisDrawing.Dimstyles
Set newstyle = ThisDrawing.Dimstyles.Item(stylename)
'ThisDrawing.ActiveTextStyle = newstyle
'MsgBox "imported textstyle is: " & newstyle.Name

End If

If chk_dimstyle_current.value = True Then
ThisDrawing.ActiveDimStyle = newstyle
End If
Exit Sub

error:
MsgBox "An " & Err.Description & " error occured in " & Err.Source
Err.Clear
Exit Sub

End Sub

Hope that Helps.

 

That's what I ended up using is the ObjectDBX functionality - seems to work good. Wish you would have posted sooned so I didn't have to write my own code.