I can't create diferentes dimstyles

Discussion in 'AutoCAD' started by Sergio Cornejo, Jun 25, 2004.

  1. Hello.
    I have been trying to create different styles of dimensions from VBA, but I
    have not been able to make it.

    The idea is to create a dimension style for different scales (1:1 at 1:2000)
    and different text heights in the paper (2mm at 10mm)

    It is to create a templates for future drawings.

    Is this possible? Can I manipulate the properties of a dimension style from
    the code VBA?

    Excuseme for my english...

    Sergio Cornejo
     
    Sergio Cornejo, Jun 25, 2004
    #1
  2. You must use CopyFrom to copy the changes made (that create just overrides)
    to the DimStyle you want the changes made to.

    --
    R. Robert Bell


    Hello.
    I have been trying to create different styles of dimensions from VBA, but I
    have not been able to make it.

    The idea is to create a dimension style for different scales (1:1 at 1:2000)
    and different text heights in the paper (2mm at 10mm)

    It is to create a templates for future drawings.

    Is this possible? Can I manipulate the properties of a dimension style from
    the code VBA?

    Excuseme for my english...

    Sergio Cornejo
     
    R. Robert Bell, Jun 26, 2004
    #2
  3. Hi.

    I can resolve my problem with the SendCommand order. here there is the code
    (if somebady need it)

    ---------------------------------


    Public Sub DimMaker()

    Dim idcDimStyles As AcadDimStyles
    Dim idcDimFuente As AcadDimStyle
    Dim i, j As Integer
    Dim letterHeight(0 To 5) As Double
    Dim scales(0 To 16) As Double
    Dim DimName As String

    scales(0) = 10
    scales(1) = 20
    scales(2) = 25
    scales(3) = 40
    scales(4) = 50
    scales(5) = 75
    scales(6) = 100
    scales(7) = 125
    scales(8) = 200
    scales(9) = 250
    scales(10) = 400
    scales(11) = 500
    scales(12) = 750
    scales(13) = 1000
    scales(14) = 1250
    scales(15) = 2000
    scales(16) = 1

    letterHeight(0) = 2
    letterHeight(1) = 3
    letterHeight(2) = 4
    letterHeight(3) = 5
    letterHeight(4) = 8
    letterHeight(5) = 10

    Set idcDimStyles = ThisDrawing.DimStyles

    Set idcDimFuente = idcDimStyles.Item(0)
    ThisDrawing.SendCommand "dimclrd" & vbCr & "1" & vbCr
    ThisDrawing.SendCommand "dimclre" & vbCr & "1" & vbCr
    ThisDrawing.SendCommand "dimclrt" & vbCr & "2" & vbCr
    ThisDrawing.SendCommand "dimtxt" & vbCr & "1" & vbCr
    ThisDrawing.SendCommand "dimtxsty" & vbCr & "NoHeight" & vbCr
    ThisDrawing.SendCommand "dimgap" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimexe" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimdle" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimexo" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimasz" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimblk" & vbCr & "." & vbCr
    ThisDrawing.SendCommand "dimcen" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimtih" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimtoh" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimdec" & vbCr & "2" & vbCr
    ThisDrawing.SendCommand "dimadec" & vbCr & "3" & vbCr
    ThisDrawing.SendCommand "dimunit" & vbCr & "2" & vbCr
    ThisDrawing.SendCommand "dimaunit" & vbCr & "1" & vbCr
    ThisDrawing.SendCommand "dimjust" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimdsep" & vbCr & "." & vbCr
    ThisDrawing.SendCommand "dimrnd" & vbCr & "0.01" & vbCr
    ThisDrawing.SendCommand "dimtad" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimtvp" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "-dimstyle" & vbCr & "S" & vbCr & "Inicial" & vbCr
    ThisDrawing.SendCommand "-dimstyle" & vbCr & "R" & vbCr & "Inicial" & vbCr
    ThisDrawing.SendCommand "-purge" & vbCr & "D" & vbCr & "iso-25" & vbCr & "N"
    & vbCr

    For i = 0 To 16
    For j = 0 To 5
    DimName = "E 1-" & CStr(scales(i)) & " ATP " & CStr(letterHeight(j))
    & " mm"
    txtHeight = (1 / (1000 / scales(i))) * letterHeight(j)
    ThisDrawing.SendCommand "dimtxt" & vbCr & CStr(txtHeight) & vbCr
    ThisDrawing.SendCommand "dimgap" & vbCr & CStr(txtHeight / 2) & vbCr
    ThisDrawing.SendCommand "dimexe" & vbCr & CStr(txtHeight / 2) & vbCr
    ThisDrawing.SendCommand "dimexo" & vbCr & CStr(txtHeight / 2) & vbCr
    ThisDrawing.SendCommand "dimasz" & vbCr & CStr(txtHeight / 2) & vbCr
    ThisDrawing.SendCommand "-dimstyle" & vbCr & "S" & vbCr & DimName &
    vbCr
    Next j
    Next i

    End Sub
     
    Sergio Cornejo, Jun 26, 2004
    #3
  4. SendCommand is unneeded.

    Sub Test()
    With ThisDrawing
    .SetVariable "DimClrD", 1
    .SetVariable "DimClrE", 2
    .SetVariable "DimClrT", 3
    Dim myDim1 As AcadDimStyle
    Set myDim1 = .DimStyles.Add("Test1")
    myDim1.CopyFrom ThisDrawing

    .SetVariable "DimClrD", 4
    .SetVariable "DimClrE", 5
    .SetVariable "DimClrT", 6
    Dim myDim2 As AcadDimStyle
    Set myDim2 = .DimStyles.Add("Test2")
    myDim2.CopyFrom ThisDrawing

    .ActiveDimStyle = .DimStyles.Item("Standard")
    End With
    End Sub

    Also, if you are creating multiple styles simply to accommodate different
    DimScales, many places have changed to using one DimStyle that sets all the
    variable correctly for the dimension elements, and then use a DimOverride of
    the DimScale when placing the dimension. Advantage: less DimStyles to
    manage.


    --
    R. Robert Bell


    Hi.

    I can resolve my problem with the SendCommand order. here there is the code
    (if somebady need it)

    ---------------------------------


    Public Sub DimMaker()

    Dim idcDimStyles As AcadDimStyles
    Dim idcDimFuente As AcadDimStyle
    Dim i, j As Integer
    Dim letterHeight(0 To 5) As Double
    Dim scales(0 To 16) As Double
    Dim DimName As String

    scales(0) = 10
    scales(1) = 20
    scales(2) = 25
    scales(3) = 40
    scales(4) = 50
    scales(5) = 75
    scales(6) = 100
    scales(7) = 125
    scales(8) = 200
    scales(9) = 250
    scales(10) = 400
    scales(11) = 500
    scales(12) = 750
    scales(13) = 1000
    scales(14) = 1250
    scales(15) = 2000
    scales(16) = 1

    letterHeight(0) = 2
    letterHeight(1) = 3
    letterHeight(2) = 4
    letterHeight(3) = 5
    letterHeight(4) = 8
    letterHeight(5) = 10

    Set idcDimStyles = ThisDrawing.DimStyles

    Set idcDimFuente = idcDimStyles.Item(0)
    ThisDrawing.SendCommand "dimclrd" & vbCr & "1" & vbCr
    ThisDrawing.SendCommand "dimclre" & vbCr & "1" & vbCr
    ThisDrawing.SendCommand "dimclrt" & vbCr & "2" & vbCr
    ThisDrawing.SendCommand "dimtxt" & vbCr & "1" & vbCr
    ThisDrawing.SendCommand "dimtxsty" & vbCr & "NoHeight" & vbCr
    ThisDrawing.SendCommand "dimgap" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimexe" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimdle" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimexo" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimasz" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimblk" & vbCr & "." & vbCr
    ThisDrawing.SendCommand "dimcen" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimtih" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimtoh" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimdec" & vbCr & "2" & vbCr
    ThisDrawing.SendCommand "dimadec" & vbCr & "3" & vbCr
    ThisDrawing.SendCommand "dimunit" & vbCr & "2" & vbCr
    ThisDrawing.SendCommand "dimaunit" & vbCr & "1" & vbCr
    ThisDrawing.SendCommand "dimjust" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimdsep" & vbCr & "." & vbCr
    ThisDrawing.SendCommand "dimrnd" & vbCr & "0.01" & vbCr
    ThisDrawing.SendCommand "dimtad" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "dimtvp" & vbCr & "0" & vbCr
    ThisDrawing.SendCommand "-dimstyle" & vbCr & "S" & vbCr & "Inicial" & vbCr
    ThisDrawing.SendCommand "-dimstyle" & vbCr & "R" & vbCr & "Inicial" & vbCr
    ThisDrawing.SendCommand "-purge" & vbCr & "D" & vbCr & "iso-25" & vbCr & "N"
    & vbCr

    For i = 0 To 16
    For j = 0 To 5
    DimName = "E 1-" & CStr(scales(i)) & " ATP " & CStr(letterHeight(j))
    & " mm"
    txtHeight = (1 / (1000 / scales(i))) * letterHeight(j)
    ThisDrawing.SendCommand "dimtxt" & vbCr & CStr(txtHeight) & vbCr
    ThisDrawing.SendCommand "dimgap" & vbCr & CStr(txtHeight / 2) & vbCr
    ThisDrawing.SendCommand "dimexe" & vbCr & CStr(txtHeight / 2) & vbCr
    ThisDrawing.SendCommand "dimexo" & vbCr & CStr(txtHeight / 2) & vbCr
    ThisDrawing.SendCommand "dimasz" & vbCr & CStr(txtHeight / 2) & vbCr
    ThisDrawing.SendCommand "-dimstyle" & vbCr & "S" & vbCr & DimName &
    vbCr
    Next j
    Next i

    End Sub
     
    R. Robert Bell, Jun 26, 2004
    #4
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.