Dwg2Bmp

Merhaba,
DWG dosyasını BMP dosyasına dönüştüren Makro Function'u
yeni oluşturulacak olan bmp dosyası
dwg dosyanızla aynı klasöre kayıt edilecektir.

Function Dwg2Bmp(DwgFullName As String)
Dim NewDwg As AcadDocument
Set NewDwg = Documents.Open(DwgFullName)

Dim DwgPath As String
Dim DwgName As String
DwgPath = ThisDrawing.Path
DwgName = Left(ThisDrawing.Name, (InStr(ThisDrawing.Name, ".dwg")) - 1)

Dim exportFile As String
exportFile = DwgPath & "\" & DwgName

Dim mode As Integer
Dim corner1(0 To 2) As Double
Dim corner2(0 To 2) As Double
Dim BlockSS As AcadSelectionSet

On Error Resume Next
Set BlockSS = ThisDrawing.SelectionSets("BlockSS")
If Err Then Set BlockSS = ThisDrawing.SelectionSets.Add("BlockSS")
BlockSS.Clear

mode = acSelectionSetCrossing
corner1(0) = ThisDrawing.Limits(0): corner1(1) = ThisDrawing.Limits(1): corner1(2) = 0
corner2(0) = ThisDrawing.Limits(2): corner2(1) = ThisDrawing.Limits(3): corner2(2) = 0

BlockSS.Select mode, corner1, corner2

ThisDrawing.Export exportFile, "bmp", BlockSS

BlockSS.Delete

NewDwg.Close

Set NewDwg = Nothing

End Function
Sub TestBmp()
Dwg2Bmp "C:\Documents and Settings\bla bla\My Documents\MyProgram\AutocadVBA\ElkBlock\Evaevienetanj.dwg"
Beep
End Sub

Ekler:
Dosya: Dwg2Bmp.zip
Dosya içeriği: Dwg2Bmp.bas

Kolay gelsin