Author Topic: Call a command with selection set in VBA  (Read 6219 times)

0 Members and 1 Guest are viewing this topic.

ahervai

  • Guest
Call a command with selection set in VBA
« on: June 06, 2013, 11:40:08 AM »
Hello Everyone!

I would like to write a vba code what call an autocad command with ThisDrawing.SendCommand
and put a selection set in it as a parameter.
For example I would like to move a cube calling _move command without user input.


Can anyone help me?
Thanks in advance!
Andras

fixo

  • Guest
Re: Call a command with selection set in VBA
« Reply #1 on: June 07, 2013, 05:00:24 PM »
Welcome on board, averhai
Try this code, or convert them to your function

Code: [Select]
Option Explicit

'written by Smel as posted on autolisp.ru 05/11/2006
Public Sub SendCmdEX(ac As Object, cmd As String, Optional ChOsmode As Boolean = False)
 If ChOsmode Then
  ac.SendCommand cmd
 Else
  Dim osmode As Integer
  osmode = CInt(GetVar(ac, "OSMODE"))
  ac.SendCommand cmd
  SetVar ac, "OSMODE", osmode
 End If
End Sub

Public Sub SetVar(ac As Object, varName As String, varValue)
ac.SetVariable varName, varValue
End Sub

Public Function GetVar(ac As Object, varName As String) As Variant
GetVar = ac.GetVariable(varName)
End Function
Sub MoveCommand()
Dim setName As String
Dim setObj As AcadSelectionSet
    Dim oEnt As AcadEntity
    Dim varPick As Variant
    Dim sol As Acad3DSolid

    setName = "$Cubes$"
    On Error GoTo Err_Control

            Dim fType(0) As Integer, fData(0)
            Dim oSset As AcadSelectionSet

     fType(0) = 0: fData(0) = "3dsolid"
 
     Dim dxfcode As Variant
     Dim dxfdata As Variant
     dxfcode = fType: dxfdata = fData
     
     Dim setColl As AcadSelectionSets
     With ThisDrawing
          Set setColl = .SelectionSets
          For Each setObj In setColl
               If setObj.Name = setName Then
                    .SelectionSets.Item(setName).Delete
                    Exit For
               End If
          Next
          Set oSset = .SelectionSets.Add(setName)
     End With
   Dim selMod As Integer
     selMod = acSelectionSetAll
     ZoomAll
     oSset.Select selMod, , , dxfcode, dxfdata
     Dim ptVecStr As String
    '' Vector to move:
     ptVecStr = "(list 5.0 5.0 0.0)"
     Dim cmdStr As String
                  Set oEnt = oSset.Item(0)
          cmdStr = "_MOVE" & vbCr & "(handent " & Chr(34) & oEnt.Handle & Chr(34) & ")"
          Dim i
          For i = 1 To oSset.Count - 1
          Set oEnt = oSset.Item(i)
          cmdStr = cmdStr & vbCr & "(handent " & Chr(34) & oEnt.Handle & Chr(34) & ")"
          Next
               
          cmdStr = cmdStr & vbCr & vbCr & "_D" & vbCr & ptVecStr & vbCr
          SendCmdEX ThisDrawing, cmdStr, True
               

Err_Control:
     If Err.Number <> 0 Then
     MsgBox Err.Description
     End If
     
End Sub