AutoCAD, AutoCAD Architecture (ACA/ADT), Revit Architecture, Revit MEP, Revit Structure, BIM, CAD, AutoLISP, VBA, VB, VB.NET, C#, databases, Access, SQL Server, FlexNet (FLEXlm), license usage reporting, software design, development, customization, integration...
Wednesday, April 26, 2006
Elliptical helix in AutoCAD 2007
Tuesday, April 25, 2006
AcroPDF.dll fix in Acrobat Reader 7.0.7
I've made a solution using the ActiveX AcroPDF.dll that comes free with Acrobat Reader to automate batch printing of PDF files in a more consistent way than selection a bunch of PDF files in Explorer right click and print that has problems with not all PDF's being printed or in a random order and sometimes the first file is not printed to fit the paper but was zoomed in quite a bit (a bug that seems to be related to versions 7.0.0 up to 7.0.7 but that worked using the COM object). I used
AxAcroPDF1.LoadFile("C:\test.pdf")
AxAcroPDF1.printAllFit(True)
and it worked on my PC for a while but then stopped working one day and I could not get it to work again. Adobe support confirmed to me that it was fixed in Acrobat 7.0.7 and that explained why it worked on some PC's but not on all. I had during the time tried installing older versions like Acrobat 5.0 and Acrobat 6.0 for other testing purposes and somehow that broke the fix even for 7.0.7 after a while. What helped was to completely uninstall every Adobe Acrobat and Acrobat Reader and clean up the registry.
I still get a dialog box saying "WARNING! A script has requested to print an Acrobat file. This could print an entire document. Do you want to proceed printing?" There is a checkbox to make this not show up but in versions before 7.0.7 it just made the application not print the PDF's at all. So finally I got to know why this happened.
One method to skip this question is to change the registry setting iWarnScriptPrintAll at
HKEY_CURRENT_USER\Software\Adobe\Acrobat Reader\7.0\AVAlert\cCheckbox\cEWH
to 1 (DWORD)
before launch of Reader so that the dialog is not displayed. Setting it to 0 will make Reader to show it again.
[HKEY_CURRENT_USER\Software\Adobe\Acrobat Reader\7.0\AVAlert\cCheckbox\cEWH]
"iWarnScriptPrintAll"=dword:00000001
Something that is more irritating and that I've not found an easy solution for (let me know if you find it) is that you cannot add a new command to the PDF extension. Try Tools>Folder Options>File Types>Advanced on the PDF and add a new action. Now right click on a PDF and see that it's not there. Go back and try to edit it. Not possible. I suspect that it's the PDF shell extension file pdfshell.dll that does this. Not kind at all.
You might as well run into this and I hope these notes can get help some of you.
Monday, April 24, 2006
Sheet Set Manager code snippets
' This will set all empty values to chr(160) in the active sheet set.
Sub EmptyAllSheetValuesToEmpty()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
Exit Sub
ElseIf i = 0 Then
MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
Exit Sub
End If
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Dim ss As AcSmSheetSet
If ssm Is Nothing Then
MsgBox "Something wrong here: 1", vbCritical
Exit Sub
End If
Set dbIter = ssm.GetDatabaseEnumerator
If dbIter Is Nothing Then
MsgBox "Something wrong here: 2", vbCritical
Exit Sub
End If
dbIter.Reset
'get the Database of the first sheetset
Set db = dbIter.Next
If db Is Nothing Then
MsgBox "No Sheet Set open", vbCritical
Exit Sub
End If
'get the sheetset
Set ss = db.GetSheetSet
If ss Is Nothing Then
MsgBox "Cannot get the Sheet Set", vbCritical
Exit Sub
End If
Set oSheetIter = ss.GetSheetEnumerator
If oSheetIter Is Nothing Then
Return
End If
' lock the database
Dim lockStatus As AcSmLockStatus
Let lockStatus = db.GetLockStatus
If lockStatus = AcSmLockStatus_UnLocked Then
db.LockDb db
Else
Dim sUserName As String
Dim sMachineName As String
db.GetLockOwnerInfo sUserName, sMachineName
MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
Exit Sub
End If
Debug.Print db.GetFileName
Dim compEnum As IAcSmEnumComponent
' get component enumerator
Set compEnum = ss.GetSheetEnumerator
Call LoopThroughSheets(compEnum)
' unlock the database
Call db.UnlockDb(db, True)
End Sub
Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
Dim comp As IAcSmComponent
Set comp = compEnum.Next()
' loop through till the component is Nothing
Do While Not comp Is Nothing
On Error Resume Next
Debug.Print comp.GetName & "," & comp.GetDesc
On Error GoTo 0
' if the component is a sheet, then...
If comp.GetTypeName = "AcSmSheet" Then
Dim s As AcSmSheet
Set s = comp
Dim propIter As IAcSmEnumProperty
Set propIter = comp.GetCustomPropertyBag.GetPropertyEnumerator
Dim propname As String
Dim propval As AcSmCustomPropertyValue
Do While True
Set propval = Nothing
propname = ""
propIter.Next propname, propval
If propname = "" Then Exit Do
If Not IsEmpty(propval) And Not IsObject(propval) Then
If propval.GetFlags = CUSTOM_SHEET_PROP Then
If IsEmpty(propval.GetValue) Then
Dim oProjNum As New AcSmCustomPropertyValue
PropFlag = CUSTOM_SHEET_PROP
oProjNum.InitNew comp
oProjNum.SetFlags PropFlag
oProjNum.SetValue Chr(160)
comp.GetCustomPropertyBag.SetProperty propname, oProjNum
Set oProjNum = Nothing
End If
End If
End If
Loop
' if the componnet is a subset then ...
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
' loop through all the sheets.
Call LoopThroughSheets(sset.GetSheetEnumerator)
End If
' next
Set comp = compEnum.Next()
Loop
End Sub
modCustSheetSetProperties
' This works on Sheet Set level. Not on Sheet level
' It iterates through the Custom Properties
Private Sub GetCustSheetProp()
Dim oSSM As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Dim oSheetSetDb As AcSmDatabase
Dim oSheetSet As AcSmSheetSet
On Error GoTo ErrHandler
If oSSM Is Nothing Then
Return
End If
Set dbIter = oSSM.GetDatabaseEnumerator
If dbIter Is Nothing Then
Return
End If
dbIter.Reset
'get the Database of the first sheetset
Set db = dbIter.Next
If db Is Nothing Then
Return
End If
'get the sheetset
Set oSheetSet = db.GetSheetSet
If oSheetSet Is Nothing Then
Return
End If
Set oSheetIter = oSheetSet.GetSheetEnumerator
If oSheetIter Is Nothing Then
Return
End If
'lock db
Dim lockStatus As AcSmLockStatus
Let lockStatus = db.GetLockStatus
If lockStatus = AcSmLockStatus_UnLocked Then
db.LockDb db
End If
Debug.Print oSheetSet.GetName
Debug.Print oSheetSet.GetDesc
Dim propIter As IAcSmEnumProperty
Set propIter = oSheetSet.GetCustomPropertyBag.GetPropertyEnumerator
Dim propname As String
Dim propval As AcSmCustomPropertyValue
Do While True
Set propval = Nothing
propname = ""
propIter.Next propname, propval
Set propval = Nothing
Set propval = oSheetSet.GetCustomPropertyBag.GetProperty(propname)
Debug.Print "Sheet Set Property: " & propname & " : " & propval.GetValue
If propname = "" Then Exit Do
If Not IsEmpty(propval) And Not IsObject(propval) Then
If propval.GetFlags = CUSTOM_SHEET_PROP Then
Debug.Print "Sheet Property: " & propname & " : " & propval.GetValue
' remove 01-Document Number
If propval.GetValue = "01-Document Number" Then
Dim oProp2 As New AcSmCustomPropertyValue
Set oProp2 = Nothing
PropFlag = CUSTOM_SHEET_PROP
oProp2.InitNew comp
oProp2.SetFlags PropFlag
oProp2.SetValue Null
' Remove this property by setting it to Null
comp.GetCustomPropertyBag.SetProperty "01-Document Number", oProp2
Set oProp2 = Nothing
End If
End If
End If
Loop
GoSub Cleanup
Exit Sub
Cleanup:
db.UnlockDb db
Set oSheetSet = Nothing
Set oSheetSetDb = Nothing
Return
ErrHandler:
GoSub Cleanup
End Sub
modAddSheetSetProperty
' Add a new Sheet Set property to all sheets in the current Sheet Set
Sub AddSheetSetProperty()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
Exit Sub
ElseIf i = 0 Then
MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
Exit Sub
End If
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Dim ss As AcSmSheetSet
If ssm Is Nothing Then
MsgBox "Something wrong here: 1", vbCritical
Exit Sub
End If
Set dbIter = ssm.GetDatabaseEnumerator
If dbIter Is Nothing Then
MsgBox "Something wrong here: 2", vbCritical
Exit Sub
End If
dbIter.Reset
'get the Database of the first sheetset
Set db = dbIter.Next
If db Is Nothing Then
MsgBox "No Sheet Set open", vbCritical
Exit Sub
End If
'get the sheetset
Set ss = db.GetSheetSet
If ss Is Nothing Then
MsgBox "Cannot get the Sheet Set", vbCritical
Exit Sub
End If
Set oSheetIter = ss.GetSheetEnumerator
If oSheetIter Is Nothing Then
Return
End If
' lock the database
Dim lockStatus As AcSmLockStatus
Let lockStatus = db.GetLockStatus
If lockStatus = AcSmLockStatus_UnLocked Then
db.LockDb db
Else
Dim sUserName As String
Dim sMachineName As String
db.GetLockOwnerInfo sUserName, sMachineName
MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
Exit Sub
End If
Debug.Print db.GetFileName
Dim compEnum As IAcSmEnumComponent
' get component enumerator
Set compEnum = ss.GetSheetEnumerator
Call LoopThroughSheets(compEnum)
' unlock the database
Call db.UnlockDb(db, True)
End Sub
Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
Dim comp As IAcSmComponent
Set comp = compEnum.Next()
' loop through till the component is Nothing
Do While Not comp Is Nothing
On Error Resume Next
Debug.Print comp.GetName & "," & comp.GetDesc
On Error GoTo 0
' if the component is a sheet, then...
If comp.GetTypeName = "AcSmSheet" Then
Dim oProp As New AcSmCustomPropertyValue
PropFlag = CUSTOM_SHEET_PROP
oProp.InitNew comp
oProp.SetFlags PropFlag
oProp.SetValue Chr(160)
comp.GetCustomPropertyBag.SetProperty "04-Doc Description", oProp
Set oProp = Nothing
' if the componnet is a subset then ...
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
' loop through all the sheets.
Call LoopThroughSheets(sset.GetSheetEnumerator)
End If
' next
Set comp = compEnum.Next()
Loop
End Sub
modRenameSSProperty
' Rename Sheet Set property to all sheets in the current Sheet Set
Sub unlockss()
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Set dbIter = ssm.GetDatabaseEnumerator
Set db = dbIter.Next
Call db.UnlockDb(db, True)
End Sub
Sub RenameSheetSetProperty()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
Exit Sub
ElseIf i = 0 Then
MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
Exit Sub
End If
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Dim ss As AcSmSheetSet
If ssm Is Nothing Then
MsgBox "Something wrong here: 1", vbCritical
Exit Sub
End If
Set dbIter = ssm.GetDatabaseEnumerator
If dbIter Is Nothing Then
MsgBox "Something wrong here: 2", vbCritical
Exit Sub
End If
dbIter.Reset
'get the Database of the first sheetset
Set db = dbIter.Next
If db Is Nothing Then
MsgBox "No Sheet Set open", vbCritical
Exit Sub
End If
'get the sheetset
Set ss = db.GetSheetSet
If ss Is Nothing Then
MsgBox "Cannot get the Sheet Set", vbCritical
Exit Sub
End If
Set oSheetIter = ss.GetSheetEnumerator
If oSheetIter Is Nothing Then
Return
End If
' lock the database
Dim lockStatus As AcSmLockStatus
Let lockStatus = db.GetLockStatus
If lockStatus = AcSmLockStatus_UnLocked Then
db.LockDb db
Else
Dim sUserName As String
Dim sMachineName As String
db.GetLockOwnerInfo sUserName, sMachineName
MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
Exit Sub
End If
Debug.Print db.GetFileName
Dim compEnum As IAcSmEnumComponent
' get component enumerator
Set compEnum = ss.GetSheetEnumerator
Call LoopThroughSheets(compEnum)
' unlock the database
Call db.UnlockDb(db, True)
End Sub
Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
Dim comp As IAcSmComponent
Set comp = compEnum.Next()
' loop through till the component is Nothing
Do While Not comp Is Nothing
On Error Resume Next
Debug.Print comp.GetName & "," & comp.GetDesc
On Error GoTo 0
' if the component is a sheet, then...
If comp.GetTypeName = "AcSmSheet" Then
Dim propval As AcSmCustomPropertyValue
Set propval = Nothing
Set propval = comp.GetCustomPropertyBag.GetProperty("04-Document Subtitle")
sOld = propval.GetValue
Set propval = Nothing
Dim oProp As New AcSmCustomPropertyValue
PropFlag = CUSTOM_SHEET_PROP
oProp.InitNew comp
oProp.SetFlags PropFlag
oProp.SetValue sOld
comp.GetCustomPropertyBag.SetProperty "04-Doc Subtitle", oProp
Set oProp = Nothing
' if the componnet is a subset then ...
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
' loop through all the sheets.
Call LoopThroughSheets(sset.GetSheetEnumerator)
End If
' next
Set comp = compEnum.Next()
Loop
End Sub
modSetCustSheetSetProperty
Dim propvalue As String
Dim propname As String
Sub unlockdbnow()
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Dim ss As AcSmSheetSet
Set dbIter = ssm.GetDatabaseEnumerator
Set db = dbIter.Next
' unlock the database
Call db.UnlockDb(db, True)
End Sub
Sub CheckAndCorrectSSProperties()
propvalue = "0"
propname = "10-Last Revision GNETA"
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
Exit Sub
ElseIf i = 0 Then
MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
Exit Sub
End If
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Dim ss As AcSmSheetSet
If ssm Is Nothing Then
MsgBox "Something wrong here: 1", vbCritical
Exit Sub
End If
Set dbIter = ssm.GetDatabaseEnumerator
If dbIter Is Nothing Then
MsgBox "Something wrong here: 2", vbCritical
Exit Sub
End If
dbIter.Reset
'get the Database of the first sheetset
Set db = dbIter.Next
If db Is Nothing Then
MsgBox "No Sheet Set open", vbCritical
Exit Sub
End If
'get the sheetset
Set ss = db.GetSheetSet
If ss Is Nothing Then
MsgBox "Cannot get the Sheet Set", vbCritical
Exit Sub
End If
Set oSheetIter = ss.GetSheetEnumerator
If oSheetIter Is Nothing Then
Return
End If
' lock the database
Dim lockStatus As AcSmLockStatus
Let lockStatus = db.GetLockStatus
If lockStatus = AcSmLockStatus_UnLocked Then
db.LockDb db
Else
Dim sUserName As String
Dim sMachineName As String
db.GetLockOwnerInfo sUserName, sMachineName
MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
Exit Sub
End If
Debug.Print db.GetFileName
Dim compEnum As IAcSmEnumComponent
' get component enumerator
Set compEnum = ss.GetSheetEnumerator
Call LoopThroughSheets(compEnum)
' unlock the database
Call db.UnlockDb(db, True)
End Sub
Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
Dim comp As IAcSmComponent
Set comp = compEnum.Next()
' loop through till the component is Nothing
Do While Not comp Is Nothing
' if the component is a sheet, then...
If comp.GetTypeName = "AcSmSheet" Then
Dim s As AcSmSheet
Set s = comp
Dim propval1 As AcSmCustomPropertyValue
Dim prop1 As String
Set propval1 = Nothing
Set propval1 = s.GetCustomPropertyBag.GetProperty(propname)
If propval1 Is Nothing Then
' The property doesn't exist
Exit Sub
End If
Set propval1 = Nothing
Dim propval As New AcSmCustomPropertyValue
Dim bag As IAcSmCustomPropertyBag
Set bag = s.GetCustomPropertyBag
PropFlag = CUSTOM_SHEET_PROP
propval.InitNew bag
propval.SetFlags PropFlag
propval.SetValue propvalue
bag.SetProperty propname, propval
Set propval = Nothing
' if the component is a subset then ...
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
' loop through all the sheets.
Call LoopThroughSheets(sset.GetSheetEnumerator)
End If
' next
Set comp = compEnum.Next()
Loop
End Sub
modCheckAndCorrectSSProperties
' This will check the active sheet set.
' "Sheet number" is overriding the "01-Document Number"
' "Sheet title" is overriding the "03-Document Title"
Sub CheckAndCorrectSSProperties()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
Exit Sub
ElseIf i = 0 Then
MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
Exit Sub
End If
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Dim ss As AcSmSheetSet
If ssm Is Nothing Then
MsgBox "Something wrong here: 1", vbCritical
Exit Sub
End If
Set dbIter = ssm.GetDatabaseEnumerator
If dbIter Is Nothing Then
MsgBox "Something wrong here: 2", vbCritical
Exit Sub
End If
dbIter.Reset
'get the Database of the first sheetset
Set db = dbIter.Next
If db Is Nothing Then
MsgBox "No Sheet Set open", vbCritical
Exit Sub
End If
'get the sheetset
Set ss = db.GetSheetSet
If ss Is Nothing Then
MsgBox "Cannot get the Sheet Set", vbCritical
Exit Sub
End If
Set oSheetIter = ss.GetSheetEnumerator
If oSheetIter Is Nothing Then
Return
End If
' lock the database
Dim lockStatus As AcSmLockStatus
Let lockStatus = db.GetLockStatus
If lockStatus = AcSmLockStatus_UnLocked Then
db.LockDb db
Else
Dim sUserName As String
Dim sMachineName As String
db.GetLockOwnerInfo sUserName, sMachineName
MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
Exit Sub
End If
Debug.Print db.GetFileName
Dim compEnum As IAcSmEnumComponent
' get component enumerator
Set compEnum = ss.GetSheetEnumerator
Call LoopThroughSheets(compEnum)
' unlock the database
Call db.UnlockDb(db, True)
End Sub
Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
Dim comp As IAcSmComponent
Set comp = compEnum.Next()
' loop through till the component is Nothing
Do While Not comp Is Nothing
' if the component is a sheet, then...
If comp.GetTypeName = "AcSmSheet" Then
Dim s As AcSmSheet
Set s = comp
Dim sNumber As String
Dim sTitle As String
sNumber = s.GetNumber
sTitle = s.GetTitle
If sNumber = "" Then sNumber = Chr(160)
If sTitle = "" Then sTitle = Chr(160)
Dim propval As New AcSmCustomPropertyValue
Dim bag As IAcSmCustomPropertyBag
Set bag = s.GetCustomPropertyBag
PropFlag = CUSTOM_SHEET_PROP
propval.InitNew bag
propval.SetFlags PropFlag
propval.SetValue sNumber
bag.SetProperty "01-Document Number", propval
Set propval = Nothing
Set bag = s.GetCustomPropertyBag
propval.InitNew bag
propval.SetFlags PropFlag
propval.SetValue sTitle
bag.SetProperty "03-Document Title", propval
Set propval = Nothing
' if the component is a subset then ...
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
' loop through all the sheets.
Call LoopThroughSheets(sset.GetSheetEnumerator)
End If
' next
Set comp = compEnum.Next()
Loop
End Sub
modCurrentSheet
Private Function GetDictXrecValue(DictName As String, XrecName As String)
On Error GoTo err_label
Dim oDict As AcadDictionary
Dim oXRec As AcadXRecord
Dim dxfCode, dxfData
Set oDict = ThisDrawing.Dictionaries.item(DictName)
Set oXRec = oDict.item(XrecName)
oXRec.GetXRecordData dxfCode, dxfData
GetDictXrecValue = dxfData(0)
Exit Function
err_label:
GetDictXrecValue = Null
End Function
Private Function GetCurrentSheetDwgName() As String
On Error Resume Next
GetCurrentSheetDwgName = GetDictXrecValue("AcSheetSetData", "SheetDwgName")
End Function
Private Function GetCurrentLayoutName() As String
On Error Resume Next
GetCurrentLayoutName = GetDictXrecValue("AcSheetSetData", "LayoutName")
End Function
Private Function GetShSetFileName() As String
On Error Resume Next
GetShSetFileName = GetDictXrecValue("AcSheetSetData", "ShSetFileName")
End Function
Public Function SheetDwgNameOK() As Boolean
SheetDwgNameOK = (UCase(ThisDrawing.FullName) = UCase(GetCurrentSheetDwgName))
End Function
Private Sub test()
Debug.Print GetCurrentLayoutName
Debug.Print GetCurrentSheetDwgName
Debug.Print SheetDwgNameOK
Debug.Print GetShSetFileName
End Sub
Public Sub WriteXRec()
Dim oDict As AcadDictionary
Dim oXRec As AcadXRecord
Dim dxfCode(0 To 1) As Integer
Dim dxfData(0 To 1)
Set oDict = ThisDrawing.Dictionaries.Add("SampleTest")
Set oXRec = oDict.AddXRecord("Record1")
dxfCode(0) = 1: dxfData(0) = "First Value"
dxfCode(1) = 2: dxfData(1) = "Second Value"
oXRec.SetXRecordData dxfCode, dxfData
End Sub
Public Sub ReadXRec()
Dim oDict As AcadDictionary
Dim oXRec As AcadXRecord
Dim dxfCode, dxfData
Set oDict = ThisDrawing.Dictionaries.item("SampleTest")
Set oXRec = oDict.item("Record1")
oXRec.GetXRecordData dxfCode, dxfData
Debug.Print dxfData(0) & vbCrLf & dxfData(1)
End Sub
Sub TestNotWorking()
Dim ssm As New AcSmSheetSetMgr
Dim ss As AcSmSheetSet
Dim ss2 As AcSmSheetSet
Dim oSheetIter As IAcSmEnumComponent
Set ss2 = ssm.GetParentSheetSet(ThisDrawing.FullName, ThisDrawing.ActiveLayout.name, ss)
Debug.Print ss.GetName
Set ss = Nothing
Set ss2 = Nothing
Set ssm = Nothing
End Sub
modDeleteSSProperty
' Delete Sheet Set property to all sheets in the current Sheet Set
Sub unlockss()
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Set dbIter = ssm.GetDatabaseEnumerator
Set db = dbIter.Next
Call db.UnlockDb(db, True)
End Sub
Sub DeleteSheetSetProperty()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
Exit Sub
ElseIf i = 0 Then
MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
Exit Sub
End If
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As IAcSmDatabase
Dim ss As AcSmSheetSet
If ssm Is Nothing Then
MsgBox "Something wrong here: 1", vbCritical
Exit Sub
End If
Set dbIter = ssm.GetDatabaseEnumerator
If dbIter Is Nothing Then
MsgBox "Something wrong here: 2", vbCritical
Exit Sub
End If
dbIter.Reset
'get the Database of the first sheetset
Set db = dbIter.Next
If db Is Nothing Then
MsgBox "No Sheet Set open", vbCritical
Exit Sub
End If
'get the sheetset
Set ss = db.GetSheetSet
If ss Is Nothing Then
MsgBox "Cannot get the Sheet Set", vbCritical
Exit Sub
End If
Set oSheetIter = ss.GetSheetEnumerator
If oSheetIter Is Nothing Then
Return
End If
' lock the database
Dim lockStatus As AcSmLockStatus
Let lockStatus = db.GetLockStatus
If lockStatus = AcSmLockStatus_UnLocked Then
db.LockDb db
Else
Dim sUserName As String
Dim sMachineName As String
db.GetLockOwnerInfo sUserName, sMachineName
MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
Exit Sub
End If
Dim compEnum As IAcSmEnumComponent
' get component enumerator
Set compEnum = ss.GetSheetEnumerator
Call LoopThroughSheets(compEnum)
' unlock the database
Call db.UnlockDb(db, True)
End Sub
Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
Dim comp As IAcSmComponent
Set comp = compEnum.Next()
' loop through till the component is Nothing
Do While Not comp Is Nothing
' if the component is a sheet, then...
If comp.GetTypeName = "AcSmSheet" Then
Debug.Print comp.GetName & "," & comp.GetDesc
Dim oProp2 As New AcSmCustomPropertyValue
PropFlag = CUSTOM_SHEET_PROP
oProp2.InitNew comp
oProp2.SetFlags PropFlag
oProp2.SetValue Null
' Remove this property by setting it to Null
comp.GetCustomPropertyBag.SetProperty "01-Document Number", oProp2
Set oProp2 = Nothing
' if the componnet is a subset then ...
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
' loop through all the sheets.
Call LoopThroughSheets(sset.GetSheetEnumerator)
End If
' next
Set comp = compEnum.Next()
Loop
End Sub
modSSM
Public Function SheetSetsOpen() As Integer
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As AcSmDatabase
Dim i As Integer
Set dbIter = ssm.GetDatabaseEnumerator
dbIter.Reset
Set db = dbIter.Next
i = 0
Do While Not db Is Nothing
i = i + 1
Set db = Nothing
Set db = dbIter.Next
Loop
SheetSetsOpen = i
End Function
' List the Sheet Selections that exists in the current Sheet Set
Sub ListSheetSelections()
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As AcSmDatabase
Dim ss As AcSmSheetSet
Dim sheetSelSet As IAcSmSheetSelSet
Dim sheetSelSetsEnum As IAcSmEnumSheetSelSet
Set dbIter = ssm.GetDatabaseEnumerator
dbIter.Reset
Set db = dbIter.Next
Set ss = db.GetSheetSet
Set sheetSelSetsEnum = ss.GetSheetSelSets.GetEnumerator
Set sheetSelSet = sheetSelSetsEnum.Next
Do While Not sheetSelSet Is Nothing
Debug.Print sheetSelSet.GetName
Set sheetSelSet = Nothing
Set sheetSelSet = sheetSelSetsEnum.Next
Loop
End Sub
' List the Sheet Selections that exists in the current Sheet Set and the Sheets and Subsets
Sub ListSheetSelectionsAndContent()
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As AcSmDatabase
Dim ss As AcSmSheetSet
Dim sheetSelSet As IAcSmSheetSelSet
Dim sheetSelSetsEnum As IAcSmEnumSheetSelSet
Dim sheetSelSetEnum As IAcSmEnumComponent
Dim item As IAcSmPersist
Dim oSubSet As AcSmSubset
Dim oSheet As AcSmSheet
Set dbIter = ssm.GetDatabaseEnumerator
dbIter.Reset
Set db = dbIter.Next
Set ss = db.GetSheetSet
Set sheetSelSetsEnum = ss.GetSheetSelSets.GetEnumerator
Set sheetSelSet = sheetSelSetsEnum.Next
Do While Not sheetSelSet Is Nothing
Debug.Print "Sheet Selection: " & sheetSelSet.GetName
Set sheetSelSetEnum = sheetSelSet.GetEnumerator
sheetSelSetEnum.Reset
Set item = sheetSelSetEnum.Next
Do While Not item Is Nothing
If item.GetTypeName = "AcSmSubset" Then
Set oSubSet = item
Debug.Print " Subset: " & oSubSet.GetName
ElseIf item.GetTypeName = "AcSmSheet" Then
Set oSheet = item
Debug.Print " Sheet: " & oSheet.GetName
End If
Set item = Nothing
Set item = sheetSelSetEnum.Next
Loop
Set sheetSelSet = Nothing
Set sheetSelSet = sheetSelSetsEnum.Next
Loop
End Sub
' List the Sheet Selections that exists in the current Sheet Set and the Sheets and Subsets
' It also list the sheets that are in the subsets
Sub ListSheetSelectionsAndContent2()
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As AcSmDatabase
Dim ss As AcSmSheetSet
Dim sheetSelSet As IAcSmSheetSelSet
Dim sheetSelSetsEnum As IAcSmEnumSheetSelSet
Dim sheetSelSetEnum As IAcSmEnumComponent
Dim item As IAcSmPersist
Dim oSubSet As AcSmSubset
Dim oSheet As AcSmSheet
Set dbIter = ssm.GetDatabaseEnumerator
dbIter.Reset
Set db = dbIter.Next
db.LockDb db
Set ss = db.GetSheetSet
Set sheetSelSetsEnum = ss.GetSheetSelSets.GetEnumerator
Set sheetSelSet = sheetSelSetsEnum.Next
Do While Not sheetSelSet Is Nothing
Debug.Print "Sheet Selection: " & sheetSelSet.GetName
If sheetSelSet.GetName = "SCRIPT" Then
Set sheetSelSetEnum = sheetSelSet.GetEnumerator
sheetSelSetEnum.Reset
Set item = sheetSelSetEnum.Next
Do While Not item Is Nothing
If item.GetTypeName = "AcSmSubset" Then
Set oSubSet = item
Debug.Print " Subset: " & oSubSet.GetName
Dim compEnum As IAcSmEnumComponent
' get component enumerator
Set compEnum = oSubSet.GetSheetEnumerator
LoopThroughSheets compEnum
ElseIf item.GetTypeName = "AcSmSheet" Then
Set oSheet = item
Debug.Print " Sheet: " & oSheet.GetName
ChangeProperties "17-Approved", "JIMMY BERGMARK", oSheet
End If
Set item = Nothing
Set item = sheetSelSetEnum.Next
Loop
End If
Set sheetSelSet = Nothing
Set sheetSelSet = sheetSelSetsEnum.Next
Loop
Call db.UnlockDb(db, True)
End Sub
Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
Dim comp As IAcSmComponent
Set comp = compEnum.Next()
' loop through till the component is Nothing
Do While Not comp Is Nothing
' if the component is a sheet, then...
If comp.GetTypeName = "AcSmSheet" Then
Dim s As AcSmSheet
Set s = comp
Debug.Print " Sheet: " & s.GetName
ChangeProperties "17-Approved", "JIMMY BERGMARK", s
' Debug.Print s.GetLayout.GetFileName
' if the componnet is a subset then ...
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
' loop through all the sheets.
Call LoopThroughSheets(sset.GetSheetEnumerator)
End If
' next
Set comp = compEnum.Next()
Loop
End Sub
Private Sub ChangeProperties(sProperty As String, sValue As String, ByVal oSheet As AcSmSheet)
Dim propval As New AcSmCustomPropertyValue
Dim bag As IAcSmCustomPropertyBag
Set bag = oSheet.GetCustomPropertyBag
PropFlag = CUSTOM_SHEET_PROP
propval.InitNew bag
propval.SetFlags PropFlag
propval.SetValue sValue
bag.SetProperty sProperty, propval
Set propval = Nothing
Set bag = Nothing
End Sub
modSSMChangeNumberTitle
Dim ssm As ACSMCOMPONENTS16Lib.AcSmSheetSetMgr
Dim db As AcSmDatabase
Dim ss As AcSmSheetSet
Sub changeNameNumber()
Set ssm = CreateObject("AcSmComponents.AcSmSheetSetMgr")
' open the database
Set db = ssm.OpenDatabase("C:\Program Files\AutoCAD 2005\Sample\Sheet Sets\Architectural\IRD Addition.dst", True)
' lock the database
Call db.LockDb(db)
' get the sheetset
Set ss = db.GetSheetSet
Dim compEnum As IAcSmEnumComponent
' get component enumerator
Set compEnum = ss.GetSheetEnumerator
Call LoopThroughSheets(compEnum)
' unlock the database
Call db.UnlockDb(db, True)
' close
Call ssm.Close(db)
End Sub
Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
Dim comp As IAcSmComponent
Set comp = compEnum.Next()
' loop through till the component is Nothing
Do While Not comp Is Nothing
On Error Resume Next
Debug.Print comp.GetName & "," & comp.GetDesc
On Error GoTo 0
' if the component is a sheet, then...
If comp.GetTypeName = "AcSmSheet" Then
Dim s As AcSmSheet
Set s = comp
' set the new number
s.SetNumber "0000"
' set the new name
s.SetTitle "MySheet"
' if the componnet is a subset then ...
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
' loop through all the sheets.
Call LoopThroughSheets(sset.GetSheetEnumerator)
End If
' next
Set comp = compEnum.Next()
Loop
End Sub
modWhoIsLockingSS
' Show who is locking the Sheet Set
' Doesn't seem to work because when db is nothing it is locked and it cannot get the lock owner info
Sub WhoIsLocking()
Dim ssm As New AcSmSheetSetMgr
Dim dbIter As IAcSmEnumDatabase
Dim db As AcSmDatabase
Dim sUserName As String
Dim sMachineName As String
Set dbIter = ssm.GetDatabaseEnumerator
dbIter.Reset
Set db = dbIter.Next
Do While Not db Is Nothing
Dim lockStatus As AcSmLockStatus
lockStatus = db.GetLockStatus
If lockStatus = AcSmLockStatus_Locked_Remote Then
Dim ss As AcSmSheetSet
Dim ssn As String
Set ss = db.GetSheetSet
ssn = ss.GetName
db.GetLockOwnerInfo sUserName, sMachineName
MsgBox "The Sheet Set '" & ssn & "' is locked by " & sUserName & " at " & sMachineName, vbExclamation
End If
Debug.Print db.GetFileName
Set db = Nothing
Set db = dbIter.Next
Loop
Set dbIter = Nothing
End Sub
Friday, April 21, 2006
DWG TrueView 2007 major problems
There are some serious problems with the newly released DWG TrueView 2007 with support for AutoCAD\ADT DWG 2007 files that I recently blogged about.
You only have the chance once to make DWG TrueView use hardware acceleration and after that you cannot make changes because there is no way to start the dialog box other than with this registry hack. Change the value of the registry key below to 0 (zero) to be able to get the Performance Tuner notification. Then you can right click on the icon and select Launch Tuning dialog.
HKEY_CURRENT_USER\Software\Autodesk\DWG TrueView\R3\DWGVIEWR-5001:409\3DGS Configuration\GSHEIDI10\FirstRun
If you have multiple users using a PC or multiple login accounts DWG TrueView does not play well.
Secondary install is started if a new windows user logs in and starts to use DWG TrueView for the first time. The problem with that are many.
First this comes up: --------------------------- DWG TrueView --------------------------- This version of DWG TrueView was not installed properly and some features may not run correctly. You should reinstall DWG TrueView immediately to make sure all features are working properly. Do you wish to continue anyway? --------------------------- Yes No --------------------------- Selecting No gives: --------------------------- DWG TrueView Error Aborting --------------------------- FATAL ERROR: Unhandled e06d7363h Exception at 7c81eb33h --------------------------- OK --------------------------- Selecting Yes gives: --------------------------- DWG TrueView --------------------------- Unable to load profile file. Some profile information saved in last session may not be restored. --------------------------- OK --------------------------- If you launch the tuning dialog box the following error comes up several times: --------------------------- DWG TrueView --------------------------- Please enter an integer between 1 and 60. --------------------------- OK --------------------------- If you start Tools>Options DWG TrueView locks up completely If you then try to start by double-clicking a dwg file you might get this one: --------------------------- DWG TrueView Error Aborting --------------------------- FATAL ERROR: Unhandled Access Violation Reading 0x0020 Exception at 7cb4e1h --------------------------- OK ---------------------------
The only solution is to uninstall and install again. And if another user logs into the PC uninstall and install is again needed (reinstall or repair doesn't help). If the user account does not have administrative rights to install DWG TrueView will hardly work at all. For example Power Users.
As soon as I find or is notified about a solution to these problems I will post about it. Until then I will not install DWG TrueView unless really needed.Wednesday, April 19, 2006
Facility of the Year Award
"The reason for Baxter/Pharmadule winning was innovation - there were two other facilities that were really awesome but our modular approach was the innovation they thought has made the best contribution to the pharmaceutical industry this year when it comes to production facilities." - Henrik Cornell M.Sc., Senior Vice President.
Below is a link to the official website of the ISPE Facility of the Year ward.
http://www.facilityoftheyear.org/
Tuesday, April 18, 2006
AutoCAD, ADT, DWF and AutoLISP resources
Friday, April 14, 2006
Vespa Beta
Bloggers about ADT 2007
I just read Robin Capper's 2007: A ADT/ABS Space Odyssey that describes the new unified space object. This is one of the major reasons why you should upgrade to ADT 2007. To be able to create spaces for all rooms in a drawing within seconds and to have the spaces associated with the bounding walls and objects is a real time saver. Visual Styles in AutoCAD/Architectural Desktop includes a video showing what Visual Styles is about.
A new blog BIMology by Tomislav Zigo starts with a post about Multi Line Schedule Tag in ADT 2007.
Matt Dillon also has a fair post about his Position on "Revit vs. ADT" or was it ADT vs. Revit. It's not specific about ADT 2007 but worth reading anyway. I agree that ADT is more than only AutoCAD for Architects.
If you want to know about the great Enhanced Property Data Features in ADT 2007 David Koch has posted 5 parts about it. Let's see if more is coming about it.
I have also a post on the Scheduling Enhancements in ADT 2007. And as the last tip the Palette Auto-hide Speed freeware is working great in AutoCAD 2007 and ADT 2007 as well.
Do I recommend upgrading to ADT 2007? Sure I do. But as always it's really up to how you use ADT and your environment and other factors. Remember that it's a new DWG format so you will not be able to use the ADT objects once saved in 2007 in older versions.
Thursday, April 13, 2006
DWG TrueView with support for the DWG 2007 file format
Monday, April 10, 2006
Annual Aseptic Technology Symposium
Updated ADT 2007 .NET API HardwiredStyles Samples
Friday, April 7, 2006
Debug .NET dll's in AutoCAD 2007
By trial and error I early found working in Visual Studio 2005/VB.NET that I needed to add the working folder (C:\Program Files\AutoCAD 2007) to the Working directory in Properties>Debug>Start Options.
There are also a couple of other solutions to the problem that is triggered because acmgd.dll is now demand loaded at startup by default.
Change LOADCTRLS to 0xc (12) in the registry
HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\AutoCAD\R17.0\ACAD-5001:409\Applications\AcMgd
Or don't copy acmgd to the debug/bin folder local. Change the Copy Local property for admgd.dll to False.
By the way observe that you now can use edit and continue in VB.NET 2005 even when debuging a dll loaded in AutoCAD. It's great!
Thursday, April 6, 2006
Create a polyline in modelspace based on a viewport
Wednesday, April 5, 2006
Wblock supports saving down to older versions in AutoCAD 2007
To make it easier for those needing to work with older file formats of DWG files you have been able to automatically save to older versions. Now the Wblock command also respects this setting. It's also possible to manually specify the file type in Wblock (Write Block) using the browse for file name and path dialog box. The setting is available at Tools>Options>Open and Save>Save as.
When reference editing a drawing it keeps the version of the xreffed drawing. You will get this dialog box message if you Refedit (reference edit) something other than a 2007 DWG: "The Xref selected references a previous drawing file format. Edits saved back to the Xref file will be in the release format of the referenced drawing file."
These are good news for companies that might not be able to upgrade all users to AutoCAD 2007 at the same time and having to use older versions during a transition time.
Tuesday, April 4, 2006
JetStream v5 from NavisWorks Released
- SwitchBack - take camera views directly back to the CAD package
- Selection Set Management Improvements - sorting and folder hierarchies
- Viewpoint sorting - sort viewpoints list
- Selection Tree sorting - sort selection tree items
- Allow NWC/NWD close file ASAP - allow other people access to the files whilst navigating
- Absolute coordinates display - visible XYZ position of camera view
- Full-screen mode - remove all interface controls, expanding the 3D view to full screen
- TimeLiner Playback without TimeLiner license - play TimeLiner simulations without the need for a full TimeLiner license
- SwitchBack - take clashing objects directly back to the CAD package for fast clash resolution
- Multiple Selections/Multiple Changes - change status settings on multiple clash items simultaneously
- Column sorting - sort clash lists based on column data
- Run without Install - Run Freedom without needing to install
- Option to prevent Object Properties from being exported - additional security by preventing CAD-originating properties from being exported
- ...
Saturday, April 1, 2006
AutoCAD 2007 Hotfixes - New Features Workshop and Activation Update
Two hotfixes so far.
Hotfix - New Features Workshop Update - This hotfix provides some updated content in the New Features Workshop. Something that is not yet in the Readme is that you might need to do this. Right click on the file acad_nfw.chm after downloaded and select Properties. Press the button Unblock. "Security: This file came from another computer and might be blocked to help protect this computer."
Hotfix - Autodesk Activation Update - After you activate and then restart your product, you receive error 0.1.0011 or 11.1.6011 and are required to reactivate. This problem can occur for Autodesk's 2006 & 2007-based products on computers with SATA Raid controllers. Important: If this update is applied to a computer that does not have a SATA Raid controller, the license on that computer will be broken. You will need to reactivate the product to repair the license.
"Don't show me this again" in AutoCAD 2007, yes, no, I changed my mind
When you first start AutoCAD 2007 some dialog boxes shows up to help you to easier learn new features. Without looking to much you simply check the checkbox for "Don't show me this again". Later (seconds or days) you want to see this dialogbox again. Here are some ways.
One way that restores many is to check the "Show all warning messages" checkbox in Tools>Options>System. Another one is to reset the profile completely using Tools>Options>Profiles>Reset.
The following tips requires that you are familiar with the registry.
The first thing that comes up is a dialog box Migrate Custom Settings. A previous version of AutoCAD (version 2000, 2000i, 2002, 2004, 2005 or 2006) is installed on this system. You can migrate settings and files from your previous product release to AutoCAD 2007.
When you install AutoCAD you can select if you want this feature to be installed or not.
If you accept the Migration it's saved in the registry at this location: [HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R17.0\ACAD-5001:409] "AutoMigrate"=dword:00000000
If you press Cancel in the Migration dialog box the value will be set to 2.
If you change the AutoMigrate value to 1 (AutoCAD has to be closed) the Migration will start again next time you start AutoCAD.
The second thing that comes up is a dialog box about Workspaces that ask you to "Choose a task-based workspace from the list below to set the initial workspace and the default drawing template file."
If you don't want to see this dialog box again it's saved to the registry and is saved to the profile.
[HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R17.0\ACAD-5001:409\Profiles\AutoCAD 2007\Drawing Window] "MoreHideWarningDialogs"=dword:00002000
AutoCAD 2007 above is the name of the profile. If you want to see this dialog box you should take the value for MoreHideWarningDialogs and subtract 2000 from it. Observe that 2000 is hexadecimal.
Selection Preview Cycling comes up if you for example holds down CTRL and selects a line. It says: "To cycle through overlapping objects, roll over the object on top, then hold SHIFT and press SPACEBAR repeatedly. To cycle through overlapping subobjects (faces, edges, and vertices) on 3D Solids, roll over the subobject on top, then hold CTRL and press SPACEBAR repeatedly."
If you don't want to see this one 200 is added to the MoreHideWarningDialogs value.
Walk and Fly Navigation Settings has the value 1000.
These are just some of the values for MoreHideWarningDialogs. When you find a new one you wonder about or know about just add a comment to this post.
If changes are made to MoreHideWarningDialogs in the registry the profile must not be current or active. Either close AutoCAD or change to another profile temporary.
Why the focus on 3D in AutoCAD 2007
Thanks for letting us know Eric!"First, we look at a variety of factors when planning the next release. We also have a 'live' roadmap for the next 3 releases - a roadmap which constantly gets updated along the way due to changing customer requirements, new AUGI wishlist, new O/S parameters, our own vertical product requirements, to name a few of the variables." ... read more here.
e-Learning for AutoCAD 2007
I noticed that e-Learning for AutoCAD 2007 now is available. It's free for subscription customers. Not so much about the new stuff though. It's more of an update of the previous lessons. But for some users it can be a great start to get familiar with the the features below.
- Customizing Toolbars and the Keyboard (learn to use CUI)
- Working with Blocks (Dynamic Blocks)
- Working with Tool Palettes
- Working with Sheet Sets
It's found from within AutoCAD>Help>Subscription e-Learning Catalog
Some of the latest blog posts
Contact Us
| About JTB World |
Website General Terms of Use |
Privacy Policy
^ Top of page
© 2004- JTB World. All rights reserved.