TheSwamp
Code Red => VB(A) => Topic started by: Matersammichman 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
-
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
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
-
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
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
-
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
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 . . .
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.
-
So...I guess any "quick fix" with the vba equivalent of "Dimoverride" for the current dimstyle is just a pipe dream?? :lmao:
-
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