Author Topic: ARCHTICK problem  (Read 5750 times)

0 Members and 1 Guest are viewing this topic.

Matersammichman

  • Guest
ARCHTICK problem
« on: July 11, 2006, 03:31:40 PM »
When I use the following to set my1/16" = 1'-0"  dimensioning parameters, I cannot get the dimension ticks to display as an Archtick, it always displays Oblique. I've tried this as many ways as I can think of.
What am I missing???





Private Sub optarrowsixteenth_Click()
Dim TextStyle0 As AcadTextStyle
Dim newDimStyle As AcadDimStyle
Dim currDimStyle As AcadDimStyle
Set TextStyle0 = ThisDrawing.TextStyles.Add("DIMTXT")
TextStyle0.fontFile = "simplex.shx"
TextStyle0.Height = 0
ThisDrawing.SendCommand "_TEXTSTYLE" & vbCr & "DIMTXT" & vbCr
ThisDrawing.SendCommand "_dimcen" & vbCr & 3 / 32 & vbCr

Dim varData As Variant
Dim DataType As Integer
sysVarName = "DIMSCALE"
varData = ThisDrawing.GetVariable(sysVarName)
Set newDimStyle = ThisDrawing.DimStyles.Add("My_Arch")
ThisDrawing.SendCommand "_graphscr" & vbCr
ThisDrawing.ActiveDimStyle = newDimStyle
ThisDrawing.SendCommand "DIMADEC" & vbCr & 2 & vbCr
ThisDrawing.SendCommand "DIMALT" & vbCr & "Off" & vbCr
ThisDrawing.SendCommand "DIMALTD" & vbCr & 2 & vbCr
ThisDrawing.SendCommand "DIMALTF" & vbCr & 25.4 & vbCr
ThisDrawing.SendCommand "DIMALTRND" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMALTTD" & vbCr & 2 & vbCr
ThisDrawing.SendCommand "DIMALTTZ" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMALTU" & vbCr & 2 & vbCr
ThisDrawing.SendCommand "DIMALTZ" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMAPOST" & vbCr & "" & vbCr
ThisDrawing.SendCommand "DIMASSOC" & vbCr & 1 & vbCr
ThisDrawing.SendCommand "DIMASZ" & vbCr & 1 / 8 & vbCr
ThisDrawing.SendCommand "DIMATFIT" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMAUNIT" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMAZIN" & vbCr & 2 & vbCr
ThisDrawing.SendCommand "DIMBLK" & vbCr & "_ArchTick" & vbCr
ThisDrawing.SendCommand "DIMBLK1" & vbCr & "_ArchTick" & vbCr
ThisDrawing.SendCommand "DIMBLK2" & vbCr & "_ArchTick" & vbCr
ThisDrawing.SendCommand "DIMCEN" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMCLRD" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMCLRE" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMCLRT" & vbCr & 256 & vbCr
ThisDrawing.SendCommand "DIMDEC" & vbCr & 3 & vbCr
ThisDrawing.SendCommand "DIMDLE" & vbCr & 1 / 16 & vbCr
ThisDrawing.SendCommand "DIMDLI" & vbCr & 1 / 16 & vbCr
ThisDrawing.SendCommand "DIMDSEP" & vbCr & "." & vbCr
ThisDrawing.SendCommand "DIMEXE" & vbCr & 1 / 16 & vbCr
ThisDrawing.SendCommand "DIMEXO" & vbCr & 1 / 16 & vbCr
ThisDrawing.SendCommand "DIMFIT" & vbCr & 5 & vbCr
ThisDrawing.SendCommand "DIMFRAC" & vbCr & 2 & vbCr
ThisDrawing.SendCommand "DIMGAP" & vbCr & 1 / 64 & vbCr
ThisDrawing.SendCommand "DIMJUST" & vbCr & "0" & vbCr
ThisDrawing.SendCommand "DIMLDRBLK" & vbCr & "" & vbCr
ThisDrawing.SendCommand "DIMLFAC" & vbCr & 1 & vbCr
ThisDrawing.SendCommand "DIMLIM" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMLUNIT" & vbCr & 4 & vbCr
ThisDrawing.SendCommand "DIMLWD" & vbCr & -1 & vbCr
ThisDrawing.SendCommand "DIMLWE" & vbCr & -1 & vbCr
ThisDrawing.SendCommand "DIMPOST" & vbCr & "" & vbCr
ThisDrawing.SendCommand "DIMRND" & vbCr & "1/16" & vbCr
ThisDrawing.SendCommand "DIMSAH" & vbCr & "On" & vbCr
ThisDrawing.SendCommand "_dimscale" & vbCr & "192" & vbCr
ThisDrawing.SendCommand "DIMSD1" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMSD2" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMSE1" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMSE2" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMSHO" & vbCr & "ON" & vbCr
ThisDrawing.SendCommand "DIMSOXD" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMTAD" & vbCr & 1 & vbCr
ThisDrawing.SendCommand "DIMTDEC" & vbCr & 3 & vbCr
ThisDrawing.SendCommand "DIMTFAC" & vbCr & 1 & vbCr
ThisDrawing.SendCommand "DIMTIH" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMTIX" & vbCr & "ON" & vbCr
ThisDrawing.SendCommand "DIMTM" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMTMOVE" & vbCr & 1 & vbCr
ThisDrawing.SendCommand "DIMTOFL" & vbCr & "ON" & vbCr
ThisDrawing.SendCommand "DIMTOH" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMTOL" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMTOLJ" & vbCr & 1 & vbCr
ThisDrawing.SendCommand "DIMTP" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMTSZ" & vbCr & 1 / 32 & vbCr
ThisDrawing.SendCommand "DIMTVP" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMTXSTY" & vbCr & "DIMTXT" & vbCr
ThisDrawing.SendCommand "DIMTXT" & vbCr & 3 / 32 & vbCr
ThisDrawing.SendCommand "DIMTZIN" & vbCr & 0 & vbCr
ThisDrawing.SendCommand "DIMUNIT" & vbCr & 6 & vbCr
ThisDrawing.SendCommand "DIMUPT" & vbCr & "OFF" & vbCr
ThisDrawing.SendCommand "DIMZIN" & vbCr & 3 & vbCr

ThisDrawing.SendCommand "_TEXTSIZE" & vbCr & 18 & vbCr
ThisDrawing.SetVariable "DIMBLK", "_ArchTick"
End Sub

Bryco

  • Water Moccasin
  • Posts: 1882
Re: ARCHTICK problem
« Reply #1 on: July 11, 2006, 03:45:53 PM »
Matersammichman  you set the setvars (no sendcommand needed) first
then use copyfrom to set the dimstyle, I do all mine at once so this is part of a few subs.
The setvars have already been set for the leaderdimstyle elsewhwere

Code: [Select]
Private Sub childDimset(sDimStyle As String)

    Dim AngulardimStyle As AcadDimStyle
    Dim DiameterdimStyle As AcadDimStyle
    Dim RadialdimStyle As AcadDimStyle
    Dim LeaderdimStyle As AcadDimStyle
    Dim LineardimStyle As AcadDimStyle
    Dim activeDoc As AcadDocument
   
    With ThisDrawing
        Set activeDoc = .Application.ActiveDocument
       
        Set LineardimStyle = .DimStyles.Add(sDimStyle & "$0")
        LineardimStyle.CopyFrom activeDoc
             
        .SetVariable "DIMATFIT", 3
        .SetVariable "DIMBLK1", "."
        .SetVariable "DIMBLK2", "."
        .SetVariable "DIMCEN", 0
        .SetVariable "DIMDLE", 0
        .SetVariable "DIMDLI", 0.0625
        .SetVariable "DIMEXE", 0.125
        .SetVariable "DIMSAH", 0
        .SetVariable "DIMTAD", 0
        .SetVariable "DIMTIH", 1
        .SetVariable "DIMTMOVE", 2
        .SetVariable "DIMTOFL", 0
        .SetVariable "DIMTOH", 1
        .SetVariable "DIMUPT", 1

        Set AngulardimStyle = .DimStyles.Add(sDimStyle & "$2")
        AngulardimStyle.CopyFrom activeDoc
       
       
        Set activeDoc = .Application.ActiveDocument
        .SetVariable "DIMADEC", 1
        .SetVariable "DIMATFIT", 0
        .SetVariable "DIMCEN", 0.09125
        .SetVariable "DIMTAD", 1
        .SetVariable "DIMTIH", 0
        .SetVariable "DIMTMOVE", 0
        .SetVariable "DIMTOFL", 1
        .SetVariable "DIMTOH", 0
       
        Set DiameterdimStyle = .DimStyles.Add(sDimStyle & "$3")
        DiameterdimStyle.CopyFrom activeDoc
       
       
        Set activeDoc = .Application.ActiveDocument
       
        .SetVariable "DIMCEN", 0
        .SetVariable "DIMTOFL", 0
        Set RadialdimStyle = .DimStyles.Add(sDimStyle & "$4")
        RadialdimStyle.CopyFrom activeDoc
       
        '"$6" is ordinate
       
        .SetVariable "DIMTAD", 0
        Set LeaderdimStyle = .DimStyles.Add(sDimStyle & "$7")
        LeaderdimStyle.CopyFrom activeDoc

       
        'reset for next dimstyle
       
        .SetVariable "DIMBLK1", "ArchTick"
        .SetVariable "DIMBLK2", "ArchTick"
        .SetVariable "DIMCEN", 0.09375
        .SetVariable "DIMDLE", 0.0625
        .SetVariable "DIMDLI", 0.5625
        .SetVariable "DIMEXE", 0.0625
        .SetVariable "DIMSAH", 1
        .SetVariable "DIMTAD", 1
        .SetVariable "DIMTOFL", 1
        .SetVariable "DIMUPT", 0
               
    End With

End Sub

Bob Wahr

  • Guest
Re: ARCHTICK problem
« Reply #2 on: July 11, 2006, 03:48:07 PM »
First off, I would use SetVariable instead of SendCommand to set the variables.  I made these changes in notepad for a find and replace so it might need some more cleanup but give this a shot
Code: [Select]
Private Sub optarrowsixteenth_Click()
Dim TextStyle0 As AcadTextStyle
Dim newDimStyle As AcadDimStyle
Dim currDimStyle As AcadDimStyle
Set TextStyle0 = ThisDrawing.TextStyles.Add("DIMTXT")
TextStyle0.fontFile = "simplex.shx"
TextStyle0.Height = 0
ThisDrawing.SetVariable "TEXTSTYLE", "DIMTXT"
ThisDrawing.SetVariable "dimcen", 3 / 32

Dim varData As Variant
Dim DataType As Integer
sysVarName = "DIMSCALE"
varData = ThisDrawing.GetVariable(sysVarName)
Set newDimStyle = ThisDrawing.DimStyles.Add("My_Arch")
ThisDrawing.ActiveDimStyle = newDimStyle
ThisDrawing.SetVariable "DIMADEC", 2
ThisDrawing.SetVariable "DIMALT", "Off"
ThisDrawing.SetVariable "DIMALTD", 2
ThisDrawing.SetVariable "DIMALTF", 25.4
ThisDrawing.SetVariable "DIMALTRND", 0
ThisDrawing.SetVariable "DIMALTTD", 2
ThisDrawing.SetVariable "DIMALTTZ", 0
ThisDrawing.SetVariable "DIMALTU", 2
ThisDrawing.SetVariable "DIMALTZ", 0
ThisDrawing.SetVariable "DIMAPOST", ""
ThisDrawing.SetVariable "DIMASSOC", 1
ThisDrawing.SetVariable "DIMASZ", 1 / 8
ThisDrawing.SetVariable "DIMATFIT", 0
ThisDrawing.SetVariable "DIMAUNIT", 0
ThisDrawing.SetVariable "DIMAZIN", 2
ThisDrawing.SetVariable "DIMBLK", "_ArchTick"
ThisDrawing.SetVariable "DIMBLK1", "_ArchTick"
ThisDrawing.SetVariable "DIMBLK2", "_ArchTick"
ThisDrawing.SetVariable "DIMCEN", 0
ThisDrawing.SetVariable "DIMCLRD", 0
ThisDrawing.SetVariable "DIMCLRE", 0
ThisDrawing.SetVariable "DIMCLRT", 256
ThisDrawing.SetVariable "DIMDEC", 3
ThisDrawing.SetVariable "DIMDLE", 1 / 16
ThisDrawing.SetVariable "DIMDLI", 1 / 16
ThisDrawing.SetVariable "DIMDSEP", "."
ThisDrawing.SetVariable "DIMEXE", 1 / 16
ThisDrawing.SetVariable "DIMEXO", 1 / 16
ThisDrawing.SetVariable "DIMFIT", 5
ThisDrawing.SetVariable "DIMFRAC", 2
ThisDrawing.SetVariable "DIMGAP", 1 / 64
ThisDrawing.SetVariable "DIMJUST", "0"
ThisDrawing.SetVariable "DIMLDRBLK", ""
ThisDrawing.SetVariable "DIMLFAC", 1
ThisDrawing.SetVariable "DIMLIM", "OFF"
ThisDrawing.SetVariable "DIMLUNIT", 4
ThisDrawing.SetVariable "DIMLWD", -1
ThisDrawing.SetVariable "DIMLWE", -1
ThisDrawing.SetVariable "DIMPOST", ""
ThisDrawing.SetVariable "DIMRND", "1/16"
ThisDrawing.SetVariable "DIMSAH", "On"
ThisDrawing.SetVariable "_dimscale", "192"
ThisDrawing.SetVariable "DIMSD1", "OFF"
ThisDrawing.SetVariable "DIMSD2", "OFF"
ThisDrawing.SetVariable "DIMSE1", "OFF"
ThisDrawing.SetVariable "DIMSE2", "OFF"
ThisDrawing.SetVariable "DIMSHO", "ON"
ThisDrawing.SetVariable "DIMSOXD", "OFF"
ThisDrawing.SetVariable "DIMTAD", 1
ThisDrawing.SetVariable "DIMTDEC", 3
ThisDrawing.SetVariable "DIMTFAC", 1
ThisDrawing.SetVariable "DIMTIH", "OFF"
ThisDrawing.SetVariable "DIMTIX", "ON"
ThisDrawing.SetVariable "DIMTM", 0
ThisDrawing.SetVariable "DIMTMOVE", 1
ThisDrawing.SetVariable "DIMTOFL", "ON"
ThisDrawing.SetVariable "DIMTOH", "OFF"
ThisDrawing.SetVariable "DIMTOL", "OFF"
ThisDrawing.SetVariable "DIMTOLJ", 1
ThisDrawing.SetVariable "DIMTP", 0
ThisDrawing.SetVariable "DIMTSZ", 0.09375
ThisDrawing.SetVariable "DIMTVP", 0
ThisDrawing.SetVariable "DIMTXSTY", "DIMTXT"
ThisDrawing.SetVariable "DIMTXT", 0.09375
ThisDrawing.SetVariable "DIMTZIN", 0
ThisDrawing.SetVariable "DIMUNIT", 6
ThisDrawing.SetVariable "DIMUPT", "OFF"
ThisDrawing.SetVariable "DIMZIN", 3

ThisDrawing.SetVariable "TEXTSIZE", 18
ThisDrawing.SetVariable "DIMBLK", "ArchTick"
newDimStyle.CopyFrom ThisDrawing
End Sub
Bryco beat and topped me but Imma post anyway

mohnston

  • Bull Frog
  • Posts: 305
  • CAD Programmer
Re: ARCHTICK problem
« Reply #3 on: July 11, 2006, 08:24:25 PM »
Don't forget each style will have children which may or may not be affected by a change to the parent.

Another option for maintaining and setting dim variables is
Code: [Select]
Public Function FixDims(aDoc As AcadDocument) As Boolean
   
   On Error GoTo Err_Handler
   Dim aDStyle As AcadDimStyle
   Dim strDSName As String
   Dim intFldCount As Integer
   Dim fld As ADODB.Field
   Dim db As ADODB.Connection
   Dim rs As ADODB.Recordset
   Dim strSQL As String
   
   Set db = New ADODB.Connection
   
   db.Open ENG_SYS_DB
   
   Set rs = New ADODB.Recordset
   strSQL = "SELECT * " & _
               "FROM dimvars"
               
   rs.Open strSQL, db, adOpenForwardOnly
   
   With rs
      While .EOF = False And .BOF = False
         Set aDStyle = aDoc.DimStyles.Add(.Fields("style_name").Value)
         For Each fld In rs.Fields
            If UCase(Left(fld.Name, 3)) = "DIM" Then
               aDoc.SetVariable fld.Name, .Fields(fld.Name).Value
            End If
         Next
         aDStyle.CopyFrom aDoc
         .MoveNext
      Wend
   End With
   
   Set aDStyle = ThisDrawing.DimStyles("MyStandardDimStyle")
   
   aDoc.ActiveDimStyle = aDStyle
   
   aDoc.Save
   FixDims = True
Exit_Here:
   Exit Function
Err_Handler:
   Select Case Err.Number
      Case -2145320861 ' error saving file
         aDoc.Close False
         Set aDoc = Nothing
         FixDims = False
         Resume Exit_Here
      Case Else
         FixDims = False
         InputBox "Error " & Err.Description, "Fix Dims", Err.Number
         Resume Exit_Here
   End Select
End Function

The table looks like . . .
Code: [Select]
  style_name varchar(255) NOT NULL,
  style_description varchar(255),
  dimasz float8,
  dimblk varchar(255),
  dimblk1 varchar(255),
  dimblk2 varchar(255),
  dimcen float8,
  dimclrt float8,
  dimclrd float8,
  dimdle float8,
  dimexe float8,
  dimfit float8,
  dimgap float8,
  dimjust float8,
  dimlfac float8,
  dimpost varchar(255),
  dimtad float8,
  dimtfac float8,
  dimtih float8,
  dimtofl float8,
  dimtoh float8,
  dimtolj float8,
  dimtsz float8,
  dimtvp float8,
  dimtxt float8,
  dimsd1 int2 DEFAULT 0,
  dimsd2 int2 DEFAULT 0,
  dimse1 int2 DEFAULT 0,
  dimse2 int2 DEFAULT 0,
  dimsoxd int2 DEFAULT 0,
  dimldrblk varchar(64),
  dimatfit int2,
  dimtmove int2,
  dimdec int2 DEFAULT 3

This way you can have many dim styles and tweak their settings without reopening or redistributing your code.
It's amazing what you can do when you don't know what you can't do.
CAD Programming Solutions

Matersammichman

  • Guest
Re: ARCHTICK problem
« Reply #4 on: July 12, 2006, 12:08:49 PM »
So...I guess any "quick fix" with the vba equivalent of "Dimoverride" for the current dimstyle is just a pipe dream?? :lmao:

yujebey

  • Guest
Re: ARCHTICK problem
« Reply #5 on: September 04, 2014, 06:51:24 AM »
it happened to me and i fixed with adding this code;

ThisDrawing.SetVariable "DIMSAH", 1

its allow to show what you assign to DIMBLK, DIMBLK1, DIMBLK2