Author Topic: VBS in cad (lisp)  (Read 1458 times)

0 Members and 1 Guest are viewing this topic.

xshrimp

  • Mosquito
  • Posts: 14
VBS in cad (lisp)
« on: March 08, 2009, 04:04:24 AM »
Code: [Select]
;;;xshrimp 2009.03.08
;;;(gps->rnd 10)->8
;;;(gps->rnd 10)->5
(defun gps->rnd  (int / retun str )
(setq str(strcat"Dim ret\nret = Int((" (itoa int)" * Rnd) + 1) " ))
(if (not #wscript#)(setq #wscript# (vlax-create-object "ScriptControl")))
(vlax-put #wscript# 'language "vbs")
(vlax-invoke-method #wscript# 'ExecuteStatement str)
(setq retun (vlax-invoke-method #wscript# 'eval "ret"))
(if retun (fix retun) )
)
« Last Edit: March 12, 2009, 11:42:44 AM by xshrimp »
abc

xshrimp

  • Mosquito
  • Posts: 14
Re: VBS in cad (lisp)
« Reply #1 on: March 08, 2009, 04:05:26 AM »
Code: [Select]
;;;xshrimp 2009.03.08
(defun gps->getfiled  (/ str )
(setq str
 "Function GetTargetFileName
         Set objDialog = CreateObject(\"UserAccounts.CommonDialog\")
         objDialog.Filter = \"DwgFile(*.dwg)|*.dwg\"
         objDialog.InitialDir = \".\"
         If objDialog.ShowOpen <> 0 Then                 
              GetTargetFileName = objDialog.FileName
         End If
         Set objDialog = Nothing
End Function
ret = GetTargetFileName
"
 )
(if (not #wscript#)(setq #wscript# (vlax-create-object "ScriptControl")))
(vlax-put #wscript# 'language "vbs")
(vlax-invoke-method #wscript# 'ExecuteStatement str)
(vlax-invoke-method #wscript# 'eval "ret")
)
Code: [Select]
;;;xshrimp 2009.03.08
(defun gps->InputBox( / retun str )
(setq str "dim ret \n ret=InputBox(\"Enter your name\") ")
  (if (not #wscript#)(setq #wscript# (vlax-create-object "ScriptControl")))
  (vlax-put #wscript# 'language "vbs")
  (vlax-invoke-method #wscript# 'ExecuteStatement str)     
  (setq retun (vlax-invoke-method #wscript# 'eval "ret")) 
  retun
)
« Last Edit: March 12, 2009, 11:43:39 AM by xshrimp »
abc

xshrimp

  • Mosquito
  • Posts: 14
Re: VBS in cad (lisp)
« Reply #2 on: March 08, 2009, 04:23:50 AM »
Code: [Select]
(defun gps->about( / str )
(setq str
"Dim oIE, doc1   
    Set oIE = CreateObject(\"InternetExplorer.Application\")
    oIE.Navigate \"about:blank\" 
    oIE.Visible = 1             
    oIE.ToolBar = 0
    oIE.StatusBar = 0
    oIE.Width=750
    oIE.Height=700
    Do While (oIE.Busy): Loop
    Set doc1 = oIE.Document     
    doc1.open             
    doc1.writeln \"<html><head><title>显示系统环境变量</title></head>\"
    doc1.writeln \"<body bgcolor='silver'><pre><center><font color=red size=5>系统环境变量</font></center><p><font color=blue size=3>\"
Set wshshell = CreateObject(\"#wscript#.Shell\")
For Each EnvirSYSTEM In wshshell.Environment(\"SYSTEM\")
 enOutSYSTEM=enOutSYSTEM&\"当前\"&EnvirSYSTEM&vbCrlf
Next
For Each EnvirPROCESS In wshshell.Environment(\"PROCESS\")
 enOutPROCESS=enOutPROCESS&\"当前\"&EnvirPROCESS&vbCrlf
Next
For Each EnvirUSER In wshshell.Environment(\"USER\")
 enOutUSER=enOutUSER&\"当前\"&EnvirUSER&vbCrlf
Next
For Each EnvirVOLATILE In wshshell.Environment(\"VOLATILE\")
 enOutVOLATILE=enOutVOLATILE&\"当前\"&EnvirVOLATILE&vbCrlf
Next
 doc1.writeln enOutSYSTEM&enOutPROCESS&enOutUSER&enOutVOLATILE
doc1.writeln \"</font></p></pre></body></html>\"
    doc1.close                 
set wshshell=nothing
set oIE=nothing
")
  (setq #wscript# (vlax-create-object "ScriptControl"))
  (vlax-put #wscript# 'language "vbs")
  (vlax-invoke-method #wscript# 'ExecuteStatement str)
  (setq retun (vlax-invoke-method #wscript# 'eval "ret"))
   
)
« Last Edit: March 12, 2009, 11:44:32 AM by xshrimp »
abc

xshrimp

  • Mosquito
  • Posts: 14
Re: VBS in cad (lisp)
« Reply #3 on: March 08, 2009, 04:30:19 AM »
Code: [Select]
;;;xshrimp 2009.03.08
(defun gps->date( / str )
(setq str "msgbox date & vbcrlf & time & vbcrlf & weekdayname(weekday(date))")
  (if (not #wscript#)(setq #wscript# (vlax-create-object "ScriptControl")))
  (vlax-put #wscript# 'language "vbs")
  (vlax-invoke-method #wscript# 'ExecuteStatement str)   
)
« Last Edit: March 12, 2009, 11:45:21 AM by xshrimp »
abc