[LISP函数]：获取CPU的ProcessorId

LADESIGNER

[PHP]
(defun ProcessorID (/ ID USERS4)
  (vl-load-com)
  (setq users4 (getvar "users4"))
  (vla-eval (vlax-get-acad-object)
            (strcat
                 "set colInstances = GetObject(\"Winmgmts:\").ExecQuery(\"Select * from Win32_Processor\")" ":"
                 "id = \"\"" ":"
                 "For each objInstance in colInstances" ":"
                 "id = id & objInstance.ProcessorId" ":"
                 "next" ":"
                 "ThisDrawing.SetVariable \"USERS4\", id"
                 )
           )
  (setq ID (getvar "users4"))
  (setvar "users4" users4)
  id
)
[/PHP]
较EACHY的兼容性好一些.

adisonmaster

好东西，先学习一下!

TLHMQH

好东西收藏了。

LADESIGNER

[PHP]
;;;修改自EACHY版主的程序.
;;;XP以下操作系统须下载安装WMI补丁.
(defun XDL-ProcessorID (/ ids wmiobj serv lox sn)
  (if (setq wmiobj (vlax-create-object "wbemScripting.SwbemLocator"))
    (progn
      (or
        (not(vl-catch-all-error-p(setq serv(vl-catch-all-apply 'vlax-invoke (list wmiobj 'ConnectServer "." "" "" "" "" "" 128 nil)))));;FOR XP系统.
        (setq serv(vlax-invoke wmiobj 'ConnectServer "." "" "" "" "" "")) ;;;XP以下操作系统.
        )
      (setq lox        (vlax-invoke
                  serv
                  'ExecQuery
                  "Select * from Win32_Processor"
                )
      )
      (setq ids nil)
      (vlax-for        item lox
        (if (not
              (member (setq sn (vlax-get item 'ProcessorID )) ids)
            )
          (setq ids (cons sn ids))
        )
      )
      (mapcar 'vlax-release-object (list lox serv wmiobj))
    )
  )
  (reverse ids)
)
[/PHP]

小菜

楼主能不能把硬盘ID的也改成VBA的写法？

LADESIGNER

最初由 小菜 发布
[B]楼主能不能把硬盘ID的也改成VBA的写法？ [/B]

把
[PHP]
"Select * from Win32_Processor"  改成 "Select * from Win32_DiskDrive"  
[/PHP]   
[PHP]   
(vlax-get item 'ProcessorID ) 改成(vlax-get item 'SerialNumber )
[/PHP]
就可以了。
98下测试Win32_DiskDrive无Serialnumber属性，WIN2000还未测试，估计对XP以下的操作系统无效。