Dwg2Jpg

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

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

Dim JpgName As String
JpgName = Left(DwgFullName, (InStr(DwgFullName, ".dwg")) - 1) & ".jpg"

Dim plotFileName As String
plotFileName = "PublishToWeb JPG.pc3"

Dim corner1(0 To 1) As Double
Dim corner2(0 To 1) As Double
corner1(0) = ThisDrawing.Limits(0): corner1(1) = ThisDrawing.Limits(1)
corner2(0) = ThisDrawing.Limits(2): corner2(1) = ThisDrawing.Limits(3)

ThisDrawing.ActiveLayout.CenterPlot = True
ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
ThisDrawing.ActiveLayout.SetWindowToPlot corner1, corner2
ThisDrawing.ActiveLayout.GetWindowToPlot corner1, corner2
ThisDrawing.ActiveLayout.PlotType = acWindow

Dim result As Boolean
result = ThisDrawing.Plot.PlotToFile(JpgName, plotFileName)

NewDwg.Close

Set NewDwg = Nothing
End Function

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

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

Kolay gelsin