VBA Not performing in autocad 2016

[katlyn.dgrella]

I run a simple copy/paste/pasteordered text program on 2015 autocad that works wonderful.  I have tried to apply this same VBA to my 2016 Autocad and the macro loads with no issued but does not perform within the drawing.  Is there a setting of modification that needs to be made to allow this to function in the 2016 autocad? 

attached is the code

[Ed__Jobe]

Welcome to the VBA forum. First, please don't attach code in a separate text file. Just insert it into the post using the code tags. On the editor menu, the button looks like </>. A popup appears where you can paste your code.

Two things to note.

1. When VBA loads your dvb, it compiles it to the latest version. So you won't be able to use the same dvb for 2015 and 2016.

2. In the VBAIDE, go to Tools>References and make sure that there are no references prefixed with "MISSING:". You may need to manually reference the 2016 type library.

[katlyn.dgrella]

Ok thank you.  How can I use the code written on the newer version of Autocad? 

[Ed__Jobe]

You just need to have 2 dvb's, with different file names. One for each version. Then for the 2016 dvb, make sure you follow step 2 in my previous post.

[katlyn.dgrella]

there is no missing references and it is still not functioning correctly

[Ed__Jobe]

Do you get any errors? Can you provide more information for troubleshooting?

[grobnik]

Hi @katlyn.dgrella are you abke to run the procedure step by step, if there are error tappino like as on error resume next please make a commento forva whyle in order to understand the point where is hanghing

[katlyn.dgrella]

Here is the DVB.

I have copied the file and renamed it to upload to the 2016 version and checked the missing reference library.  I have a custom toolbar button that references the different functions "Copy text"/"Paste text"/"Paste Text Ordered"

When I used the toolbar buttons my command reads the macro name and -vbarun but nothing happens

'AutoCAD VBA Macros
'Last Updated: 6/29/2005
'*************************

Option Explicit

Public Sub PasteText()
'Pastes lines of text from the clipboard to text objects in AutoCAD

    On Error GoTo ExitSub

    Dim objText As Object, SelSet As AcadSelectionSet
    
    'Get the selected AutoCAD objects
    Set SelSet = AutoCAD.ActiveDocument.ActiveSelectionSet
    
    Dim iIndex As Integer, strText() As String
    Dim strNew As String, strClipboard As String
    Dim iTextIndex As Integer
    
    'Copy the contents off the clipboard
    strClipboard = modClipboard.GetText()
    
    If strClipboard = "" Then Exit Sub
    
    'Parse the contents into lines
    strText = Split(strClipboard, vbCrLf)
    
    iTextIndex = 0
    
    For iIndex = 0 To SelSet.Count - 1
       
        Set objText = SelSet.Item(iIndex)
        
        If iTextIndex > UBound(strText) Then Exit Sub
        
        'Determine if the selected item is text, and update it if it is
        If TypeOf objText Is AcadText Or TypeOf objText Is AcadMText Then
        
            strNew = strText(iTextIndex)
            
            objText.TextString = strNew
            
            iTextIndex = iTextIndex + 1
            
        End If
    
    Next iIndex

ExitSub:

End Sub

Public Sub CopyText()
'Copies multiple text objects from AutoCAD to the clipboard

    On Error GoTo ExitSub

    Dim objText As Object, SelSet As AcadSelectionSet
    
    'Get the selected AutoCAD objects
    Set SelSet = AutoCAD.ActiveDocument.ActiveSelectionSet
    
    Dim iIndex As Integer
    Dim strCopy As String, strClipboard As String
    Dim iTextIndex As Integer
    
    Dim aText() As String
    
    iTextIndex = 0
    
    'Don't run without selected objects
    If SelSet.Count = 0 Then Exit Sub
    
    For iIndex = 0 To SelSet.Count - 1
       
        Set objText = SelSet.Item(iIndex)
        
        'Determine if the selected item is text, and put text in array if it is
        If TypeOf objText Is AcadText Or TypeOf objText Is AcadMText Then
        
            strCopy = objText.TextString
            
            ReDim Preserve aText(0 To iTextIndex)
            
            aText(iTextIndex) = strCopy
            
            iTextIndex = iTextIndex + 1
            
        End If
    
    Next iIndex
    
    Dim strBuffer As String
    
    strBuffer = ""
    
    'Now populate the clipboard with data from the array
    For iIndex = 0 To UBound(aText)
    
        strBuffer = strBuffer & aText(iIndex)
        
        'Add a carriage return for all but the last item
        If iIndex < UBound(aText) Then
        
            strBuffer = strBuffer & vbCrLf
            
        End If
        
    Next iIndex
    
    'Update the clipboard
    Call modClipboard.SetText(strBuffer)

ExitSub:
    
End Sub

Public Sub PasteTextOrdered()
'Pastes text from the clipboard in the order specified by the user

    On Error GoTo ExitSub

    'Get the active document
    Dim objDoc As AcadDocument, SelSet As AcadSelectionSet
    
    Set objDoc = AutoCAD.ActiveDocument
    
    'Get the selected objects
    Set SelSet = objDoc.ActiveSelectionSet

    Dim strPrompt As String, strInput As String
    Dim intCoord As Integer
    
    'Prompt the user for vertical or horizontal ordering
    strPrompt = vbCrLf & vbCrLf & "Specify [Vertical/Horizontal]: "
    strInput = objDoc.Utility.GetString(1, strPrompt)
    
    'Determine the user's input and update the coordinate type and next prompt
    If InStr(Mid("horizontal", 1, Len(strInput)), LCase(strInput)) <> 0 Then
    
        intCoord = 0
        strPrompt = vbCrLf & vbCrLf & "Specify [Left/Right]: "
        
    Else
    
        intCoord = 1
        strPrompt = vbCrLf & vbCrLf & "Specify [Top/Bottom]: "
        
    End If

    'Get user input about top-bottom left-right ordering
    strInput = objDoc.Utility.GetString(1, strPrompt)

    Dim blnTopRight As Boolean

    'Set variables based on user input
    If intCoord = 1 Then
    
        If InStr(Mid("bottom", 1, Len(strInput)), LCase(strInput)) <> 0 Then
        
            blnTopRight = False
            
        Else
        
            blnTopRight = True
            
        End If
        
    Else
    
         If InStr(Mid("right", 1, Len(strInput)), LCase(strInput)) <> 0 Then
        
            blnTopRight = True
            
        Else
        
            blnTopRight = False
            
        End If

    End If
    
    Dim aTextObjects() As Object, objText As Object
    
    'Sort the objects based on user settings
    aTextObjects = SortTextObjects(SelSet, intCoord, blnTopRight)
    
    Dim iIndex As Integer, strText() As String
    Dim strNew As String, strClipboard As String
    
    'Copy the contents off the clipboard
    strClipboard = modClipboard.GetText()
    
    If strClipboard = "" Then Exit Sub
    
    'Parse the contents into lines
    strText = Split(strClipboard, vbCrLf)
    
    For iIndex = 0 To UBound(aTextObjects)
       
        Set objText = aTextObjects(iIndex)

        If iIndex > UBound(strText) Then Exit Sub

        strNew = strText(iIndex)
            
        objText.TextString = strNew
    
    Next iIndex
    
ExitSub:

End Sub

[Ed__Jobe]

Can you run it using the VBARUN command? As @grobnik mentioned, you can set a breakpoint in the CopyText sub and step through each line to see what line the command fails on. Note that the use of On Error GoTo :ExitSub may be masking a new error that you didn't plan for. Try commenting out that line and debugging again.

[grobnik]

Hi @katlyn.dgrella place ' before 

On Error GoTo ExitSub

And press F9 (function key) on next code row and run the first procedure. When the procedure stop on the red line highlihted goto step by step with F8 until error msg will appeal, do nothing and press debug on error message window.

[katlyn.dgrella]

ok  I then get an error "mismatch" on 

  strClipboard = modClipboard.GetText()

[katlyn.dgrella]

this is modClipboard

'Function calls to access Windows clipboard

Option Explicit

Private Declare PtrSafe Function IsClipboardFormatAvailable _
    Lib "user32" _
    (ByVal uFormat As Long) As Long
Private Declare PtrSafe Function OpenClipboard _
    Lib "user32" _
    (ByVal Hwnd As Long) As Long
Private Declare PtrSafe Function GetClipboardData _
    Lib "user32" _
    (ByVal uFormat As Long) As Long
Private Declare PtrSafe Function GlobalSize _
    Lib "kernel32" _
    (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalLock _
    Lib "kernel32" _
    (ByVal hMem As Long) As Long
Private Declare PtrSafe Sub MoveMemory _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (ByVal strDest As Any, _
    ByVal lpSource As Any, _
    ByVal Length As Long)
Private Declare PtrSafe Function GlobalUnlock _
    Lib "kernel32" _
    (ByVal hMem As Long) As Long
Private Declare PtrSafe Function CloseClipboard _
    Lib "user32" () As Long
Private Declare PtrSafe Function GlobalAlloc _
    Lib "kernel32" _
    (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare PtrSafe Function EmptyClipboard _
    Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData _
    Lib "user32" _
    (ByVal uFormat As Long, ByVal hData As Long) As Long
Private Declare PtrSafe Function GlobalFree _
    Lib "kernel32" _
    (ByVal hMem As Long) As Long

Private Const GMEM_MOVABLE = &H2&
Private Const GMEM_DDESHARE = &H2000&
Private Const CF_TEXT = 1

'Error return codes from Clipboard2Text
Private Const CLIPBOARDFORMATNOTAVAILABLE = 1
Private Const CANNOTOPENCLIPBOARD = 2
Private Const CANNOTGETCLIPBOARDDATA = 3
Private Const CANNOTGLOBALLOCK = 4
Private Const CANNOTCLOSECLIPBOARD = 5
Private Const CANNOTGLOBALALLOC = 6
Private Const CANNOTEMPTYCLIPBOARD = 7
Private Const CANNOTSETCLIPBOARDDATA = 8
Private Const CANNOTGLOBALFREE = 9

Function SetText(strText As String) As Variant
    Dim varRet As Variant
    Dim fSetClipboardData As Boolean
    Dim hMemory As Long
    Dim lpMemory As Long
    Dim lngSize As Long

    varRet = False
    fSetClipboardData = False

    ' Get the length, including one extra for a CHR$(0)
    ' at the end.
    lngSize = Len(strText) + 1
    hMemory = GlobalAlloc(GMEM_MOVABLE Or _
        GMEM_DDESHARE, lngSize)
    If Not CBool(hMemory) Then
        varRet = CVErr(CANNOTGLOBALALLOC)
        GoTo SetTextDone
    End If

    ' Lock the object into memory
    lpMemory = GlobalLock(hMemory)
    If Not CBool(lpMemory) Then
        varRet = CVErr(CANNOTGLOBALLOCK)
        GoTo SetTextGlobalFree
    End If

    ' Move the string into the memory we locked
    Call MoveMemory(lpMemory, strText, lngSize)

    ' Don't send clipboard locked memory.
    Call GlobalUnlock(hMemory)

    ' Open the clipboard
    If Not CBool(OpenClipboard(0&)) Then
        varRet = CVErr(CANNOTOPENCLIPBOARD)
        GoTo SetTextGlobalFree
    End If

    ' Remove the current contents of the clipboard
    If Not CBool(EmptyClipboard()) Then
        varRet = CVErr(CANNOTEMPTYCLIPBOARD)
        GoTo SetTextCloseClipboard
    End If

    ' Add our string to the clipboard as text
    If Not CBool(SetClipboardData(CF_TEXT, _
        hMemory)) Then
        varRet = CVErr(CANNOTSETCLIPBOARDDATA)
        GoTo SetTextCloseClipboard
    Else
        fSetClipboardData = True
    End If

SetTextCloseClipboard:
    ' Close the clipboard
    If Not CBool(CloseClipboard()) Then
        varRet = CVErr(CANNOTCLOSECLIPBOARD)
    End If

SetTextGlobalFree:
    If Not fSetClipboardData Then
        'If we have set the clipboard data, we no longer own
        ' the object--Windows does, so don't free it.
        If CBool(GlobalFree(hMemory)) Then
            varRet = CVErr(CANNOTGLOBALFREE)
        End If
    End If

SetTextDone:
    SetText = varRet
End Function

Public Function GetText() As Variant
    Dim hMemory As Long
    Dim lpMemory As Long
    Dim strText As String
    Dim lngSize As Long
    Dim varRet As Variant

    varRet = ""

    ' Is there text on the clipboard? If not, error out.
    If Not CBool(IsClipboardFormatAvailable _
        (CF_TEXT)) Then
        varRet = CVErr(CLIPBOARDFORMATNOTAVAILABLE)
        GoTo GetTextDone
    End If

    ' Open the clipboard
    If Not CBool(OpenClipboard(0&)) Then
        varRet = CVErr(CANNOTOPENCLIPBOARD)
        GoTo GetTextDone
    End If

    ' Get the handle to the clipboard data
    hMemory = GetClipboardData(CF_TEXT)
    If Not CBool(hMemory) Then
        varRet = CVErr(CANNOTGETCLIPBOARDDATA)
        GoTo GetTextCloseClipboard
    End If

    ' Find out how big it is and allocate enough space
    ' in a string
    lngSize = GlobalSize(hMemory)
    strText = Space$(lngSize)

    ' Lock the handle so we can use it
    lpMemory = GlobalLock(hMemory)
    If Not CBool(lpMemory) Then
        varRet = CVErr(CANNOTGLOBALLOCK)
        GoTo GetTextCloseClipboard
    End If

    ' Move the information from the clipboard memory
    ' into our string
    Call MoveMemory(strText, lpMemory, lngSize)

    ' Truncate it at the first Null character because
    ' the value reported by lngSize is erroneously large
    strText = Left$(strText, InStr(1, strText, Chr$(0)) - 1)

    ' Free the lock
    Call GlobalUnlock(hMemory)

GetTextCloseClipboard:
    ' Close the clipboard
    If Not CBool(CloseClipboard()) Then
        varRet = CVErr(CANNOTCLOSECLIPBOARD)
    End If

GetTextDone:
    If Not IsError(varRet) Then
        GetText = strText
    Else
        GetText = varRet
    End If
End Function

[grobnik]

Seems not so easy. Are you sure that there isn't another way to do what do need ? Why use clipboard ? I guess could you use a text file or something like as.

[Ed__Jobe]

GetText is declared as a Variant. The windows function sets varRet, a variant. Without stepping through the code myself, I'm assuming that it is an array of strings. Dim strClipboard as a variant and pause on the line to examine its contents in the Locals window to see how you can process its contents.

[katlyn.dgrella]

this tool was created before I was employed at this company. I am just trying to implement it on another work station. There is probably an easier solution out there.

[norman.yuan]

So, your issue is not from VBA itself, but from Windows API calls, which are for 32bit CPU. Since I saw the code was last updated in year 2005 (when the AutoCAD VBA was 32 bit), but you claimed it worked with your AutoCAD 2015(?), so I can only assume your Acad2015 is also 32-bit version (thus its VBA is also 32 bit). I also assume that your Acad2016 is 64-bit, thus, the code stops work. You need to update the Windows API functions (those declares like "Private Declare PtrSafe Function ...". You can search the internet, you should be able to find plenty of links. One of ithem might be "ready-to-use" (I never used/tested it):

https://francescofoti.com/2013/12/share-the-clipboard-with-vba-and-the-windows-api/ 

HTH

[grobnik]

Yes, copy the text in windows clipboard and paste on autocad dwg, later you
can apply style and so on.
If I remember well the result should be a mtext in dwg.

[katlyn.dgrella · Accepted solution]

Thank you all for your help.

A solution was found.  The code was simplified to use the DataObject variable to copy to the computers clipboard. then retrieving the text from clipboard. 

Sub CopyTextToClipboard()
'PURPOSE: Copy a given text to the clipboard (using DataObject)
'SOURCE: www.TheSpreadsheetGuru.com
'NOTES: Must enable Forms Library: Checkmark Tools > References > Microsoft Forms 2.0 Object Library

Dim obj As New DataObject
Dim txt As String

'Put some text inside a string variable
  txt = "This was copied to the clipboard using VBA!"
'Make object's text equal above string variable
  obj.SetText txt

'Place DataObject's text into the Clipboard
  obj.PutInClipboard

'Notify User
  MsgBox "There is now text copied to your clipboard!", vbInformation

End Sub

Dim DataObj As New DataObject
    Dim S As String
    DataObj.GetFromClipboard
    S = DataObj.GetText
    Debug.Print S