Tommy I can't send the actual drawing BUT here is the VBA Code, scroll all the way down to the bottom to see it. I am using 2005, and this is being implemented automatically without an actual drawing being open, just AutoCAD.Originally Posted by Tommy
[vba]Sub FixMyDXF()
Dim mPath As String, mFileName As String, mNewLyr As AcadLayer
Dim mDoc As AcadDocument, sset As AcadSelectionSet, mFxdNm As String
mPath = "D:\VBATEST\" ' dxf files here
mFileName = "*.dxf"
mFileName = Dir(mPath & mFileName)
While mFileName <> ""
Set mDoc = Application.Documents.Open(mPath & mFileName)
DeleteLayouts mDoc
' bellow code works
' I added New Text Style and then sets a new style
' for dimention text
Dim newTextStyle As AcadTextStyle
Set newTextStyle = ThisDrawing.TextStyles.Add("ARIAL")
ThisDrawing.ActiveTextStyle = newTextStyle
' End add text
' I added Set Font Type
Dim textStyle1 As AcadTextStyle
'Dim currFontFile As String
Dim newFontFile As String
Set textStyle1 = ThisDrawing.ActiveTextStyle
' Change the value for FontFile
newFontFile = "C:\Program Files\AutoCAD 2005\Fonts\arial.ttf"
textStyle1.fontFile = newFontFile
' End Set Font
'Set mNewLyr = mDoc.Layers.Add("LayerName")
'set layer attributes
'mNewLyr.color = acRed
'mNewLyr.Linetype = "CONTINUOUS"
' added dim style change
' ad_AddDimStyle
' This routine demonstrates how to add a new dimension style and define
' its various properties.
' It was developed for AutoCAD 2000 and above.
' Demand load: -vbarun;ad_AddDimStyle.dvb!ad_AddDimStyle;
' version 1.00
'
' Copyright?2000-2006 ActiveDwg.com
'
' This routine is provided for demonstration purposes only and must
' not be used for critical applications without your verification
' that this routine will perform as you intended.
' This routine may be freely utilized for your own personal use so long
' as the entire contents of this header remain intact.
' This routine is provided "as-is" and no declaration, written or implied,
' is made as to its reliability for any particular task. Any use of this
' routine is solely at your own risk.
'
Dim adDimStyle As AcadDimStyle
' Start Med
'Set adDimStyle = ThisDrawing.DimStyles.Add("adDimStyle")
Set adDimStyle = ThisDrawing.DimStyles.Add("Med 20-48 Inch")
ThisDrawing.ActiveDimStyle = adDimStyle
With ThisDrawing
'The first group defines overall and linear scale factors
.SetVariable "DimScale", 1 'Overall Scale Factor. Determined by 12/Scale Factor.
' 96 is for 1/8"=1'-0" so that 12/.125=96.
.SetVariable "DimLFac", 1 'Linear Scale Factor. '1'=1:1, '2'=2:1,'.5'=1:2, etc
'This group defines the typical dimension properties
.SetVariable "DimADec", 2 'Precision places for angular dimensions. May be 0-8.
.SetVariable "DimAso", 1 'Dimensional associativity. 0=off, 1=on. 0 'explodes' dimensions.
' DimAso is stored by drawing, not by style.
.SetVariable "DimASz", 1.25 'Arrowhead size for dimensions and leaders.
.SetVariable "DimAtFit", 3 'Defines placement of arrowheads and text if insufficient space for both.
' 0=both outside, 1=force arrows outside, 2=force text outside, 3=best fit.
.SetVariable "DimAUnit", 0 'Units for angular dimensions.
' 0=decimal degrees, 1=degrees/minutes/seconds, 2=gradians, 3=radians
.SetVariable "DimAZin", 3 'Zero suppression for angular dimensions.
' 0=display all leading and trailing zeros, 1=suppress leading zeros,
' 2=suppress trailing zeros, 3=suppress leading and trailing zeros
.SetVariable "DimBlk", "" 'Defines typical arrow type. ' "" '=Closed-Filled, '.'=none.
' Others are: '_ArchTick', '_BoxBlank', '_BoxFilled', '_Closed', '_ClosedBlank',
' '_DatumBlank', '_DatumFilled', '_Dot', '_DotSmall', '_DotBlank', '_Integral',
' '_None', '_Oblique', '_Origin', '_Origin2', '_Open', '_Open90', '_Open30', '_Small'.
.SetVariable "DimBlk1", "" 'Defines 1st arrow type if 'DimSAH is '1'. See 'DimBlk' for type list.
.SetVariable "DimBlk2", "" 'Defines 1st arrow type if 'DimSAH is '2'. See 'DimBlk' for type list.
.SetVariable "DimCen", 0.5 'Defines circle and arc center marks and lines. Show as mark size.
' 0=No marks, <0=centerlines are drawn, >0=centermarks are drawn.
.SetVariable "DimClrD", 160 'Color for dimlines, arrows, and leaders. 0=ByBlock, 256 = ByLayer, 1-255=color.
.SetVariable "DimClrE", 1 'Color for dimension extension lines. 0=ByBlock, 256 = ByLayer, 1-255=color.
.SetVariable "DimClrT", 7 'Color for dimension text. 0=ByBlock, 256 = ByLayer, 1-255=color.
.SetVariable "DimDec", 2 'Decimal precision for normal dimensions.
.SetVariable "DimDLE", 0 'For oblique marks in place of arrows: Distance dimlines extend beyond extension lines.
.SetVariable "DimDLI", 0.1 'Offset distance between dimension line rows.
.SetVariable "DimDSep", "." 'Decimal separator for decimal format dimensions.
.SetVariable "DimExe", 1.25 'Extension distance of extension lines beyond dimension lines.
.SetVariable "DimExO", 1.25 'Offset distance from dimension origin to extension line.
.SetVariable "DimFrac", 0 'Fraction format in fractional dimensions. 0=Horizontal, 1=diagonal, 2=not stacked.
.SetVariable "DimGap", 1.25 'Gap between dimlines and dimension text.
.SetVariable "DimJust", 0 'Dimension text horizontal position. 0=Centered between extension lines,
' 1=at 1st extension line, 2=at 2nd extension line, 3=above and at 1st extension line,
' 4=above and at 2nd extension line.
.SetVariable "DimLdrBlk", "" 'Defines leader arrow type. See DimBlk for type list.
.SetVariable "DimLim", 0 'Defines whether dimension limits are generated. 1=On, 0=Off.
.SetVariable "DimLUnit", 3 'Defines dimension unit types(except angular). 1=Scientific, 2=Decimal, 3=Engineering,
' 4=Architectural, 5=Fractional, 6=Windows default
.SetVariable "DimLwd", acLnWtByLayer 'Defines dimension line lineweight. 'ByBlock'=acLnWtByBlock, 'ByLayer'=acLnWtByLayer,
' also may be specified as millimeters WAS -2.
.SetVariable "DimLwe", acLnWtByLayer 'Defines extension line lineweight. 'ByBlock'=acLnWtByBlock, 'ByLayer'=acLnWtByLayer,
' also may be specified as millimeters WAS -2.
.SetVariable "DimPost", "" 'Defines dimension text prefix or suffix. Use brackets to specify prefix or suffix.
' '<>ft' will create a suffix of 'ft', while 'ft<>' will create a prefix of 'ft'.
.SetVariable "DimRnd", 0 'Defines precision for rounding dimensions. '.5' will round to nearest half.
.SetVariable "DimSAh", 0 'Defines arrowhead block display. 0=set per 'DIMBLK'(see 'DimLdrBlk' for list'),
' 1=sets arrowhead 1('DIMBLK1') independently of arrowhead 2('DIMBLK2')(see 'DimLdrBlk' for list').
.SetVariable "DimSD1", 0 'Defines display of 1st dimline and arrowhead. 0=Display, 1=Do not display.
.SetVariable "DimSD2", 0 'Defines display of 2nd dimline and arrowhead. 0=Display, 1=Do not display.
.SetVariable "DimSE1", 0 'Defines display of 1st extension line. 0=Display, 1=Do not display.
.SetVariable "DimSE2", 0 'Defines display of 2nd extension line. 0=Display, 1=Do not display.
.SetVariable "DimSho", 1 'Defines dynamic update of dimtext as defining points are dragged. 0=Update, 1=Do not update.
' DimSho is stored by drawing, not by style.
.SetVariable "DimSOXD", 0 'Defines whether dimlines are drawn outside of extension lines.
' 0=Drawn outside, 1=Not drawn outside.
.SetVariable "DimTAD", 0 'Dimension text vertical position. 0=Centered between extension lines,
' 1=above the dimension line, 2=dimensions placed on side of dimline away from defining points,
' 3=placed according to Japanese Industrial Standards.
.SetVariable "DimTIH", 1 'Defines position of dimtext between extension lines. 0=Align with dimline, 1=Always horizontal.
.SetVariable "DimTIX", 0 'Defines how text is placed between extension lines. 0=Between if fits, 1=Always between.
.SetVariable "DimTOFL", 0 'Defines how dimline is placed between extension lines. 0=In or out with arrowheads, 1=Always between.
.SetVariable "DimTOH", 1 'Defines position of dimtext outside extension lines. 0=Align with dimline, 1=Always horizontal.
.SetVariable "DimTSz", 0 'Defines size of Oblique strokes in place of arrowheads. 0=Draws arrowheads, >0=Oblique size.
.SetVariable "DimTVP", 0
.SetVariable "DimTxSty", "ARIAL"
.SetVariable "DimTxt", 1.25
.SetVariable "DimUPT", 1
.SetVariable "DimZIn", 12
'This group defines the Alternate dimension properties
.SetVariable "DimAlt", 1
.SetVariable "DimAltD", 2
.SetVariable "DimAltF", 1
.SetVariable "DimAltRnd", 0
.SetVariable "DimAltTD", 2
.SetVariable "DimAltTZ", 0
.SetVariable "DimAltU", 2
.SetVariable "DimAltZ", 0
.SetVariable "DimAPost", """"
'This group defines the Tolerance dimension properties
.SetVariable "DimTol", 0
.SetVariable "DimTDec", 2
.SetVariable "DimTFac", 1
.SetVariable "DimTM", 0
.SetVariable "DimTolJ", 1
.SetVariable "DimTP", 0
.SetVariable "DimTZin", 0
End With
adDimStyle.CopyFrom ThisDrawing
'End Add Med Dim Styles
Set sset = mDoc.SelectionSets.Add("TEST")
'ZoomExtents
'ZoomAll
mFxdNm = Replace(mPath & mFileName, ".DXF", "Rev")
mDoc.Export mFxdNm, "DXF", sset
mDoc.Close False
ZoomExtents
'copy new file over exist file
FileCopy mFxdNm & ".DXF", mPath & mFileName
'delete the new file
Kill mFxdNm & ".DXF"
Set mDoc = Nothing
Set mNewLyr = Nothing
mFileName = Dir
Wend
End Sub
'Below contributed by lucas
Sub DeleteLayouts(iDoc As AcadDocument)
Dim adLayout As AcadLayout
On Error Resume Next
If iDoc.ActiveSpace = acPaperSpace Then _
iDoc.ActiveSpace = acModelSpace
ZoomExtents
For Each adLayout In iDoc.Layouts
adLayout.Delete
'ZoomAll
Next adLayout
Err.Clear
On Error GoTo 0
End Sub
'*************************************************************************
' should change all objects to a single layer by Tommy VBAX
Sub ChnageAllToLyer()
Dim ssAll As AcadSelectionSet, mEntity As AcadEntity
Set ssAll = ThisDrawing.SelectionSets.Add("AllEntities")
ssAll.Select acSelectionSetAll
For Each mEntity In ssAll
mEntity.Layer = "0"
Next
ssAll.Clear
ssAll.Delete
Set ssAll = Nothing
ThisDrawing.Regen acActiveViewport
End Sub
'*************************************************************************[/vba]
Reply With Quote