Prompt box for file location

T

tractng

Guys,

I need help.

Scenerio:
The files are already opened by the user. Before the script is run, i
want to have a prompt box that prompts the user for the exact location
(that the file is going to be updated), where user can browser it to
find it. With that exact location, it goes into memory for the
following line (instead of hard coding)

Set oDoc1 = oApplication.Documents.ItemByName("C:\twd\Part1.ipt")

Somehow the code is reading more than the file name and path. Any way I
could just get the exact location"C:\twd\Part1.ipt"

It got to be this line here, but I am not sure how to trim it down (I
got the code from somebody).

OpenDlgName.lpstrFile = Space$(32766)

Complete Code Below
-------------------------------------
Option Explicit

Public Declare Function GetSaveFileName Lib _
"comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

Public Declare Function GetOpenFileName Lib _
"comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

Public Const OFN_HIDEREADONLY = &H4

Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String

End Type

Public OpenDlgName As OPENFILENAME
Public SaveDlgName As OPENFILENAME
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File open dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@

Public Function ShowOpen() As String
Dim strTemp As String
OpenDlgName.lStructSize = Len(OpenDlgName)
OpenDlgName.hwndOwner = ThisApplication.MainFrameHWND
'Set the filter here
OpenDlgName.lpstrFilter = "Text Files (*.ipt)" + _
Chr$(0) + "*.ipt" + Chr$(0)
OpenDlgName.lpstrFile = Space$(32766)
OpenDlgName.nMaxFile = 32767 '255
OpenDlgName.lpstrFileTitle = Space$(254)
OpenDlgName.nMaxFileTitle = 255
OpenDlgName.lpstrInitialDir = CurDir
'Dialog Title
OpenDlgName.lpstrTitle = "Open File Now"

'Set Flags... &H200 for Multi Select, &H80000 for Explorer, and
&H80200 for both
If GetOpenFileName(OpenDlgName) Then
strTemp = (Trim(OpenDlgName.lpstrFile))
ShowOpen = Mid(strTemp, 1, Len(strTemp) - 1)


End If
End Function

--------------------------------------------------

Sub Update1()

Dim sLocation As String
sLocation = OpenDlgName.lpstrFile

' Declare the Application object
Dim oApplication As Inventor.Application

' Obtain the Inventor Application object.
' This assumes Inventor is already running.
Set oApplication = GetObject(, "Inventor.Application")

' Set a reference to the active document.
' This assumes a document is open.

Dim oDoc As Document
Dim oDoc1 As Document

Set oDoc = oApplication.ActiveDocument
Set oDoc1 = oApplication.Documents.ItemByName("C:\twd\Part1.ipt")
'Set oDoc1 = oApplication.Documents.ItemByName(sLocation)

' Obtain the PropertySets collection object
'Dim oPropsets As PropertySets

Set oPropSets = oDoc.PropertySets
Set oPropsets1 = oDoc.PropertySets
Set oPropsets2 = oDoc1.PropertySets
Set oPropsets3 = oDoc1.PropertySets
Set oPropsets4 = oDoc1.PropertySets

' Get a reference to the "Description" property.
Dim oProp As Property
Dim oProp1 As Property
Dim oProp2 As Property
Dim oProp3 As Property

Dim vSubject As String
Dim vAuthor As Variant
Dim vManager As Variant
Dim vCompany As Variant

'==========================================================
'reading the current active file (value from property page)
'Summary tab

'reading the 'Title' field
vTitle =
oPropSets.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}").ItemByPropId(kTitleSummaryInformation).value

'reading the 'Subject' field
vSubject =
oPropsets1.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}").ItemByPropId(kSubjectSummaryInformation).value

'reading the 'Manager' field
vManager =
oPropsets1.Item("{D5CDD502-2E9C-101B-9397-08002B2CF9AE}").ItemByPropId(kManagerDocSummaryInformation).value

'reading the 'Company' field
vCompany =
oPropsets1.Item("{D5CDD502-2E9C-101B-9397-08002B2CF9AE}").ItemByPropId(kCompanyDocSummaryInformation).value


'reading the 'Author' field
vAuthor =
oPropsets1.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}").ItemByPropId(kAuthorSummaryInformation).value


'==========================================================
'writing to a non-active file,
'non-active file is in the background opened by the same program

'writing the 'Title' field to summary tab
Set oProp2 =
oPropsets2.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}").ItemByPropId(kTitleSummaryInformation)
oProp2.value = vTitle

'writing onto the Custom tab field from 'Manager' field
On Error Resume Next
Set oPropsets3 =
oDoc1.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
oPropsets3.Add vManager, "Color", 20

If Err Then
Set oPropsets3 =
oDoc1.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
oPropsets3.Add vManager, "Color", 20

End If

Set oPropsets3 =
oDoc1.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
oPropsets3.Add vManager, "Color", 20

' writing onto the Custom tab field from 'Company' field
On Error Resume Next
Set oPropsets4 =
oDoc1.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
oPropsets4.Add vCompany, "Compound #", 30

If Err Then
Set oPropsets4 =
oDoc1.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
oPropsets4.Add vCompany, "Compound #", 30
End If


'writing onto the Custom tab field from 'Author' field

On Error Resume Next
Set oPropsets2 =
oDoc1.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
oPropsets2.Add vAuthor, "Durometer", 40

If Err Then
Set oPropsets2 =
oDoc1.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
oPropsets2.Add vAuthor, "Durometer", 40
End If

'==========================================================
Dim oPdoc As PartDocument

Set oPdoc = oDoc1

'Dim oComp As ComponentDefinition
Set oComp = oPdoc.ComponentDefinition

Dim sTemp As String
Dim oMat As Material

On Error Resume Next

Set oMat = oPdoc.Materials(vSubject)

If Err Then

MsgBox "Material doesn't match! Must select manually from the
Physical tab", vbInformation, ""

Else

oPdoc.ComponentDefinition.Material = oMat

End If


End Sub





Thanks,
Tony
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top