How to convert Plot Lisp routine to VBA

[ian.cook]

I am looking for advice on creating my first VBA routine. I would like to include the lisp command shown below, into a user form, so a user can pick this (or additional options) and allow admin colleagues open a drawing and produce A3 plans without any knowledge of CAD. I can create the user forms OK, but cannot workout how to include the lisp command.
Anyone able to help me.
the lisp command is:
(defun C:MMSA3 ()
(command "-plot" "Y" "Building Blueprint" "colour A3-th"
"A3 297 x 419 mm" "" "Portrait" "n" "E" "F" "C" "y" "pdf fine" "n" "n" "n" "n" "n" "n" "y")
)

[jwanstaett]

I am looking for advice on creating my first VBA routine. I would like to include the lisp command shown below, into a user form, so a user can pick this (or additional options) and allow admin colleagues open a drawing and produce A3 plans without any knowledge of CAD. I can create the user forms OK, but cannot workout how to include the lisp command.
Anyone able to help me.
the lisp command is:
(defun C:MMSA3 ()
(command "-plot" "Y" "Building Blueprint" "colour A3-th"
"A3 297 x 419 mm" "" "Portrait" "n" "E" "F" "C" "y" "pdf fine" "n" "n" "n" "n" "n" "n" "y")
)

use the sendcommand in AutoCAD VBA it works the same as the command function in lisp. use vbCr where you would need to use the enter key in the command

ThisDrawing.SendCommand "-plot" & vbCr &  vbCr  & "Y" &  vbCr  "Building Blueprint"_
& vbCr & "colour A3-th" & vbCr & "A3 297 x 419 mm" & vbCr & vbCr  & "Portrait"_
 & vbCr & "n" & vbCr & "E" & vbCr & "F" "C" & vbCr &  "y" & vbCr &"pdf fine"_
 & vbCr & "n" & vbCr & "n" & vbCr & "n" & vbCr & "n"& vbCr & "n"& vbCr & "n"& vbCr & "y"

or this will run the mmsa3 command if it is loaded

thisdrawing.sendcommand "mmsa3" & vbCr

but the right way to do it is with PlotToDevice or PlotToFile method of the acadplot object check in help for how to use.

ThisDrawing.Plot.PlotToDevice
ThisDrawing.Plot.PlotToFile

We make plot files for all are drawing plots and save them were nonautocad use can open then if they need to view a drawing. And if we need to plot them we just send the plot file to the plotter. We use ViewCompanion a program for viewing HPG files. ViewCompanion will also convent to PDF for emailing the file to nonautocad user.

[ian.cook]

Thanks for pointing me in the right direction.

[daniel.olives]

Hy,
(Sorry for my english, i am a french user!)

After that litle explanation a partial sub to make a layout, with a block named
for exemple :
"6000_cadre_A3" ~ 286 mmm x 409 mm

The version of AutoCAD is usefull to put the good value to
"backgroundplot".

If there is no plotteur (traceur in french) "Aucun" or ""

put Traceur0.pc3 by default. with an extra dimension A0++(more 2 A4 widh an 900mm)
"User257"

With this method you can make an automatic view in a layout with a search of the name of the block.

The debugg is not finished but it is an exemple of all problem find, to do that.


Daniel OLIVES
FRANCE Lyon

Sub TPSImprime()
    Dim objPresentation As AcadLayout
    Dim Layouts As AcadLayouts
    Dim objPlotDevices As Variant
    Dim objTraceur As AcadPlot
    Dim objElem As Object               ' objet Elément du dessin
    
    Dim Version As String
    Version = ThisDrawing.Application.Version
    ' ou idem
    Dim Ver As String
    Ver = ThisDrawing.GetVariable("ACADVER")

    Dim ScaleCart As Variant, AngCart As Variant
    Dim PlotEch As Variant
        
    Set objPresentation = ThisDrawing.ActiveLayout
    Set Layouts = ThisDrawing.Layouts
    Dim CoinBasX As Double, CoinBasY As Double, CoinHautX As Double, CoinHautY As Double
    Dim pt1(0 To 2) As Double
    Dim pt2(0 To 2) As Double
    Dim pt3(0 To 2) As Double
    Dim pt4(0 To 2) As Double
    Dim ptz1(0 To 1) As Double
    Dim ptz2(0 To 1) As Double
    Dim plineObj As AcadPolyline
    Dim points(0 To 11) As Double
    Dim FlagImp As Integer
    FlagImp = 0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01
    ' Test si un traceur est défini
    If objPresentation.ConfigName = "Aucun" Or _
            Left(objPresentation.ConfigName, 7) = "Traceur" Or _
            objPresentation.ConfigName = "" Then
        ' Traceur par défaut "Traceur0.pc3"
        objPresentation.ConfigName = "Traceur0.pc3"
        ' à tester
        ' Taille de papier par défaut A0++ 
        objPresentation.CanonicalMediaName = "User257"
        objPresentation.SetCustomScale 1, 1
        objPresentation.PaperUnits = acMillimeters ' unité papier
        ThisDrawing.Regen acAllViewports
    End If
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 02
    For Each objElem In objPresentation.Block      '.PaperSpace
        ' si l'élément est un bloc
        With objElem
            If .EntityType = acBlockReference Then
                Select Case UCase(.name)
                    ' point 3D fenêtre selon cadre
....
                   Case "6000_CADRE_A3"
                        CoinBasX = -201.5: CoinBasY = 2.1
                        CoinHautX = 207.58: CoinHautY = 286.62
                        objPresentation.ConfigName = "Couleur.pc3"
                        If objPresentation.name <> "Model" _
                                Then objPresentation.name = "A3_" & objPresentation.name
                        ' "ISO A3 -" = "A3"
                        objPresentation.CanonicalMediaName = "A3"
                        objPresentation.SetCustomScale 1, 1
                        objPresentation.PaperUnits = acMillimeters ' unité papier
                        FlagImp = FlagImp + 1
                    Case Else
                End Select
            End If
        End With
    Next objElem
    
    ' Cas ou il y a plusieurs blocs cadre
    If FlagImp > 1 Then _
        MsgBox ("Il y a " & FlagImp & " blocs de cadre dans cette présentation !" _
                & vbCrLf & _
                "La mise en page est faite sur le dernier trouvé !")
    If FlagImp = 0 Then msg = MsgBox("Pas de cadre bloc connu !", vbInformation, "Technip TPS"): Exit Sub

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 03
    pt1(0) = CoinBasX: pt1(1) = CoinBasY: pt1(2) = 0
    pt2(0) = CoinHautX: pt2(1) = CoinHautY: pt2(2) = 0
    
    ' Transfert point 3D vers point 2D
    ptz1(0) = pt1(0)
    ptz2(0) = pt2(0)
    ptz1(1) = pt1(1)
    ptz2(1) = pt2(1)

    ThisDrawing.Application.ZoomWindow pt1, pt2          ' zoom fenêtre
    
    ' Cas ou tous les points à zéro, pas de fenêtre !
    If ptz1(0) = 0 And ptz2(1) = 0 And ptz1(1) = 0 And ptz2(1) = 0 Then
        MsgBox "Il n'y a pas de cadre bloc dans cette présentation"
    Else
        objPresentation.PlotType = acWindow             ' Présentation fenêtre
        objPresentation.SetWindowToPlot ptz1, ptz2

        ThisDrawing.Regen acAllViewports                        ' pour prise en compte
'        objPresentation.RefreshPlotDeviceInfo                  ' bugg le format ?? en pouce !!

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 04
        On Error Resume Next
        ' Prépare variable "Backgroundplot" selon version acad
        Select Case UCase(Version)
          Case "15.1S (LMS TECH)" ' Acad 2004
            ThisDrawing.Plot.PlotToDevice
            ThisDrawing.Plot.DisplayPlotPreview acFullPreview   ' Prévisualisation
          Case "16.2S (LMS TECH)", "16.1S (LMS TECH)"           ' Acad 2006 ou 2005
            ThisDrawing.SetVariable "BACKGROUNDPLOT", 0         ' sans tache de fond
'           ThisDrawing.Plot.PlotToDevice                       ' ne pas mettre en commentaire pour impression
            ThisDrawing.Plot.DisplayPlotPreview acFullPreview   ' Prévisualisation
            ThisDrawing.SetVariable "BACKGROUNDPLOT", 2         ' avec tache de fond
          Case Else
        End Select
    End If  ' Tous les points à zéro
End Sub

[ Moderator Action = ON ] What are [ CODE ] tags... [ Moderator Action = OFF ]