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 SubmodCustSheetSetProperties
' 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 SubmodAddSheetSetProperty
' 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 SubmodRenameSSProperty
' 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 SubmodSetCustSheetSetProperty
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 SubmodCheckAndCorrectSSProperties
' 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 SubmodCurrentSheet
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 SubmodDeleteSSProperty
' 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 SubmodSSM
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 SubmodSSMChangeNumberTitle
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 SubmodWhoIsLockingSS
' 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.
I was the CAD Manager at Pharmadule Emtunga on this very successful project that started about two years ago. AutoCAD (at that time 2004 and later 2005) was the 3D CAD platform using Architectural Desktop (2004-2005) for the building, Rebis Structural and later ProSteel 3D for the steel structure, MagiCAD HPV for HVAC and UtilityPiping, MagiCAD El for Electrical, Instrumentation and Telecommunication, Rebis AutoPLANT for Process Piping and NavisWorks that was used for the 3D coordination and clash checking.
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