本帖最后由 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)
  )
)

  1. ;; 创建并运行VBS弹窗的通用函数
  2. ;; 参数: msg - 弹窗显示的内容
  3. ;;(CreateMessageBox "自定义标题" "你好，这是一个测试消息!" T)
  4. ;; 全局变量存储最近创建的弹窗进程ID
  5. (setq *LastMessageBoxPID* nil)

  7. (defun CreateMessageBox (title msg 是否关闭上次对话框 / tempDir vbsPath vbsFile fileHandle WshShell Process)
  8.     (if 是否关闭上次对话框
  9.       (CloseLastMessageBox)
  10.       )
  11.     (setq tempDir (getenv "TEMP"))
  12.     (if (not tempDir)
  13.         (setq tempDir "C:\\Temp")
  14.     )
  15.    
  16.     (setq vbsPath (strcat tempDir "\\message_box.vbs"))
  17.    
  18.     (setq vbsFile (open vbsPath "w"))
  19.     (if vbsFile
  20.         (progn
  21.             (write-line "Set WshShell = WScript.CreateObject(\"WScript.Shell\")" vbsFile)
  22.             ;(write-line (strcat "MsgBox \"" msg "\", vbOKOnly, \"" title "\"") vbsFile)
  23.       (write-line (strcat "intResult = WshShell.Popup(\"" msg "\", 0, \"" title "\", 4096)") vbsFile)
  24.             (write-line "Set WshShell = Nothing" vbsFile)
  25.             (close vbsFile)
  26.             
  27.             ;; 使用WScript.Shell的Run方法启动并获取进程ID
  28.             (setq WshShell (vlax-create-object "WScript.Shell"))
  29.             (setq Process (vlax-invoke WshShell 'Exec (strcat "wscript \"" vbsPath "\"")))
  30.             (setq *LastMessageBoxPID* (vlax-get-property Process 'ProcessID))
  31.             
  32.             (vlax-release-object WshShell)
  33.             ;*LastMessageBoxPID*  ; 返回进程ID
  34.         )
  35.         (progn
  36.             (alert msg)
  37.             nil
  38.         )
  39.     )
  40. )

  42. ;; 关闭最近创建的消息框
  43. (defun CloseLastMessageBox ()
  44.   (vl-catch-all-apply
  45.     '(lambda ()
  46.   (if *LastMessageBoxPID*
  47.     (progn
  48.       (CloseProcessByID *LastMessageBoxPID*)
  49.       (setq *LastMessageBoxPID* nil)
  50.     )
  51.   )
  52.        ))
  53. )

  55. ;; 通用的进程关闭函数
  56. (defun CloseProcessByID (processID / SWbemLocator Service Process)
  57.   (vl-load-com)
  58.   (setq SWbemLocator (vlax-create-object "WbemScripting.SWbemLocator"))
  59.   (setq Service (vlax-invoke SWbemLocator 'ConnectServer))
  60.   (setq Process (vlax-invoke Service 'Get (strcat "Win32_Process.Handle='" (itoa processID) "'")))
  61.   (vlax-invoke Process 'Terminate)
  62.   (vlax-release-object Process)
  63.   (vlax-release-object Service)
  64.   (vlax-release-object SWbemLocator)
  65. )


网友答: 这个比较丑，且并不方便，开启后就丧失了对其的控制，只能用户点关掉。
ET有现成的函数
(acet-ui-status "asdasdasd" "sDadADaf")
关闭：(acet-ui-status)

网友答: 本来都准备封贴了，AI一下，惊喜更大。
这个支持弹出位置 定时关闭

  1. (defun CreateMessageBox (title msg 是否关闭上次对话框 / tempDir htaPath htaFile fileHandle WshShell Process)
  2.     (if 是否关闭上次对话框
  3.       (CloseLastMessageBox)
  4.     )
  5.     (setq tempDir (getenv "TEMP"))
  6.     (if (not tempDir)
  7.         (setq tempDir "C:\\Temp")
  8.     )
  9.    
  10.     (setq htaPath (strcat tempDir "\\message_box.hta"))
  11.    
  12.     (setq htaFile (open htaPath "w"))
  13.     (if htaFile
  14.         (progn
  15.             ;; 创建HTA文件，支持自定义位置
  16.             (write-line "<html>" htaFile)
  17.             (write-line "<head>" htaFile)
  18.             (write-line "<title>Message Box</title>" htaFile)
  19.             (write-line "<HTA:APPLICATION " htaFile)
  20.             (write-line "  ID=\"MessageBoxApp\"" htaFile)
  21.             (write-line "  APPLICATIONNAME=\"MessageBox\"" htaFile)
  22.             (write-line "  BORDER=\"thin\"" htaFile)
  23.             (write-line "  CAPTION=\"yes\"" htaFile)
  24.             (write-line "  SHOWINTASKBAR=\"yes\"" htaFile)
  25.             (write-line "  SINGLEINSTANCE=\"yes\"" htaFile)
  26.             (write-line "  SYSMENU=\"yes\"" htaFile)
  27.             (write-line "  WINDOWSTATE=\"normal\"" htaFile)
  28.             (write-line "  INNERBORDER=\"no\"" htaFile)
  29.             (write-line "  MAXIMIZEBUTTON=\"no\"" htaFile)
  30.             (write-line "  MINIMIZEBUTTON=\"no\"" htaFile)
  31.             (write-line ">" htaFile)
  32.             (write-line "<script language=\"VBScript\">" htaFile)
  33.             (write-line "Sub Window_OnLoad" htaFile)
  34.             (write-line "  ' 设置窗口大小" htaFile)
  35.             (write-line "  window.resizeTo 500, 200" htaFile)
  36.             (write-line "  ' 获取屏幕尺寸" htaFile)
  37.             (write-line "  screenWidth = window.screen.availWidth" htaFile)
  38.             (write-line "  screenHeight = window.screen.availHeight" htaFile)
  39.             (write-line "  ' 计算右下角位置" htaFile)
  40.             (write-line "  windowX = screenWidth - 420" htaFile)
  41.             (write-line "  windowY = screenHeight - 200" htaFile)
  42.             (write-line "  ' 移动窗口到右下角" htaFile)
  43.             (write-line "  window.moveTo windowX, windowY" htaFile)
  44.             (write-line "  ' 10秒后自动关闭" htaFile)
  45.             (write-line "  idTimer = window.setTimeout(\"vbscript:window.close\", 10000)" htaFile)
  46.             (write-line "End Sub" htaFile)
  47.             (write-line "</script>" htaFile)
  48.             (write-line "</head>" htaFile)
  49.             (write-line "<body style=\"font-family: Arial; font-size: 12px; padding: 10px;\">" htaFile)
  50.             (write-line (strcat "<h3>" title "</h3>") htaFile)
  51.             (write-line (strcat "<p>" msg "</p>") htaFile)
  52.             (write-line "<input type='button' value='确定' onclick='window.close' style='width: 80px;'>" htaFile)
  53.             (write-line "</body>" htaFile)
  54.             (write-line "</html>" htaFile)
  55.             (close htaFile)
  56.             
  57.             ;; 使用WScript.Shell启动HTA
  58.             (setq WshShell (vlax-create-object "WScript.Shell"))
  59.             (setq Process (vlax-invoke WshShell 'Exec (strcat "mshta \"" htaPath "\"")))
  60.             (setq *LastMessageBoxPID* (vlax-get-property Process 'ProcessID))
  61.             
  62.             (vlax-release-object WshShell)
  63.         )
  64.         (progn
  65.             (alert msg)
  66.             nil
  67.         )
  68.     )
  69. )


网友答:
  2. (defun CreateMessageBox (title msg 是否关闭上次对话框 / tempDir psPath psFile fileHandle WshShell Process)
  3.     (if 是否关闭上次对话框
  4.       (CloseLastMessageBox)
  5.     )
  6.     (setq tempDir (getenv "TEMP"))
  7.     (if (not tempDir)
  8.         (setq tempDir "C:\\Temp")
  9.     )
  10.    
  11.     (setq psPath (strcat tempDir "\\message_box.ps1"))
  12.    
  13.     (setq psFile (open psPath "w"))
  14.     (if psFile
  15.         (progn
  16.             ;; 创建PowerShell脚本实现精确定位
  17.             (write-line "Add-Type -AssemblyName System.Windows.Forms" psFile)
  18.             (write-line "[System.Windows.Forms.Application]::EnableVisualStyles()" psFile)
  19.             (write-line "$form = New-Object System.Windows.Forms.Form" psFile)
  20.             (write-line (strcat "$form.Text = "" title """) psFile)
  21.             (write-line "$form.Size = New-Object System.Drawing.Size(300,150)" psFile)
  22.             (write-line "$form.StartPosition = [System.Windows.Forms.FormStartPosition]::Manual" psFile)
  23.             (write-line "$screen = [System.Windows.Forms.Screen]::PrimaryScreen" psFile)
  24.             (write-line "$form.Location = New-Object System.Drawing.Point(($screen.WorkingArea.Width - $form.Width), ($screen.WorkingArea.Height - $form.Height))" psFile)
  25.             (write-line "$form.TopMost = $true" psFile)
  26.             (write-line "$label = New-Object System.Windows.Forms.Label" psFile)
  27.             (write-line "$label.Location = New-Object System.Drawing.Point(10,20)" psFile)
  28.             (write-line "$label.Size = New-Object System.Drawing.Size(260,50)" psFile)
  29.             (write-line (strcat "$label.Text = "" msg """) psFile)
  30.             (write-line "$form.Controls.Add($label)" psFile)
  31.             (write-line "$button = New-Object System.Windows.Forms.Button" psFile)
  32.             (write-line "$button.Location = New-Object System.Drawing.Point(110,80)" psFile)
  33.             (write-line "$button.Size = New-Object System.Drawing.Size(75,23)" psFile)
  34.             (write-line "$button.Text = "确定"" psFile)
  35.             (write-line "$button.DialogResult = [System.Windows.Forms.DialogResult]::OK" psFile)
  36.             (write-line "$form.AcceptButton = $button" psFile)
  37.             (write-line "$form.Controls.Add($button)" psFile)
  38.             (write-line "$timer = New-Object System.Windows.Forms.Timer" psFile)
  39.             (write-line "$timer.Interval = 3000" psFile)
  40.             (write-line "$timer.Add_Tick({$form.Close()})" psFile)
  41.             (write-line "$timer.Start()" psFile)
  42.             (write-line "$result = $form.ShowDialog()" psFile)
  43.             
  44.             (close psFile)
  45.             
  46.             ;; 启动PowerShell进程
  47.             (setq WshShell (vlax-create-object "WScript.Shell"))
  48.             (setq Process (vlax-invoke WshShell 'Exec (strcat "powershell -WindowStyle Hidden -ExecutionPolicy Bypass -File "" psPath """)))
  49.             (setq *LastMessageBoxPID* (vlax-get-property Process 'ProcessID))
  50.             
  51.             (vlax-release-object WshShell)
  52.         )
  53.         (progn
  54.             (alert msg)
  55.             nil
  56.         )
  57.     )
  58. )





网友答: 本帖最后由 yanshengjiang 于 2025-11-4 19:23 编辑

这个最屌。设置位置、定时关闭、跨进程置顶。 可以 结合另外一段代码的关闭进程函数。
  1. ;(CreateMessageBox "自定义标题" "你好，这是一个测试消息223eee3!" T  "5000")  自动关闭时间：毫秒
  2. (defun CreateMessageBox (title msg closeLast closetime / tempDir psPath psFile WshShell Process returnVal)
  3.     (if closeLast
  4.       (CloseLastMessageBox)
  5.     )
  6.     (setq tempDir (getenv "TEMP"))
  7.     (if (not tempDir)
  8.         (setq tempDir "C:\\Temp")
  9.     )
  10.     (setq psPath (strcat tempDir "\\message_box.ps1"))
  11.     (setq psFile (open psPath "w"))
  12.     (if psFile
  13.         (progn
  14.             (write-line "Add-Type -AssemblyName System.Windows.Forms" psFile)
  15.             (write-line "[System.Windows.Forms.Application]::EnableVisualStyles()" psFile)
  16.             (write-line "$form = New-Object System.Windows.Forms.Form" psFile)
  17.             (write-line (strcat "$form.Text = \"" title "\"") psFile)
  18.             (write-line "$form.Size = New-Object System.Drawing.Size(400,150)" psFile)
  19.             (write-line "$form.StartPosition = [System.Windows.Forms.FormStartPosition]::Manual" psFile)
  20.             (write-line "$screen = [System.Windows.Forms.Screen]::PrimaryScreen" psFile)
  21.             (write-line "$form.Location = New-Object System.Drawing.Point(($screen.WorkingArea.Width - $form.Width), ($screen.WorkingArea.Height - $form.Height))" psFile)
  22.             (write-line "$form.TopMost = $true" psFile)
  23.             (write-line "$form.FormBorderStyle = [System.Windows.Forms.FormBorderStyle]::FixedDialog" psFile)
  24.             (write-line "$form.MaximizeBox = $false" psFile)
  25.             (write-line "$form.MinimizeBox = $false" psFile)
  26.             (write-line "$label = New-Object System.Windows.Forms.Label" psFile)
  27.             (write-line "$label.Location = New-Object System.Drawing.Point(10,20)" psFile)
  28.             (write-line "$label.Size = New-Object System.Drawing.Size(360,50)" psFile)
  29.             (write-line (strcat "$label.Text = \"" msg "\"") psFile)
  30.             (write-line "$form.Controls.Add($label)" psFile)
  31.             (write-line "$button = New-Object System.Windows.Forms.Button" psFile)
  32.             (write-line "$button.Location = New-Object System.Drawing.Point(150,80)" psFile)
  33.             (write-line "$button.Size = New-Object System.Drawing.Size(75,23)" psFile)
  34.             (write-line "$button.Text = \"确定\"" psFile)
  35.             (write-line "$button.Add_Click({$form.Close()})" psFile)
  36.             (write-line "$form.Controls.Add($button)" psFile)
  37.             (write-line "$timer = New-Object System.Windows.Forms.Timer" psFile)
  38.             (write-line "$timer.Interval = 10000" psFile)
  39.       (write-line (strcat"$timer.Interval = " closetime) psFile)
  40.             (write-line "$timer.Add_Tick({$form.Close()})" psFile)
  41.             (write-line "$timer.Start()" psFile)
  42.             (write-line "$form.ShowDialog()" psFile)
  43.             (write-line "$timer.Stop()" psFile)
  44.             (write-line "$form.Dispose()" psFile)
  45.             (close psFile)
  46.             (setq WshShell (vlax-create-object "WScript.Shell"))
  47.             (setq Process (vlax-invoke WshShell 'Exec (strcat "powershell -WindowStyle Hidden -ExecutionPolicy Bypass -File \"" psPath "\"")))
  48.             (setq *LastMessageBoxPID* (vlax-get-property Process 'ProcessID))
  49.             (vlax-release-object WshShell)
  50.         )
  51.         (progn
  52.             (alert msg)
  53.         )
  54.     )

  56. )


网友答:
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
系统的气泡呢

气泡我不会用。

这个方式可以打开多个弹窗。

实际使用场景应该还是比较少。
  • 上一篇：（国外搬运）全图删除所有标注
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025