替代alert的一个方案， 不用关闭弹窗也能继续操作CAD。适用于需要反复观看报告。
本帖最后由 yanshengjiang 于 2025-11-4 18:16 编辑应该是最后一次修改了没啥其他想法了。
这个用到了VBS的4096属性，强制置顶，跨文档、跨进程置顶。
也记录了进程ID，选择关闭。
基本实现ET的功能
(defun alertt (msg intWaitTime Title intDispType / wsh result)
(setq result (vl-catch-all-apply
'(lambda ()
(setq wsh (vlax-create-object "WScript.Shell"))
(if wsh
(vlax-invoke-method wsh 'Popup msg intWaitTime Title intDispType)
)
)
)
)
(if (vl-catch-all-error-p result)
(alert strText)
)
(vlax-release-object wsh)
)
;调用ET现成的函数，可以置顶、跨文档。受教于云速图
;(alert2 "没有找到等高线,有可能是编码或线形不正确!" 1 "CASS助手提示你" 16)
(defun alert2(msg intWaitTime Title intDispType);形式参数调用alertt的，但只取msg和title两个参数。
(if acet-ui-status
(acet-ui-status msg Title)
(alert strText)
)
)
;; 创建并运行VBS弹窗的通用函数
;; 参数: msg - 弹窗显示的内容
;;(CreateMessageBox "自定义标题" "你好，这是一个测试消息!" T)
;; 全局变量存储最近创建的弹窗进程ID
(setq *LastMessageBoxPID* nil)
(defun CreateMessageBox (title msg 是否关闭上次对话框 / tempDir vbsPath vbsFile fileHandle WshShell Process)
(if 是否关闭上次对话框
(CloseLastMessageBox)
)
(setq tempDir (getenv "TEMP"))
(if (not tempDir)
(setq tempDir "C:\\Temp")
)
(setq vbsPath (strcat tempDir "\\message_box.vbs"))
(setq vbsFile (open vbsPath "w"))
(if vbsFile
(progn
(write-line "Set WshShell = WScript.CreateObject(\"WScript.Shell\")" vbsFile)
;(write-line (strcat "MsgBox \"" msg "\", vbOKOnly, \"" title "\"") vbsFile)
(write-line (strcat "intResult = WshShell.Popup(\"" msg "\", 0, \"" title "\", 4096)") vbsFile)
(write-line "Set WshShell = Nothing" vbsFile)
(close vbsFile)
;; 使用WScript.Shell的Run方法启动并获取进程ID
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Process (vlax-invoke WshShell 'Exec (strcat "wscript \"" vbsPath "\"")))
(setq *LastMessageBoxPID* (vlax-get-property Process 'ProcessID))
(vlax-release-object WshShell)
;*LastMessageBoxPID*; 返回进程ID
)
(progn
(alert msg)
nil
)
)
)
;; 关闭最近创建的消息框
(defun CloseLastMessageBox ()
(vl-catch-all-apply
'(lambda ()
(if *LastMessageBoxPID*
(progn
(CloseProcessByID *LastMessageBoxPID*)
(setq *LastMessageBoxPID* nil)
)
)
))
)
;; 通用的进程关闭函数
(defun CloseProcessByID (processID / SWbemLocator Service Process)
(vl-load-com)
(setq SWbemLocator (vlax-create-object "WbemScripting.SWbemLocator"))
(setq Service (vlax-invoke SWbemLocator 'ConnectServer))
(setq Process (vlax-invoke Service 'Get (strcat "Win32_Process.Handle='" (itoa processID) "'")))
(vlax-invoke Process 'Terminate)
(vlax-release-object Process)
(vlax-release-object Service)
(vlax-release-object SWbemLocator)
) 这个比较丑，且并不方便，开启后就丧失了对其的控制，只能用户点关掉。
ET有现成的函数
(acet-ui-status "asdasdasd" "sDadADaf")
关闭：(acet-ui-status) 本来都准备封贴了，AI一下，惊喜更大。
这个支持弹出位置 定时关闭
(defun CreateMessageBox (title msg 是否关闭上次对话框 / tempDir htaPath htaFile fileHandle WshShell Process)
(if 是否关闭上次对话框
(CloseLastMessageBox)
)
(setq tempDir (getenv "TEMP"))
(if (not tempDir)
(setq tempDir "C:\\Temp")
)
(setq htaPath (strcat tempDir "\\message_box.hta"))
(setq htaFile (open htaPath "w"))
(if htaFile
(progn
;; 创建HTA文件，支持自定义位置
(write-line "<html>" htaFile)
(write-line "<head>" htaFile)
(write-line "<title>Message Box</title>" htaFile)
(write-line "<HTA:APPLICATION " htaFile)
(write-line "ID=\"MessageBoxApp\"" htaFile)
(write-line "APPLICATIONNAME=\"MessageBox\"" htaFile)
(write-line "BORDER=\"thin\"" htaFile)
(write-line "CAPTION=\"yes\"" htaFile)
(write-line "SHOWINTASKBAR=\"yes\"" htaFile)
(write-line "SINGLEINSTANCE=\"yes\"" htaFile)
(write-line "SYSMENU=\"yes\"" htaFile)
(write-line "WINDOWSTATE=\"normal\"" htaFile)
(write-line "INNERBORDER=\"no\"" htaFile)
(write-line "MAXIMIZEBUTTON=\"no\"" htaFile)
(write-line "MINIMIZEBUTTON=\"no\"" htaFile)
(write-line ">" htaFile)
(write-line "<script language=\"VBScript\">" htaFile)
(write-line "Sub Window_OnLoad" htaFile)
(write-line "' 设置窗口大小" htaFile)
(write-line "window.resizeTo 500, 200" htaFile)
(write-line "' 获取屏幕尺寸" htaFile)
(write-line "screenWidth = window.screen.availWidth" htaFile)
(write-line "screenHeight = window.screen.availHeight" htaFile)
(write-line "' 计算右下角位置" htaFile)
(write-line "windowX = screenWidth - 420" htaFile)
(write-line "windowY = screenHeight - 200" htaFile)
(write-line "' 移动窗口到右下角" htaFile)
(write-line "window.moveTo windowX, windowY" htaFile)
(write-line "' 10秒后自动关闭" htaFile)
(write-line "idTimer = window.setTimeout(\"vbscript:window.close\", 10000)" htaFile)
(write-line "End Sub" htaFile)
(write-line "</script>" htaFile)
(write-line "</head>" htaFile)
(write-line "<body style=\"font-family: Arial; font-size: 12px; padding: 10px;\">" htaFile)
(write-line (strcat "<h3>" title "</h3>") htaFile)
(write-line (strcat "<p>" msg "</p>") htaFile)
(write-line "<input type='button' value='确定' onclick='window.close' style='width: 80px;'>" htaFile)
(write-line "</body>" htaFile)
(write-line "</html>" htaFile)
(close htaFile)
;; 使用WScript.Shell启动HTA
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Process (vlax-invoke WshShell 'Exec (strcat "mshta \"" htaPath "\"")))
(setq *LastMessageBoxPID* (vlax-get-property Process 'ProcessID))
(vlax-release-object WshShell)
)
(progn
(alert msg)
nil
)
)
) (defun CreateMessageBox (title msg 是否关闭上次对话框 / tempDir psPath psFile fileHandle WshShell Process)
(if 是否关闭上次对话框
(CloseLastMessageBox)
)
(setq tempDir (getenv "TEMP"))
(if (not tempDir)
(setq tempDir "C:\\Temp")
)
(setq psPath (strcat tempDir "\\message_box.ps1"))
(setq psFile (open psPath "w"))
(if psFile
(progn
;; 创建PowerShell脚本实现精确定位
(write-line "Add-Type -AssemblyName System.Windows.Forms" psFile)
(write-line "::EnableVisualStyles()" psFile)
(write-line "$form = New-Object System.Windows.Forms.Form" psFile)
(write-line (strcat "$form.Text = \"" title "\"") psFile)
(write-line "$form.Size = New-Object System.Drawing.Size(300,150)" psFile)
(write-line "$form.StartPosition = ::Manual" psFile)
(write-line "$screen = ::PrimaryScreen" psFile)
(write-line "$form.Location = New-Object System.Drawing.Point(($screen.WorkingArea.Width - $form.Width), ($screen.WorkingArea.Height - $form.Height))" psFile)
(write-line "$form.TopMost = $true" psFile)
(write-line "$label = New-Object System.Windows.Forms.Label" psFile)
(write-line "$label.Location = New-Object System.Drawing.Point(10,20)" psFile)
(write-line "$label.Size = New-Object System.Drawing.Size(260,50)" psFile)
(write-line (strcat "$label.Text = \"" msg "\"") psFile)
(write-line "$form.Controls.Add($label)" psFile)
(write-line "$button = New-Object System.Windows.Forms.Button" psFile)
(write-line "$button.Location = New-Object System.Drawing.Point(110,80)" psFile)
(write-line "$button.Size = New-Object System.Drawing.Size(75,23)" psFile)
(write-line "$button.Text = \"确定\"" psFile)
(write-line "$button.DialogResult = ::OK" psFile)
(write-line "$form.AcceptButton = $button" psFile)
(write-line "$form.Controls.Add($button)" psFile)
(write-line "$timer = New-Object System.Windows.Forms.Timer" psFile)
(write-line "$timer.Interval = 3000" psFile)
(write-line "$timer.Add_Tick({$form.Close()})" psFile)
(write-line "$timer.Start()" psFile)
(write-line "$result = $form.ShowDialog()" psFile)
(close psFile)
;; 启动PowerShell进程
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Process (vlax-invoke WshShell 'Exec (strcat "powershell -WindowStyle Hidden -ExecutionPolicy Bypass -File \"" psPath "\"")))
(setq *LastMessageBoxPID* (vlax-get-property Process 'ProcessID))
(vlax-release-object WshShell)
)
(progn
(alert msg)
nil
)
)
)
本帖最后由 yanshengjiang 于 2025-11-4 19:23 编辑
这个最屌。设置位置、定时关闭、跨进程置顶。 可以 结合另外一段代码的关闭进程函数。
;(CreateMessageBox "自定义标题" "你好，这是一个测试消息223eee3!" T"5000")自动关闭时间：毫秒
(defun CreateMessageBox (title msg closeLast closetime / tempDir psPath psFile WshShell Process returnVal)
(if closeLast
(CloseLastMessageBox)
)
(setq tempDir (getenv "TEMP"))
(if (not tempDir)
(setq tempDir "C:\\Temp")
)
(setq psPath (strcat tempDir "\\message_box.ps1"))
(setq psFile (open psPath "w"))
(if psFile
(progn
(write-line "Add-Type -AssemblyName System.Windows.Forms" psFile)
(write-line "::EnableVisualStyles()" psFile)
(write-line "$form = New-Object System.Windows.Forms.Form" psFile)
(write-line (strcat "$form.Text = \"" title "\"") psFile)
(write-line "$form.Size = New-Object System.Drawing.Size(400,150)" psFile)
(write-line "$form.StartPosition = ::Manual" psFile)
(write-line "$screen = ::PrimaryScreen" psFile)
(write-line "$form.Location = New-Object System.Drawing.Point(($screen.WorkingArea.Width - $form.Width), ($screen.WorkingArea.Height - $form.Height))" psFile)
(write-line "$form.TopMost = $true" psFile)
(write-line "$form.FormBorderStyle = ::FixedDialog" psFile)
(write-line "$form.MaximizeBox = $false" psFile)
(write-line "$form.MinimizeBox = $false" psFile)
(write-line "$label = New-Object System.Windows.Forms.Label" psFile)
(write-line "$label.Location = New-Object System.Drawing.Point(10,20)" psFile)
(write-line "$label.Size = New-Object System.Drawing.Size(360,50)" psFile)
(write-line (strcat "$label.Text = \"" msg "\"") psFile)
(write-line "$form.Controls.Add($label)" psFile)
(write-line "$button = New-Object System.Windows.Forms.Button" psFile)
(write-line "$button.Location = New-Object System.Drawing.Point(150,80)" psFile)
(write-line "$button.Size = New-Object System.Drawing.Size(75,23)" psFile)
(write-line "$button.Text = \"确定\"" psFile)
(write-line "$button.Add_Click({$form.Close()})" psFile)
(write-line "$form.Controls.Add($button)" psFile)
(write-line "$timer = New-Object System.Windows.Forms.Timer" psFile)
(write-line "$timer.Interval = 10000" psFile)
(write-line (strcat"$timer.Interval = " closetime) psFile)
(write-line "$timer.Add_Tick({$form.Close()})" psFile)
(write-line "$timer.Start()" psFile)
(write-line "$form.ShowDialog()" psFile)
(write-line "$timer.Stop()" psFile)
(write-line "$form.Dispose()" psFile)
(close psFile)
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Process (vlax-invoke WshShell 'Exec (strcat "powershell -WindowStyle Hidden -ExecutionPolicy Bypass -File \"" psPath "\"")))
(setq *LastMessageBoxPID* (vlax-get-property Process 'ProcessID))
(vlax-release-object WshShell)
)
(progn
(alert msg)
)
)
) 52pj 发表于 2025-11-6 08:20
易方达跌
doslib的提醒也很好用
(dos_traywnd "DOSLib提醒您" text 200 150 "" 10000)
qazxswk 发表于 2025-11-4 16:14
你这个只适用于ACAD吧。楼主的也国产CAD上也能适用。
这个让我释然了一点点 ，还以为完全白费功夫了 就是说吧窗口挂在后台 cad可以继续操作 这个思路可以用有 qifeifei 发表于 2025-11-3 18:15
就是说吧窗口挂在后台 cad可以继续操作
是的就是这个意思 yanshengjiang 发表于 2025-11-3 19:03
是的就是这个意思
系统的气泡呢 谢谢分享，留着备用。 如果弹窗能置顶显示，那就更加强大了。 简洁版就一句话：msgbox "Hello World2!" dcl1214 发表于 2025-11-3 22:31
系统的气泡呢
气泡我不会用。
这个方式可以打开多个弹窗。
实际使用场景应该还是比较少。