eTransmit (pack and go) unter Bricscad
Leider verfügt die aktuelle Version (9.x) von Bricscad nicht über einen Befehl zum Export aller Zeichnungskomponenten.
Zur Lösung gibt es unter anderem die beiden folgenden Möglichkeiten:
- Verwendung der Sofoco-Tools
- Nutzung einer VBA-Routine
1. Sofoco-Tools
Bei den Sofoco-Tools handelt es sich um eine Sammlung freier Programme für Bricscad. Wir haben sie mit der Version Bricscad PRO 9.3.13 erfolgreich testen können. In dieser Sammlung heißt das Programm "JetPack". Daneben gibt es noch eine ganze Reihe anderer nützlicher Funktionen.
Hier der Link: http://www.sofoco.com.au/SofocoTools.html
2. Einfache VBA-Lösung
Wenn auch in der Nutzeroberfläche keine entsprechende Funktion zu finden ist, verfügt die COM-Schnittstelle dennoch über entsprechende Objekte. Der nachfolgende Programmcode wurde aus der knowledge base von Bricsys entnommen und von uns erfolgreich mit Bricscad PRO 9.3.13 getestet. Bitte beachten Sie, dass in der Zeile
Const E_TRANS_DIR = "C:\TEMP"
der von Ihnen gewünschte Pfad eingesetzt werden muss.
Bevor Sie das VBA-Makro starten können, muss die Zeichnung zuvor gesichert worden sein.
| Option Explicit Const E_TRANS_DIR = "C:\TEMP" 'E_TRANS_DIR specifies the directory where transmittal package will be created. 'In this sample code this folder is assumed to exist on your system. 'Modify the value to "C:\Users\UserName\Documents\eTrans" or whatever is convenient 'but make sure it exists... 'Current code does not check whether this folder exists (neither does it 'create it if needed, nor does it try to empty it's content between runs...) Sub Example1() 'this function sends a copy of the Active Drawing, together with all dependent files 'such as xrefs, images, and fonts, into a single folder to the eTransit Directory (E_TRANS_DIR). 'It also: ' -logs info to the vba debug window ' -shows a messagebox about the TransmittalOperation Dim trmOp As TransmittalOperation Set trmOp = ThisDrawing.getTransmittalOperationInterface Dim trmInfo As TransmittalInfo Set trmInfo = trmOp.getTransmittalInfoInterface trmInfo.destinationRoot = E_TRANS_DIR Dim trmFile As TransmittalFile Dim retVal As AddFileReturnVal retVal = trmOp.addDrawingFile(ThisDrawing.FullName, trmFile) Debug.Print "returned value log:: " + _ AddFileReturnValue_ToString(retVal) + " :: " + ThisDrawing.FullName Dim trmGraph As TransmittalFilesGraph Set trmGraph = trmOp.getTransmittalGraphInterface PrintTrmGraph trmGraph 'send feedback to debug window trmOp.createTransmittalPackage 'copy the files to the folder set by destPath MsgBox (TransmittalOperation_ToString(trmOp)) 'display some vitalstatistix End Sub Sub Example2() 'identical to Example1 above but: 'here we tweak the TransmittalInfo settings to either include or exclude ImageFile, Xref, Plotfile, etc 'as in Example1 this sub also: ' -logs info to the vba debug window ' -shows a messagebox about the TransmittalOperation Dim trmOp As TransmittalOperation Set trmOp = ThisDrawing.getTransmittalOperationInterface Dim trmInfo As TransmittalInfo Set trmInfo = trmOp.getTransmittalInfoInterface trmInfo.destinationRoot = E_TRANS_DIR 'tweak following settings to either include or exclude files in the package trmInfo.includeImageFile = True trmInfo.includeXrefDwg = True trmInfo.includePlotFile = False 'note: limitation - currently saveVersion cannot be set so 'following will have no effect (it will default to 0=eNoConversion) trmInfo.saveVersion = eAutoCAD14 MsgBox (TransmittalInfo_ToString(trmInfo)) 'display some vitalstatistix Dim trmFile As TransmittalFile Dim retVal As AddFileReturnVal retVal = trmOp.addDrawingFile(ThisDrawing.FullName, trmFile) Debug.Print "returned value log:: " + _ AddFileReturnValue_ToString(retVal) + " :: " + ThisDrawing.FullName Dim trmGraph As TransmittalFilesGraph Set trmGraph = trmOp.getTransmittalGraphInterface PrintTrmGraph trmGraph 'send feedback to debug window trmOp.createTransmittalPackage 'copy the files to the folder set by destPath MsgBox (TransmittalOperation_ToString(trmOp)) 'show some vitalstatistix End Sub Private Sub PrintTrmGraph(ByRef trmGraph As TransmittalFilesGraph) 'this sub prints info about the Transmittal files to the debug window Dim files As Long, totalBytes As Long Dim sp As String: sp = vbNullString files = trmGraph.getNumberOfFiles(1, 1) totalBytes = trmGraph.totalBytes(0) Debug.Print Debug.Print "----------------------------------------" Debug.Print sp + "GRAPH: Total files=" + Str(files) + "; Missing files=" + Str(files - trmGraph.getNumberOfFiles(0, 1)) + "; Unselected files=" + Str(files - trmGraph.getNumberOfFiles(1, 0)) Debug.Print sp + " Total bytes=" + Str(totalBytes) + "; Total bytes IncludedFilesOnly=" + Str(trmGraph.totalBytes(1)) PrintTrm trmGraph.getRoot, 0 End Sub Private Sub PrintTrm(ByRef trmFile As TransmittalFile, ByVal level) Dim i As Integer Dim sp As String: sp = vbNullString For i = 0 To level - 1 sp = sp + " " Next i If level = 0 Then Debug.Print "--ROOT node (=dummy)" Else 'Debug.Print sp + "--NODE: Type=[" + FileType_ToString(trmFile.Type) + "], include=[" + Str(trmFile.includeInTransmittal) + "], fileExist=[" + Str(trmFile.fileExists) + "], version=[" + trmFile.version + "] --" 'Debug.Print sp + " sourcePath =[" + trmFile.sourcePath + "]" 'Debug.Print sp + " fileSize =[" + Str(trmFile.fileSize()) + "], lastModifiedTime=[" + Str(trmFile.lastModifiedTime()) + "]" 'Debug.Print sp + " numParents =" + Str(trmFile.numberOfDependees) 'Debug.Print sp + " numChildren =" + Str(trmFile.numberOfDependents) End If level = level + 1 Dim subFile As TransmittalFile For i = 0 To trmFile.numberOfDependents - 1 Set subFile = trmFile.getDependent(i) PrintTrm subFile, level Next i End Sub Private Function TransmittalOperation_ToString(ByVal inTransOp As TransmittalOperation) As String 'helper function returning the TransmittalOperation as a string Dim numFiles As Long numFiles = inTransOp.getTransmittalGraphInterface.getNumberOfFiles(0, 0) Dim sBuf As String sBuf = "Following [" & CStr(numFiles) & "] will be added to folder " & E_TRANS_DIR sBuf = sBuf & vbCrLf & vbCrLf sBuf = sBuf & inTransOp.getTransmittalReport TransmittalOperation_ToString = sBuf 'return value End Function Private Function TransmittalInfo_ToString(ByVal inTrmInfo As TransmittalInfo) As String 'helper function returning the TransmittalInfo's settings as a string Const BULLET = " -> " Dim sBuf As String sBuf = "Transmittal Info settings:" sBuf = sBuf & vbCrLf & BULLET & "Destination root= " & inTrmInfo.destinationRoot sBuf = sBuf & vbCrLf & BULLET & "Saveversion= " & SaveDwgFormat_ToString(inTrmInfo.saveVersion) sBuf = sBuf & vbCrLf & BULLET & "Include Image file= " & CBool(inTrmInfo.includeImageFile) sBuf = sBuf & vbCrLf & BULLET & "Include Plot file= " & CBool(inTrmInfo.includePlotFile) sBuf = sBuf & vbCrLf & BULLET & "Include Xref file= " & CBool(inTrmInfo.includeXrefDwg) sBuf = sBuf & vbCrLf & BULLET & "Image relative path= " & CBool(inTrmInfo.imageRelativePath) TransmittalInfo_ToString = sBuf 'return value End Function Private Function FileType_ToString(ByVal inType As FileType) As String 'helper function returning string value rather than the constant number of FileType Dim sReturn As String: sReturn = vbNullString Select Case inType Case eNoType: sReturn = "NoType" Case eDwgFile: sReturn = "DwgFile" Case eXrefFile: sReturn = "XrefFile" Case eImageFile: sReturn = "ImageFile" Case eFontFile: sReturn = "FontFile" Case eShxFontFile: sReturn = "ShxFontFile" Case ePfbFontFile: sReturn = "PfbFontFile" Case eTtfFontFile: sReturn = "TtfFontFile" Case eAltFontFile: sReturn = "AltFontFile" Case eShxAltFontFile: sReturn = "ShxAltFontFile" Case ePfbAltFontFile: sReturn = "PfbAltFontFile" Case eTtfAltFontFile: sReturn = "TtfAltFontFile" Case ePlotCfgFile: sReturn = "PlotCfgFile" Case ePlotStyleTableFile: sReturn = "PlotStyleTableFile" Case eFontMapFile: sReturn = "FontMapFile" Case e3rdPartyAddedFile: sReturn = "3rdPartyAddedFile" Case eUserAddedFile: sReturn = "UserAddedFile" Case eXrefAttachFile: sReturn = "XrefAttachFile" Case eXrefOverlayFile: sReturn = "XrefOverlayFile" Case eSheetSetFile: sReturn = "SheetSetFile" Case eSheetSetSupportFile: sReturn = "SheetSetSupportFile" Case eDGNUnderlay: sReturn = "DGNUnderlay" Case eDWFUnderlay: sReturn = "DWFUnderlay" Case eMaterialTextureFile: sReturn = "MaterialTextureFile" Case ePhotometricWebFile: sReturn = "PhotometricWebFile" Case eDataLinkFile: sReturn = "DataLinkFile" End Select FileType_ToString = sReturn 'return value End Function Private Function AddFileReturnValue_ToString(ByVal inVal As AddFileReturnVal) As String 'helper function returning string value rather than the constant number of AddFileReturnVal Dim sReturn As String: sReturn = vbNullString Select Case inVal Case eFileAdded: sReturn = "FileAdded" Case eRelationshipAdded: sReturn = "RelationshipAdded" Case eFileNotAdded: sReturn = "FileNotAdded" Case eFileNotAddedToPreventCycle: sReturn = "FileNotAddedToPreventCycle" Case eFileNotAddedBadArg: sReturn = "FileNotAddedBadArg" Case eFileAlreadyAdded: sReturn = "FileAlreadyAdded" End Select AddFileReturnValue_ToString = sReturn 'return value End Function Private Function SaveDwgFormat_ToString(ByVal inVal As SaveDwgFormat) As String 'helper function returning string value rather than the constant number of SaveDwgFormat Dim sReturn As String: sReturn = "unspecified" Select Case inVal Case eNoConversion: sReturn = "NoConversion" Case eAutoCADR18: sReturn = "AutoCADR18" Case eAutoCAD2000: sReturn = "AutoCAD2000" Case eAutoCAD14: sReturn = "AutoCAD14" Case eAutoCADR21: sReturn = "AutoCADR21" End Select SaveDwgFormat_ToString = sReturn 'return value End Function |