success combie this with autocad

Plug-in and third party software discussion.
Post Reply
panliang9
Posts: 5
Joined: Mon Sep 19, 2016 5:33 am

success combie this with autocad

Post by panliang9 »

Dear void:

In this autocad forum "MJCAD"(http://bbs.mjtd.com/) ,

after discuss the possilbe combine this soft with autocad, some guy write code success combine this soft with autocad.
the thread is :
http://bbs.mjtd.com/thread-173826-1-1.html
and :
http://bbs.mjtd.com/thread-173850-1-1.html

because language use in this forum is chinese, for those people who want use these code, I copy down bellow. code not write by
"zzyong00" , and "黄明儒"。

the lisp

Code: Select all

;write by ruminghuan qq740688321
;idea by panliang9 qq2259433769
(vl-load-com)
(defun sendkeys	(keys)
  (or *WSH* (setq *WSH* (vlax-get-or-create-object "wscript.shell")))
  (vlax-invoke-method *WSH* 'sendkeys keys)
  (princ)
)
(defun C:T (/ TXT)
  (if (setq txt (cdr (assoc 1 (entget (car (nentsel "\n select the text"))))))
    (progn
      (SET-CLIP-STRING txt)
      (if (= (getenv "PROCESSOR_ARCHITECTURE") "x86")	    ;32位
	(Everything32 TXT)
	(Everything64 TXT)
      )
    )
  )
  (princ)
)
(defun Everything64 (TXT)
  (startapp "D:\\Program Files\\Everything\\Everything.exe")
  (command "delay" 100)(sendkeys "^V")
)
(defun Everything32 (TXT)
  (startapp "Everything1.3.4.686.x86.x64.exe")
  (sendkeys "^V")
)
(defun SET-CLIP-STRING (STR / HTML RESULT)
  (and (= (type STR) 'STR)
       (setq HTML (vlax-create-object "htmlfile"))
       (setq RESULT (vlax-invoke
		      (vlax-get	(vlax-get HTML 'PARENTWINDOW)
				'CLIPBOARDDATA
		      )
		      'SETDATA
		      "Text"
		      STR
		    )
       )
       (vlax-release-object HTML)
  )
)
_____________________________________________________________________________________
the vba use in autocad:
_____________________________________________________________________________________

Code: Select all

Option Explicit
Public Sub SearchWithEverything()
'EveryThing搜索文本
'By zzyong00 2016.10.23\
'Idea By panliang9
Dim objEnt As AcadEntity, pt1 As Variant
Dim objT As AcadText, objMT As AcadMText
Dim strCon As String

On Error Resume Next
AppActivate ThisDrawing.Application.Caption
RETRY:
ThisDrawing.Utility.GetEntity objEnt, pt1, "select text:"

'Debug.Print objEnt.ObjectName
If Err.Number = -2147352567 Then
    Exit Sub
End If
If Err <> 0 Then
    Err.Clear
    GoTo RETRY
End If

If objEnt.ObjectName = "AcDbText" Then
    Set objT = objEnt
    strCon = objT.TextString
ElseIf objEnt.ObjectName = "AcDbMText" Then
    Set objMT = objEnt
    strCon = MtextStringClearFormat(objMT.TextString)
Else

End If
Dim lngPID As Long
'修改everything.exe的路径为安装路径
'lngPID = SuperShell("C:\Program Files\Everything\everything.exe -s " & Chr(34) & strCon & Chr(34), "C:\Program Files\Everything\", 0, SW_NORMAL, HIGH_PRIORITY_CLASS)
lngPID = Shell("C:\Program Files\Everything\everything.exe -s " & Chr(34) & strCon & Chr(34), vbNormalFocus)


End Sub
Private Function MtextStringClearFormat(MTextString As String) As String
    Dim MyString As String
    MyString = MTextString
    MyString = ReplaceByRegExp(MyString, "\\{", Chr(1))
    MyString = ReplaceByRegExp(MyString, "\\}", Chr(2))
    MyString = ReplaceByRegExp(MyString, "\\\\", Chr(3))
    MyString = ReplaceByRegExp(MyString, "\\S([^;]*?)(\^|#)([^;]*?);", "$1$3")
    MyString = ReplaceByRegExp(MyString, "\\S([^;]*?);", "$1")
    MyString = ReplaceByRegExp(MyString, "(\\P|\\O|\\o|\\L|\\l|\{|\})", "")
    MyString = ReplaceByRegExp(MyString, "\\[^;]*?;", "")
    MyString = ReplaceByRegExp(MyString, "\x01", "{")
    MyString = ReplaceByRegExp(MyString, "\x02", "}")
    MyString = ReplaceByRegExp(MyString, "\x03", "\")
    MtextStringClearFormat = Trim(MyString)
End Function
Private Function ReplaceByRegExp(ByVal Mystrig As String, ByVal TxtFind As String, ByVal TxtReplace As String)
     Dim RE As Object
     Set RE = ThisDrawing.Application.GetInterfaceObject("Vbscript.RegExp")
     
     RE.IgnoreCase = False
     RE.Global = True
     
     RE.Pattern = TxtFind
     ReplaceByRegExp = RE.Replace(Mystrig, TxtReplace)
     Set RE = Nothing
     
End Function

Code: Select all

Option Explicit



Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Public Enum enSW
    SW_HIDE = 0
    SW_NORMAL = 1
    SW_MAXIMIZE = 3
    SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type
Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
Public Enum enPriority_Class
    NORMAL_PRIORITY_CLASS = &H20
    IDLE_PRIORITY_CLASS = &H40
    HIGH_PRIORITY_CLASS = &H80
End Enum
#If VBA7 Then  ' 64位
    Private Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
    Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
#Else
    Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
    Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
#End If

Public Function SuperShell(ByVal App As String, ByVal WorkDir As String, dwMilliseconds As Long, ByVal start_size As enSW, ByVal Priority_Class As enPriority_Class) As Boolean
    Dim pclass As Long
    Dim sinfo As STARTUPINFO
    Dim pinfo As PROCESS_INFORMATION
    'Not used, but needed
    Dim sec1 As SECURITY_ATTRIBUTES
    Dim sec2 As SECURITY_ATTRIBUTES
    'Set the structure size
    sec1.nLength = Len(sec1)
    sec2.nLength = Len(sec2)
    sinfo.cb = Len(sinfo)
    'Set the flags
    sinfo.dwFlags = STARTF_USESHOWWINDOW
    'Set the window's startup position
    sinfo.wShowWindow = start_size
    'Set the priority class
    pclass = Priority_Class
    'Start the program
    If CreateProcess(vbNullString, App, sec1, sec2, False, pclass, _
    0&, WorkDir, sinfo, pinfo) Then
        'Wait
        WaitForSingleObject pinfo.hProcess, dwMilliseconds
        SuperShell = True
    Else
        SuperShell = False
    End If
End Function
panliang9
Posts: 5
Joined: Mon Sep 19, 2016 5:33 am

Re: success combie this with autocad

Post by panliang9 »

sorry , "code not write by"zzyong00" , and "黄明儒"。" is wrong .

it should be "code write by "zzyong00" , and "黄明儒.
Post Reply