Publish a drawing from VBA

Publish a drawing from VBA

cve60069
Advocate Advocate
3,742 Views
5 Replies
Message 1 of 6

Publish a drawing from VBA

cve60069
Advocate
Advocate

I have written some code that fills in some paperspace table entries then I print the layout to pdf.  I then change the table entries and then publish again.  Similar to a MailMerge program.

 

I have created a batch file .dsd and my layouts publish fine when I publish manually.  I now want vba to do the publish for me.  I will put the publish command into a loop for each pdf.

 

Any tips please.

0 Likes
Accepted solutions (1)
3,743 Views
5 Replies
Replies (5)
Message 2 of 6

maratovich
Advisor
Advisor

Show your code.

 

---------------------------------------------------------------------
Software development
Automatic creation layouts and viewport. Batch printing drawings from model.
www.kdmsoft.net
0 Likes
Message 3 of 6

cve60069
Advocate
Advocate

Option Explicit

Sub DoDataSheets()

' 7 May 2019. Table are being read and the invisibility states of all the objects may be changed
' 8 May 2019. VBA Reads all data from NAGspecification. NAGspecification re-written.
' Two new tables: text1 and text2
' 9 May 2019. Changing $ variables into text. Working
'10 May 2019. Template 1 updating. Text stuff needs to be proof read. Next bit is to template 2.
'14 May 2019. Template 2 working. Blocks have visibility states completed.


'Declare the Global Variables
Const numberOfTemplates = 4
Const numberOfEntities = 100

Const issueDate = "7 May 2019"

' Declare the templates
Dim template As AcadLayout

' Declare the tables
Dim tableArray() As AcadTable
ReDim tableArray(numberOfEntities)

' Declare the blocks
Dim props() As AcadDynamicBlockReferenceProperty
Dim prop As AcadDynamicBlockReferenceProperty
Dim blkref As AcadBlockReference

' Declare Entities
Dim entity As AcadEntity

' Declare Index's
Dim tableIndex, NAGspecificationTableIndex As Integer
Dim loadCondition1Index, loadCondition2Index, loadCondition3Index As Integer
Dim technicalDataSheetIndex, safeSpanTablesIndex, propertiesIndex, certificationIndex, disclaimerIndex As Integer
Dim page1Index, page2Index, text1Index, text2Index As Integer

'Locate and Assign the Tables
' Loop through the templates
tableIndex = 1
For Each template In ThisDrawing.Layouts
' Loop through each entity
For Each entity In template.Block
' Identify the table and assign to tableArray
If TypeOf entity Is AcadTable Then
'Stop
Set tableArray(tableIndex) = entity

'Debug.Print tableArray(tableIndex).GetCellValue(0, 0)

'Identify the NAGspecification table
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Technical Data Sheet}" Then technicalDataSheetIndex = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Safe Span Tables}" Then safeSpanTablesIndex = tableIndex

If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Load Condition 1}" Then loadCondition1Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C0;Load Condition 2}" Then loadCondition2Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C0;Load Condition 3}" Then loadCondition3Index = tableIndex

If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Properties}" Then propertiesIndex = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Certification}" Then certificationIndex = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Disclaimer}" Then disclaimerIndex = tableIndex

If tableArray(tableIndex).GetCellValue(0, 2) = "Page 1" Then page1Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 2) = "Page 2" Then page2Index = tableIndex

If tableArray(tableIndex).GetCellValue(0, 0) = "text1" Then text1Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "text2" Then text2Index = tableIndex

If tableArray(tableIndex).GetCellValue(0, 0) = "NAGspecification" Then NAGspecificationTableIndex = tableIndex

tableIndex = tableIndex + 1
End If
Next entity
Next template

'Get the DataSheet values

Dim productReference, textTable, blockVisibility As String
Dim numberProductReferences, rowIndex, i As Integer

Dim ld1(2), ld2(2), ld3(2) As String
Dim lc1(2), lc2(2), lc3(2) As String
Dim lctxt1(2), lctxt2(2), lctxt3(2) As String
Dim loadtype As String
Dim u, light As String
Dim sw As Integer

Dim d1, d2, d3, d4, d5, d6, d7 As String
Dim p1, p2, p3, p4, p5, p6, p7 As String

'Stop

numberProductReferences = tableArray(NAGspecificationTableIndex).Rows - 4

For rowIndex = 4 To numberProductReferences + 3

With tableArray(NAGspecificationTableIndex)

' Stop
productReference = .GetCellValue(rowIndex, 0)
loadtype = .GetCellValue(rowIndex, 1)

If loadtype = 1 Then

lctxt1(0) = "Domestic and Residential Activities"
lctxt1(1) = "All usage within self-contained dwelling units including student-accommodation, blocks of flats, dormitories, hotels, motels, hospitals, public-toilets, snooker-rooms, balconies., flat-roofs and walkways. Not suitable for where people may congregate."

lctxt2(0) = "Communal Areas"
lctxt2(1) = "Areas where people may congregate including restaurants, reading-rooms, classrooms, fixed seating areas, corridors, museums, dance floors, concert halls and public areas subject to crowding."

lctxt3(0) = "Highway Use"
lctxt3(1) = "Pavement-lights situated close to a road or access where heavy vehicles could park on the pavement-light. Inner London requirement."

lc1(0) = .GetCellValue(rowIndex, 4): lc1(1) = .GetCellValue(rowIndex, 5)
lc2(0) = .GetCellValue(rowIndex, 6): lc2(1) = .GetCellValue(rowIndex, 7)
lc3(0) = .GetCellValue(rowIndex, 8): lc3(1) = .GetCellValue(rowIndex, 9)

ld1(0) = .GetCellValue(3, 4): ld1(1) = .GetCellValue(3, 5)
ld2(0) = .GetCellValue(3, 6): ld2(1) = .GetCellValue(3, 7)
ld3(0) = .GetCellValue(3, 8): ld1(1) = .GetCellValue(3, 9)

End If

If loadtype = 2 Then

lctxt1(0) = "Rooflights and Domestic Use"
lctxt1(1) = "."

lctxt2(0) = "Domestic and Residential Activities"
lctxt2(1) = "All usage within self-contained dwelling units including student-accommodation, blocks of flats, dormitories, hotels, motels, hospitals, public-toilets, snooker-rooms, balconies., flat-roofs and walkways. Not suitable for where people may congregate."

lctxt3(0) = "Communal Areas"
lctxt3(1) = "Areas where people may congregate including communal restaurants, reading-rooms, classrooms, fixed seating areas, assembly areas, corridors, museums, dance floors, concert halls and public areas subject to crowding."

lc1(0) = .GetCellValue(rowIndex, 2): lc1(1) = .GetCellValue(rowIndex, 3)
lc2(0) = .GetCellValue(rowIndex, 4): lc2(1) = .GetCellValue(rowIndex, 5)
lc3(0) = .GetCellValue(rowIndex, 6): lc3(1) = .GetCellValue(rowIndex, 7)

ld1(0) = .GetCellValue(3, 4): ld1(1) = .GetCellValue(3, 5)
ld2(0) = .GetCellValue(3, 6): ld2(1) = .GetCellValue(3, 7)
ld3(0) = .GetCellValue(3, 8): ld1(1) = .GetCellValue(3, 9)

End If



textTable = .GetCellValue(rowIndex, 10)
blockVisibility = .GetCellValue(rowIndex, 11)

d1 = productReference
d2 = .GetCellValue(rowIndex, 12)
d3 = .GetCellValue(rowIndex, 13)
d4 = .GetCellValue(rowIndex, 14)
d5 = .GetCellValue(rowIndex, 15)
d6 = .GetCellValue(rowIndex, 16)
d7 = .GetCellValue(rowIndex, 17)

u = .GetCellValue(rowIndex, 18)
sw = .GetCellValue(rowIndex, 19)
light = .GetCellValue(rowIndex, 20)
'Stop
End With ' tableArray(NAGspecificationTableIndex)

'Time to get the text box values

If textTable = "text1" Then

With tableArray(text1Index)

p1 = DoDollar(.GetCellValue(2, 1), d1, d2, d3, d4, d5, d6, d7)
p2 = DoDollar(.GetCellValue(2, 2), d1, d2, d3, d4, d5, d6, d7)
p3 = DoDollar(.GetCellValue(2, 3), d1, d2, d3, d4, d5, d6, d7)
p4 = DoDollar(.GetCellValue(3, 1), d1, d2, d3, d4, d5, d6, d7)
p5 = DoDollar(.GetCellValue(4, 1), d1, d2, d3, d4, d5, d6, d7)
p6 = DoDollar(.GetCellValue(4, 2), d1, d2, d3, d4, d5, d6, d7)

' Do again for included $'s

p1 = DoDollar(p1, d1, d2, d3, d4, d5, d6, d7)
p2 = DoDollar(p2, d1, d2, d3, d4, d5, d6, d7)
p3 = DoDollar(p3, d1, d2, d3, d4, d5, d6, d7)
p4 = DoDollar(p4, d1, d2, d3, d4, d5, d6, d7)
p5 = DoDollar(p5, d1, d2, d3, d4, d5, d6, d7)
p6 = DoDollar(p6, d1, d2, d3, d4, d5, d6, d7)


End With 'tableArray(text1Index)

End If 'textTable = "text1"

If textTable = "text2" Then

With tableArray(text2Index)

p1 = DoDollar(.GetCellValue(2, 1), d1, d2, d3, d4, d5, d6, d7)
p2 = DoDollar(.GetCellValue(2, 2), d1, d2, d3, d4, d5, d6, d7)
p3 = DoDollar(.GetCellValue(2, 3), d1, d2, d3, d4, d5, d6, d7)
p4 = DoDollar(.GetCellValue(3, 1), d1, d2, d3, d4, d5, d6, d7)
p5 = DoDollar(.GetCellValue(4, 1), d1, d2, d3, d4, d5, d6, d7)
p6 = DoDollar(.GetCellValue(4, 2), d1, d2, d3, d4, d5, d6, d7)

' Do again for included $'s

p1 = DoDollar(p1, d1, d2, d3, d4, d5, d6, d7)
p2 = DoDollar(p2, d1, d2, d3, d4, d5, d6, d7)
p3 = DoDollar(p3, d1, d2, d3, d4, d5, d6, d7)
p4 = DoDollar(p4, d1, d2, d3, d4, d5, d6, d7)
p5 = DoDollar(p5, d1, d2, d3, d4, d5, d6, d7)
p6 = DoDollar(p6, d1, d2, d3, d4, d5, d6, d7)


End With 'tableArray(text2Index)

End If 'textTable = "text2"

'Write to Templates

'Set the Product Reference

With tableArray(technicalDataSheetIndex)

Call .SetValue(0, 1, 0, d1)

Call .SetValue(3, 0, 0, p1)
Call .SetValue(3, 1, 0, p2)
Call .SetValue(3, 2, 0, p3)

End With

Call tableArray(safeSpanTablesIndex).SetValue(1, 0, 0, p4)

With tableArray(loadCondition1Index)

Call .SetValue(0, 3, 0, lctxt1(0))
Call .SetValue(1, 0, 0, lctxt1(1))

Call .SetValue(3, 0, 0, ld1(0))
Call .SetValue(3, 1, 0, ld1(1))
Call .SetValue(3, 2, 0, lc1(0) & " mm")
Call .SetValue(3, 3, 0, lc1(1) & " mm")

End With

With tableArray(loadCondition2Index)

Call .SetValue(0, 3, 0, lctxt2(0))
Call .SetValue(1, 0, 0, lctxt2(1))

Call .SetValue(3, 0, 0, ld2(0))
Call .SetValue(3, 1, 0, ld2(1))
Call .SetValue(3, 2, 0, lc2(0) & " mm")
Call .SetValue(3, 3, 0, lc2(1) & " mm")

End With

With tableArray(loadCondition3Index)

Call .SetValue(0, 3, 0, lctxt3(0))
Call .SetValue(1, 0, 0, lctxt3(1))

Call .SetValue(3, 0, 0, ld2(0))
Call .SetValue(3, 1, 0, ld2(1))
Call .SetValue(3, 2, 0, lc2(0) & " mm")
Call .SetValue(3, 3, 0, lc2(1) & " mm")

End With

With tableArray(propertiesIndex)

Call .SetValue(1, 1, 0, p5)
Call .SetValue(1, 2, 0, p6)

Call .SetValue(2, 1, 0, uValue(u))
Call .SetValue(3, 1, 0, selfWeight(sw))
Call .SetValue(4, 1, 0, lightTransmittance(light))

End With

'Locate and Assign the Block visibilities
' Loop through the templates
For Each template In ThisDrawing.Layouts
' Loop through each entity
For Each entity In template.Block
' Identify the block visibility and assign the visibility value
If TypeOf entity Is AcadBlockReference Then
Set blkref = entity
If blkref.IsDynamicBlock Then
props = blkref.GetDynamicBlockProperties
For i = 0 To UBound(props)
Set prop = props(i)
'Debug.Print prop.PropertyName
If prop.PropertyName = "Visibility1" Then
prop.Value = blockVisibility
End If
If prop.PropertyName = "Plans" Then
prop.Value = productReference
End If
Next i
End If
End If
Next entity
Next template

ThisDrawing.Application.Update

Next rowIndex

Stop

 


MsgBox "Done"


'

End Sub
Function DoColon(txt As String) As String
'Stop
Dim strLen, i As Integer
strLen = Len(txt)
For i = 1 To strLen
' Find the semi-colon
If Mid(txt, i, 1) = ";" Then
DoColon = Right(txt, strLen - i)
Exit For
End If
Next i
End Function


Function DoDollar(txt, d1, d2, d3, d4, d5, d6, d7) As String 'txt, d1, d2, d3, d4, d5, d6 As String) As String

txt = Replace(txt, "$1", d1)
txt = Replace(txt, "$2", d2)
txt = Replace(txt, "$3", d3)
txt = Replace(txt, "$4", d4)
txt = Replace(txt, "$5", d5)
txt = Replace(txt, "$6", d6)
txt = Replace(txt, "$7", d7)
DoDollar = txt
'Debug.Print DoDollar
'Stop
End Function
Function selfWeight(n) As String

selfWeight = Format(CStr(n * 0.981), "000.0") & " kN/sq.m" & " (" & CStr(n) & " kg/sq.m )"

End Function

Function uValue(n) As String

uValue = n & " W/sq.m.K"

End Function

Function lightTransmittance(n) As String

If n = "N/A" Then lightTransmittance = n Else lightTransmittance = n & " %"

End Function

0 Likes
Message 4 of 6

cve60069
Advocate
Advocate

The key I am looking for is in this line

 

:..use sendcommand in VBA to run the -PUBLISH command with the DSD-file as a parameter.."

 

which I filtched from another question.

0 Likes
Message 5 of 6

cve60069
Advocate
Advocate
Accepted solution

As PUBLISH works in the background, it is not possible to pass VBA code directly to the Publisher.  To get around this, it is necessary to set the parameters to PUBLISH from the command line. "NAGspecification" is the name of the dsd file. I plagiarised this code from Mike Tuersley off the internet (thanks Mike).

 

ThisDrawing.SendCommand "(command " & _

                 Chr(34) & "-PUBLISH" & Chr(34) & _

              " " & Chr(34) & "NAGspecification" & _

                                                   Chr(34) & ")" & vbCr

 

The PUBLISH process takes time so necessary to delay the printing.  This depends on the size of the print.  I ran a print and checked the plot log for the print time and 50 worked for me.

 

' Pause for PDF publish
   For i = 1 To 50
      DoEvents ' Yield to other processes.
  Next i

 

I want to plot a number of drawings, changing details on each page before plotting.  To set the name of the pdf I used vba to edit the NAGspecification.dsd file. I opened the dsd file and then read its contents into a string variable and then renamed the output pdf and then saved the dsd file onto itself.  By placing this in a loop, I managed to print 18 pdf's changing the details in each.  I created the NAGspecification.dsd file  from Print>Batch Plot.

 

A summary of my final code is..

 

ThisDrawing.SetVariable "FILEDIA", 0 'Shut down dialog boxes

Dim tableArray() As AcadTable 'This is my productReference table

Dim pth As String : pth = "C:\NAGspecification.dsd"

Dim oldName, newName As String : oldName = "NAGspecification.pdf" ' This is name in the saved dsd file.

Dim strline, totalFile As String 'Variables used to manipulate the dsd file

Dim numberProductReferences  as Integer : numberProductReferences = tableArray(technicalIndex).Rows - 3

rowIndex = 3 ' This is the row in my table of productReferences

Do

   productReference = tableArray(technicalIndex).GetCellValue(rowIndex, 0) 'Look up productReference

   'Do all necessary changes to the layouts I want to plot

   'Copy dsd into total file

   Open pth For Input As #1

   While EOF(1) = False

      Line Input #1, strline

      totalFile = totalFile + strline + vbNewLine

   Wend

   Close #1

newName = productReference + ".pdf" 'Set the old name to the new name
totalFile = Replace(totalFile, oldName, newName) 'Change the name of the pdf in the dsd file

Open pth For Output As #1
   Print #1, totalFile 'Then save the dsd file over itself
Close #1

'Activate PUBLISH

ThisDrawing.SendCommand "(command " & Chr(34) & _

                          "-PUBLISH" & Chr(34) & " " & Chr(34) & _

                               "NAGspecification" & Chr(34) & ")" & vbCr

' Pause for PDF publish
   For i = 1 To 50
      DoEvents ' Yield to other processes.
   Next i
   oldName = newName ' Update the reference list
rowIndex = rowIndex + 1 'Update the loop

Loop Until rowIndex = numberProductReferences + 3 'Start again until all references are printed.

 

'Tidy up and Reset the dsd file to its original settings
   totalFile = Replace(totalFile, oldName, "NAGspecification.pdf")
Open pth For Output As #1
Print #1, totalFile
Close #1
ThisDrawing.SetVariable "FILEDIA", 1 'Turn back on dialogs

msgbox "Done"

 

Thanks to all those that gave me hints along the way.

 

0 Likes
Message 6 of 6

Ben_MBA
Explorer
Explorer

Hi, I dont understand your request. While wait who give u a suggest use my lisp. Hope help you.

In my lisp had "Command Printer" quick plot all drawings Model and Layout, with multiple  select for you.

https://forums.autodesk.com/t5/visual-basic-customization/i-m-sharing-my-useful-autolisp-collection/...

0 Likes