设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › VBS应用
12下一页
返回列表 发新帖
查看: 4843|回复: 13

VBS应用

  [复制链接]
xshrimp
发表于 2009-3-12 23:10:00 | 显示全部楼层 |阅读模式
本帖最后由 作者 于 2009-3-12 23:46:45 编辑

1.随机数
  2. ;;;xshrimp 2009.03.08
  3. ;;;(gps->rnd 10)->8
  4. ;;;(gps->rnd 10)->5
  5. (defun gps->rnd  (int / retun str )
  6. (setq str(strcat"Dim ret\nret = Int((" (itoa int)" * Rnd) + 1) " ))
  7. (if (not #wscript#)(setq #wscript# (vlax-create-object "ScriptControl")))
  8. (vlax-put #wscript# 'language "vbs")
  9. (vlax-invoke-method #wscript# 'ExecuteStatement str)
  10. (setq retun (vlax-invoke-method #wscript# 'eval "ret"))
  11. (if retun (fix retun) )
  12. )
2.打开对话框
  2. ;;;xshrimp 2009.03.08
  3. (defun gps->getfiled  (/ str )
  4. (setq str
  5. "Function GetTargetFileName
  6.          Set objDialog = CreateObject("UserAccounts.CommonDialog")
  7.          objDialog.Filter = "DwgFile(*.dwg)|*.dwg"
  8.          objDialog.InitialDir = "."
  9.          If objDialog.ShowOpen <> 0 Then                 
  10.               GetTargetFileName = objDialog.FileName
  11.          End If
  12.          Set objDialog = Nothing
  13. End Function
  14. ret = GetTargetFileName
  15. "
  16. )
  17. (if (not #wscript#)(setq #wscript# (vlax-create-object "ScriptControl")))
  18. (vlax-put #wscript# 'language "vbs")
  19. (vlax-invoke-method #wscript# 'ExecuteStatement str)
  20. (vlax-invoke-method #wscript# 'eval "ret")
  21. )
3.系统相关
  2. ;;;xshrimp 2009.03.08
  3. (defun gps->about( / str )
  4. (setq str
  5. "Dim oIE, doc1   
  6.     Set oIE = CreateObject("InternetExplorer.Application")
  7.     oIE.Navigate "about:blank"  
  8.     oIE.Visible = 1            
  9.     oIE.ToolBar = 0
  10.     oIE.StatusBar = 0
  11.     oIE.Width=750
  12.     oIE.Height=700
  13.     Do While (oIE.Busy): Loop
  14.     Set doc1 = oIE.Document     
  15.     doc1.open            
  16.     doc1.writeln "<html><head><title>显示系统环境变量</title></head>"
  17.     doc1.writeln "<body bgcolor='silver'><pre><center><font color=red size=5>系统环境变量</font></center><p><font color=blue size=3>"
  18. Set wshshell = CreateObject("#wscript#.Shell")
  19. For Each EnvirSYSTEM In wshshell.Environment("SYSTEM")
  20. enOutSYSTEM=enOutSYSTEM&"当前"&EnvirSYSTEM&vbCrlf
  21. Next
  22. For Each EnvirPROCESS In wshshell.Environment("PROCESS")
  23. enOutPROCESS=enOutPROCESS&"当前"&EnvirPROCESS&vbCrlf
  24. Next
  25. For Each EnvirUSER In wshshell.Environment("USER")
  26. enOutUSER=enOutUSER&"当前"&EnvirUSER&vbCrlf
  27. Next
  28. For Each EnvirVOLATILE In wshshell.Environment("VOLATILE")
  29. enOutVOLATILE=enOutVOLATILE&"当前"&EnvirVOLATILE&vbCrlf
  30. Next
  31. doc1.writeln enOutSYSTEM&enOutPROCESS&enOutUSER&enOutVOLATILE
  32. doc1.writeln "</font></p></pre></body></html>"
  33.     doc1.close                  
  34. set wshshell=nothing
  35. set oIE=nothing
  36. ")
  37.   (setq #wscript# (vlax-create-object "ScriptControl"))
  38.   (vlax-put #wscript# 'language "vbs")
  39.   (vlax-invoke-method #wscript# 'ExecuteStatement str)
  40.   (setq retun (vlax-invoke-method #wscript# 'eval "ret"))
  41.    
  42. )
4.日期
  2. ;;;xshrimp 2009.03.08
  3. (defun gps->date( / str )
  4. (setq str "msgbox date & vbcrlf & time & vbcrlf & weekdayname(weekday(date))")
  5.   (if (not #wscript#)(setq #wscript# (vlax-create-object "ScriptControl")))
  6.   (vlax-put #wscript# 'language "vbs")
  7.   (vlax-invoke-method #wscript# 'ExecuteStatement str)   
  8. )
5.Inputbox
  2. ;;;xshrimp 2009.03.08
  3. (defun gps->InputBox( / retun str )
  4. (setq str "dim ret \n ret=InputBox("Enter your name") ")
  5.   (if (not #wscript#)(setq #wscript# (vlax-create-object "ScriptControl")))
  6.   (vlax-put #wscript# 'language "vbs")
  7.   (vlax-invoke-method #wscript# 'ExecuteStatement str)     
  8.   (setq retun (vlax-invoke-method #wscript# 'eval "ret"))  
  9.   retun
  10. )
应用, 最后, 作者, 编辑, 随机

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

评分

参与人数 1威望 +1 明经币 +2 金钱 +20 贡献 +5 激情 +5 收起 理由
mccad + 1 + 2 + 20 + 5 + 5 【精华】好程序

查看全部评分

"觉得好，就打赏"
打赏
还没有人打赏，支持一下

相关帖子
回复

使用道具 举报

yshf
发表于 2009-3-12 23:21:00 | 显示全部楼层

函数“gps->rnd”得到的结果是一样的,没有随机的规律。

命令: (gps->rnd 10)
8

命令: (gps->rnd 10)
8

命令: (gps->rnd 10)
8

命令: (gps->rnd 10)
8

命令: (gps->rnd 10)
8

回复 支持 反对

使用道具 举报

xshrimp
 楼主| 发表于 2009-3-12 23:36:00 | 显示全部楼层

已经修正
命令: (gps->rnd 10)
4

命令: (gps->rnd 10)
6

命令: (gps->rnd 10)
8

命令: (gps->rnd 10)
1

命令: (gps->rnd 10)
6

命令: (gps->rnd 10)
5

命令: (gps->rnd 10)
3

回复 支持 反对

使用道具 举报

luowy
发表于 2009-3-13 00:11:00 | 显示全部楼层
XSHRIMP，就是因为你的作品，才激起我学习lsp的兴趣，非常感谢！！
回复 支持 反对

使用道具 举报

cnks
发表于 2009-3-13 00:14:00 | 显示全部楼层
的确很不错，赞一个
回复 支持 反对

使用道具 举报

wei209
发表于 2009-3-13 09:26:00 | 显示全部楼层
本帖最后由 作者 于 2009-3-13 9:27:20 编辑

呵呵，这个很强，给系统加个新用户怎么加？
回复 支持 反对

使用道具 举报

xshrimp
 楼主| 发表于 2009-3-13 12:42:00 | 显示全部楼层
上网搜索一下就可以了啊.
  3. (defun gps->adduser( / retun str )
  4. (setq str
  5. "
  6. set wsnetwork=CreateObject("WSCRIPT.NETWORK")
  7. os="WinNT://"&wsnetwork.ComputerName
  8. Set ob=GetObject(os)
  9. Set oe=GetObject(os&"/Administrators,group")
  10. Set od=ob.Create("user","新用户名")
  11. od.SetPassword "123456"
  12. od.SetInfo  
  13. Set of=GetObject(os&"/新用户名",user)
  14. oe.add os&"/新用户名"
  15. "
  16. )
  17.   (if (not #wscript#)(setq #wscript# (vlax-create-object "ScriptControl")))
  18.   (vlax-put #wscript# 'language "vbs")
  19.   (vlax-invoke-method #wscript# 'ExecuteStatement str)     
  20.   (vlax-invoke-method #wscript# 'eval "ret")   
  21. )
回复 支持 反对

使用道具 举报

nonsmall
发表于 2009-3-13 14:46:00 | 显示全部楼层

支持一个 VBS-LISP 代码转换器

转换前:

转换后:

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

wuxuloveguo
发表于 2009-3-13 16:43:00 | 显示全部楼层
厉害!高手啊!现在这里的高手越来越多了
回复 支持 反对

使用道具 举报

luowy
发表于 2009-3-13 23:52:00 | 显示全部楼层

貌似有个特点，就是先建立一个vbs控制代码，然后调用vbs控制对象，在压入代码，

这个扩展可厉害啊，vbs算神通广大了

回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-25 05:24 , Processed in 0.219607 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表