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