Author Topic: Preview Of A Layout Tab  (Read 1622 times)

0 Members and 1 Guest are viewing this topic.

Harun KILIC

  • Guest
Preview Of A Layout Tab
« on: April 11, 2007, 01:35:09 PM »
If a dwg file saved when a layout tab was active, even if Acad it self can not show the thumbnail preview.
I set accuracy value to max level from Thumbnail Preview Settings in Acad2007, then able to get the preview.
But for each file I have to open it and  make this setting. Also earlier releases do not have this setting.

BUT, I need to get the preview of a Layout Tab in any dwg file as thumbnail, using VB6.0
Is it possible, is there anybody to inform me?
Thanks.
Really need help..

P.S.:
I'm using dwgthumbnail.ocx 2.0
I have performed a search in the forums but can not get something similar..
Thanks ASMI.. :-)

Guest

  • Guest
Re: Preview Of A Layout Tab
« Reply #1 on: April 11, 2007, 03:42:53 PM »
Maybe this will help??!?

Harun KILIC

  • Guest
Re: Preview Of A Layout Tab
« Reply #2 on: April 11, 2007, 10:52:58 PM »
Thanks. Using API..
It is just doing the same as the ocx file does. The problem is Acad sometimes misses something while saving preview info, then you have to open each file and resave it. No more chance I think..

But I could not succed to convert the code in order to paint inside an image or a picture object.. so it is not usefull for me in this condition.
Thanks a lot.

Code: [Select]
...
lngHwnd = FindWindow(vbNullString, Me.Caption)
lngDc = GetDC(lngHwnd)
'I thought this was a nice touch..
Me.Caption = strFile
'Clean any old paint off..
Me.Repaint
...

DaveW

  • Guest
Re: Preview Of A Layout Tab
« Reply #3 on: April 12, 2007, 12:23:33 AM »
Just open and save each file with VB. This should help you get the files (Credit to James Crowley for most of this code.):

Module stuff
Code: [Select]
Option Explicit


Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long
   



Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Public Type SHITEMID   'mkid
    cb As Long      'Size of the ID (including cb itself)
    abID As Byte   'The item ID (variable length)
End Type


Type ITEMIDLIST  'idl
    mkid As SHITEMID
End Type

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000



Private Declare Function apiGetSystemDirectory& Lib "Kernel32" _
        Alias "GetSystemDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long)

Private Declare Function apiGetWindowsDirectory& Lib "Kernel32" _
        Alias "GetWindowsDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long)


Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized
Private Const MAX_PATH As Integer = 255

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal Cx As Long, _
    ByVal Cy As Long, ByVal wFlags As Long) As Long


Form stuff
Code: [Select]
Option Explicit

Private Sub cmdIBrowse_Click()
  Dim selectFolder As String
  Dim bi As BROWSEINFO
  Dim idl As ITEMIDLIST
  Dim rtn&, pidl&, path$, pos%
  '  set the type of folder to return
  '  play with these option constants to see what can be returned
  bi.ulFlags = BIF_RETURNONLYFSDIRS  'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
 
  '  show the browse folder dialog
  pidl& = SHBrowseForFolder(bi)
 
  '  if displaying the return value, get the selected folder
 ' If Check1 Then
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
    If rtn& Then
     
      '  parce & display the folder selection
      pos% = InStr(path$, Chr$(0))

        selectFolder = Left(path$, pos - 1)
    Else
        selectFolder = ""
    End If
End Sub

Private Sub cmdOBrowse_Click()
  Dim selectFolder As String
  Dim bi As BROWSEINFO
  Dim idl As ITEMIDLIST
  Dim rtn&, pidl&, path$, pos%
  '  set the type of folder to return
  '  play with these option constants to see what can be returned
  bi.ulFlags = BIF_RETURNONLYFSDIRS  'BIF_RETURNFSANCESTORS 'BIF_BROWSEFORPRINTER + BIF_DONTGOBELOWDOMAIN
 
  '  show the browse folder dialog
  pidl& = SHBrowseForFolder(bi)
 
  '  if displaying the return value, get the selected folder
 ' If Check1 Then
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
    If rtn& Then
     
      '  parce & display the folder selection
      pos% = InStr(path$, Chr$(0))

        selectFolder = Left(path$, pos - 1)
    Else
        selectFolder = ""
    End If


End Sub
Private Sub cmdCancel_Click()

    Unload Me

End Sub

Private Sub cmdGO_Click()

Dim FileCountx As Integer
Dim FilesArray() As String
Dim inpath As String
Dim OutPath As String
Dim teststring1 As String
Dim teststring2 As String
Dim MyFilename As String
Dim MyOldFilename As String
Dim MyNewFilename As String
Dim AddText As String
Dim RemoveText As String


FilesArray = GetFiles(inpath)


FileCountx = -1

For FileCountx = LBound(FilesArray) To UBound(FilesArray)


MsgBox MyFilename
'open the file, set the active doc and save it, switch the active doc back, open the next and save and so on.
'you can add code to go to a layout in paperspace/modelspace, zoom extents, whatever you need.

Next




Unload Me


End Sub

Sub Main()


End Sub




Private Sub Form_Load()
Populate
End Sub
Private Sub Populate()

Dim S As String
Dim PathIName As String
Dim SlashPos As Integer
Dim PathOName As String
'add some form code here

       
End Sub

Function GetFiles(ByVal FullPath As String) As String()
 


Dim FileName As String

  Dim num_files As Integer

  num_files = -1
 
  Dim FilesArray() As String
  Dim file_name As String
 
  If Right(FullPath, 1) <> "\" Then FullPath = FullPath & "\"
  FullPath = FullPath & "*.*"
 
  file_name = Dir(FullPath, vbNormal)
  Do While Len(file_name) > 0
     If FileName <> "." And FileName <> ".." Then
        num_files = num_files + 1
        ReDim Preserve FilesArray(0 To num_files)
        FilesArray(num_files) = file_name
     End If
    ' Get the next file.
    file_name = Dir$()
  Loop
 
  GetFiles = FilesArray
 
  'the array is filled
 

End Function
« Last Edit: April 12, 2007, 12:34:36 AM by DaveW »