DWG Props

Hi,

I got the xrecord code, that's all around here, to get and set dwgprops via VBA. But the only problem I come up with now:

For drawings in which the "dwgprops" command never has been run, the props are not accessable. Is there some code that I can add to the exsisting code to make sure the dwgprops dictionary is present?

Best regards,
Frank

 

Not sure what your end goal is but I created these two little apps that work
fine for getting and setting some dwg props. They use the DwgPropsX.dll
from CadWerx.net (much thanks to CadWerx - DocBar rocks!)

This the VB6 part that runs outside AutoCAD - I attached it to the
right-click menu for DWG files:
Sub form_load()
Dim intloc As Integer

Dim dwgProps As DWGPROPSXLib.Properties
Dim strFileName As String
Set dwgProps = New DWGPROPSXLib.Properties
'dwgProps.Load "H:\1997\97023\arch\c23af00g.dwg"

If Len(Command()) > 0 Then
strFileName = Command
End If

intloc = InStrRev(strFileName, "\") + 1
strFileName = Mid(strFileName, intloc)

If Len(strFileName) > 0 Then 'if there are no dwg props to display
dwgProps.Load strFileName
Else
'load the "N/A" props from this default file
dwgProps.Load "G:\Cad Standards\Hcyu
Standards\__HCYU\Blocks\DwgProps_NA.dwg"
End If
lblDwgName = (UCase(strFileName))

If Len(dwgProps.Title) > 0 Then
lblDwgTitle.Caption = (UCase(dwgProps.Title))
Else
lblDwgTitle.Caption = "N\A"
End If

If Len(dwgProps.Author) > 0 Then
lblUpdatedBy.Caption = (UCase(dwgProps.Author))
Else
lblUpdatedBy.Caption = "N\A"
End If

If Len(dwgProps.Comments) > 0 Then
tboxDwgComments.Text = (dwgProps.Comments)
Else
tboxDwgComments.Text = "No drawing summary data available"
End If

lblUpdatedOn.Caption = Mid((dwgProps.Custom(0)), 13)
'lblLastSavedBy.Caption = (UCase(dwgProps.LastSavedBy))
End Sub


Here's the VBA part that runs inside Autocad - I have it tied in with a
"drawing setup" VLISP routine:
Public infoSummary As AcadSummaryInfo
Public strDate As String

Private Sub cmdQwikUpdate_Click()
'***updates user name & "Last Update" date

Set infoSummary = ThisDrawing.SummaryInfo
strDate = Month(Date) & "." & Day(Date) & "." & Year(Date)

infoSummary.Author = UCase(Environ("username"))

On Error GoTo ADDINFO
infoSummary.RemoveCustomByKey "Last Update"

ADDINFO:
infoSummary.AddCustomInfo "Last Update", strDate

Unload frmDwgProps
'End
End Sub

Private Sub cmdFullUpdate_Click()
strDate = Month(Date) & "." & Day(Date) & "." & Year(Date)
Set infoSummary = ThisDrawing.SummaryInfo

infoSummary.Author = lblUpdatedBy.Caption

infoSummary.Title = tboxDwgTitle.Text

infoSummary.Comments = tboxDwgComments.Text

On Error GoTo ADDINFO
infoSummary.RemoveCustomByKey "Last Update"

ADDINFO:
infoSummary.AddCustomInfo "Last Update", lblDate.Caption