Results 1 to 7 of 7

Thread: Use Progress Meter in VBA AutoCAD

  1. #1
    Member
    Join Date
    2015-03
    Posts
    7
    Login to Give a bone
    0

    Question Use Progress Meter in VBA AutoCAD

    Hello Everyone,

    When i was looking for a way to add a ProgressBar control to my program, i came across this thing called "Progress Meter". After few "googlings" it seems to be refering to the blue progress bar that appears at the bottom right of the screen (AutoCAD 2014+) when we use a long command (Saving a File / ScaleListEdit/...).

    So i'm asking how could we access to this object via VBA (if it's possible of course).

    I also tried to use the "Microsoft ProgressBar Control" but apparently it's not available on 64bits OS.

    I know there is the traditional way of making a custome progress bar using a label in a userform and control the length but i just want to know if there any other possibility.

    Thanks in advance for your answers ^^

  2. #2
    Administrator rkmcswain's Avatar
    Join Date
    2004-09
    Location
    Earth
    Posts
    9,803
    Login to Give a bone
    0

    Default Re: Use Progress Meter in VBA AutoCAD

    Not VBA, but would something like this help you?
    http://through-the-interface.typepad...avascript.html

    Kean has a few other posts on various progress bars in his blog over the years too.
    R.K. McSwain | CAD Panacea |

  3. #3
    Member
    Join Date
    2015-03
    Posts
    7
    Login to Give a bone
    0

    Default Re: Use Progress Meter in VBA AutoCAD

    Yeah i saw those posts about making a custome Progress Meter, but he's using some foreign languages for me such as VB.NET HTML5...Does it mean that i have reached the wall of VBA where i need other programing languages to climb it? If so i'd like to know if the access to the AutoCAD Progress Meter is possible with Lisp, because that's the next language i'm planning to learn.

  4. #4
    Member
    Join Date
    2011-08
    Posts
    14
    Login to Give a bone
    0

    Default Re: Use Progress Meter in VBA AutoCAD

    Can you use something like this?

    Sub progressmeter()
    Dim i As Integer
    For i = 1 To 100
    ThisDrawing.SendCommand "modemacro " & String(i, "|") & vbCr
    Next i
    ThisDrawing.SendCommand "modemacro ." & vbCr
    End Sub

  5. #5
    Member
    Join Date
    2011-08
    Posts
    14
    Login to Give a bone
    0

    Default Re: Use Progress Meter in VBA AutoCAD

    Did you try this code?

  6. #6
    Member
    Join Date
    2015-09
    Location
    Madrid - Spain
    Posts
    10
    Login to Give a bone
    0

    Default Re: Use Progress Meter in VBA AutoCAD

    Ac2016
    In new module:
    Code:
    Option Explicit
    Private Declare PtrSafe Function ProgressMeter Lib "accore.dll" Alias "?acedSetStatusBarProgressMeter@@YAHPEB_WHH@Z" _
                     (ByVal strCaption As String, ByVal intmin As LongPtr, ByVal intmax As LongPtr) As Boolean
    Private Declare PtrSafe Function SetProgBarPos Lib "accore.dll" Alias "?acedSetStatusBarProgressMeterPos@@YAHH@Z" _
                     (ByVal intVal As LongPtr) As Boolean
    Private Declare PtrSafe Function RestoreStatus Lib "accore.dll" Alias "?acedRestoreStatusBar@@YAXXZ" () As Boolean
    
    
    Public Function ProgressBarOn(ByVal captionProgressBar As String, ByVal minProgressBar As Long, ByVal maxProgressBar As Long)
     On Error Resume Next
     ProgressMeter StrConv(captionProgressBar, vbUnicode), minProgressBar, maxProgressBar
     Err.Clear
    End Function
    
    Public Function ProgressBarOff()
     On Error Resume Next
     RestoreStatus
     Err.Clear
    End Function
    
    Public Function ProgressBarRun(ByVal i As Long)
     On Error Resume Next
     SetProgBarPos (i)
     Err.Clear
    End Function
    
    Public Sub TestProgressBar()
     Dim i As Long
    
      ProgressBarOn "Barra de progreso: ", 0, ThisDrawing.ModelSpace.Count * 10
      'ProgressMeter "Barra de progreso: ", 0, ThisDrawing.ModelSpace.Count * 10
      For i = 0 To ThisDrawing.ModelSpace.Count * 10
        i = i + 1
        'ThisDrawing.Utility.Prompt "Numero: " & i
    
        ProgressBarRun i
        'SetProgBarPos (i)
      Next
      ProgressBarOff
      'RestoreStatus
    End Sub

  7. #7
    Woo! Hoo! my 1st post
    Join Date
    2023-03
    Posts
    1
    Login to Give a bone
    0

    Default Re: Use Progress Meter in VBA AutoCAD

    Dim ZS As Integer
    Dim ZS1P As Integer

    Set VL = THISDRAWING.Application.GetInterfaceObject("VL.Application.16")
    Set VLF = VL.ActiveDocument.Functions
    ss.cont (selection)
    ZS = SS.Count

    'visible progress in cad
    VL.ActiveDocument.Functions.ITEM("acet-ui-progress-init").FUNCALL "Working:", ZS

    ZS1P = Int(ZS / 50)
    For ZS = 0 To SS.Count - 1
    If ZS / ZS1P = Int(ZS / ZS1P) Then VLF.ITEM("acet-ui-progress-safe").FUNCALL (ZS)
    NEXT ZS
    'close progress
    VLF.ITEM("acet-ui-progress-done").FUNCALL

Similar Threads

  1. progress report with autocad and excel
    By mmazur673816 in forum AutoLISP
    Replies: 1
    Last Post: 2014-06-06, 08:00 PM
  2. ACA in meter
    By igones in forum AutoCAD General
    Replies: 1
    Last Post: 2012-08-28, 08:45 AM
  3. The Progress Bar in the AutoCAD status Area
    By arshiel88 in forum VBA/COM Interop
    Replies: 17
    Last Post: 2010-10-15, 05:27 PM
  4. 3D Water Meter/BFP
    By michaelmerda in forum ACA/AMEP Gallery
    Replies: 0
    Last Post: 2009-11-10, 06:55 PM
  5. Anybody have a gas meter and/or electric meter?
    By christo4robin in forum Revit Architecture - General
    Replies: 1
    Last Post: 2004-02-18, 01:08 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •