VBA随机数源码汇总.docxVIP

(defun rnd(rMin rMax) (vla-eval (vlax-get-acad-object) ThisDrawing.setVariable USERR5 ,CDbl(Rnd) ) (+ rMin(* (getvar userr5)(- rMax rMin) ) ;(setq ArgLst (Do you want to continue ? 50 ;MsgBox Demonstration DEMO.HLP 1000) ;用法：(MsgBox Arglst) (defun Msgbox(ArgLst / Msg Style Title Helpfn Ctxt) (mapcar set (list Msg Style Title Helpfn Ctxt) ArgLst) (vla-eval (vlax-get-acad-object) (strcat ThisDrawing.setVariable USERI5 ,CInt(MsgBox( Msg (if Style (strcat , (itoa Style) ) (if Title (strcat , Title ) ) (if Helpfn (strcat , Helpfn ) ) (if Ctxt (strcat , (itoa Ctxt) ) ) ) (getvar useri5) ) (defun StrConv(Str conv) (vla-eval (vlax-get-acad-object) (strcat ThisDrawing.setVariable USERS5 ,CStr(StrConv( Str , (itoa Conv) ) ) (getvar users5) ) ;| (X-vbfun typ vbfun) = 运行简单的vb函数- v1.0 b -梦断江南.2004.9 参数: typ 函数返回值的vb类型. vbfun = 简单的vb函数. 返回: 设置于 USERR5变量中的值. 实例:(x-vbfun variant (rnd) ; 出错.显示设置系统变量出错.! (x-vbfun double (rnd) ;-0.533424 :取得随机数.ok (x-vbfun integer (msgbox(hello，x-vbfun,3,test) ;- 6.0 :显示信息框，参数详vb函数参考.ok. (x-vbfun single (msgbox(test1,3) ;出错.显示设置系统变量出错.! 要点: typ 必须于 vbfun 返回值类型相一致! 参考: /forum/showthread.php?s=&threadid=259492 |; (DEFUN X-vbfun (typ vbfun / typlst) (setq typlst (BOOLEAN . CBOOL)(BYTE . CBYTE)(CURRENCY . CCUR)(DOUBLE . CDBL)(DECIMAL . CDEC) (INTEGER . CINT)(LONG . CLNG)(SINGLE . CSNG)(STRING . CSTR)(VARIANT . CVAR) (vla-eval (vlax-get-acad-object) (strcat thisdrawing.setvariable USERR5 , (cdr(assoc (strcase (vl-symbol-name typ) typlst) ( (vl-prin1-to-string vbfun) ) ) ) (getvar USERR5) ) 提醒一点，好像都没有想过把User系列变量还原，？ 好像用Users15要好些吧？ Msgbox用下面的代替，也可以 (vlax-invoke-method (vlax-create-object WScript.Shell) Popup why 7 Answer This Question: 1) 实际上WScript.Shell的功能也很强大，：） 发现一个办法，可以不用传递系统变量了 (setq a (vlax-create-Object ScriptControl) (vlax-put-property a language vbs) (vla-eval a Rnd() 前面的 (setq a (vla-GetInterfaceObject (vlax-get-acad-object) ScriptControl) (vlax-put-property a language vbs) 只运行一次 你应该只运行 (vla-eval a Rnd() VB的随机数是“伪随机数”，：） VB的随机数，也是通过一种算法进行运算的，每一次的数的顺序都一样 你可以把 (setq a (vla-GetInterfaceObject (vlax-get-acad-object) ScriptControl) (vlax-put-property a language vbs) 放在启动时加载 调用时运行(vla-eval a Rnd()即可 例，在Acad.lsp文件里加入 (setq Tls-VBScript (vlax-create-Object ScriptControl) (vlax-put-property Tls-VBScript language vbs) (defun Rnd() (vla-eval Tls-VBScript Rnd() 嗯，的确可以了：） 另外，wscri pt.shell 已经有实例。那么wscri pt 对象如何取得？ 如果用 (setq a (vla-GetInterfaceObject (vlax-get-acad-object) ScriptControl) (vla-eval a Rnd()可以，但是(vla-eval a Randomize) 却又不行了，why？ (vla-GetInterfaceObject (vlax-get-acad-object) wscri pt.shell)可以获得 另外，(setq a (vla-GetInterfaceObject (vlax-get-acad-object) ScriptControl)总容易引起内存不足的错误，好像(setq a (vlax-create-Object ScriptControl)不会，没有过多的测试，：） 对于没有返回值的过程要调用ScriptControl对象的ExecuteStatement方法 不过对于Randomize好像没什么用，Randomize作用于过程，如果做出来了的话，调用Randomize和Rnd是两个过程，没有效果 另外，我上面的方法有问题，ScriptControl对象不能做全局变量，只能做局部变量，否则总会引起内存不足（太大了），Rnd不能用这种方法，其他的可以 下面做成函数调用VBS函数 调用格式： (tls-eval msgbox (Are u ready? 1 TlsCad) (defun tls-vbs() (setq Tls-VBScript (vlax-create-Object ScriptControl) (vlax-put-property Tls-VBScript language vbs) Tls-VBScript ) (defun tls-join(chrs fchr / pstr) (setq pstr ) (foreach i Chrs (setq pstr (strcat pstr i fchr) (substr pstr 1 (- (strlen pstr) (strlen fchr) ) (defun tls-eval(funname args) (vla-eval (tls-vbs) (strcat (vl-prin1-to-string funname) ( (tls-join (mapcar vl-prin1-to-string args) ,) ) ) *在Label标签中随机产生1-80的数，用空格来控制随机数的停止与开始。谢谢了! Private Sub Form_KeyPress(KeyAscii As Integer) VBA.Randomize If KeyAscii = 32 Then Label1.Caption = Int(Rnd() * 80 + 1) End If End Sub Private Sub Form_Load() Me.KeyPreview = True End SubPublic IsRnd As Boolean Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 32 Then IsRnd = Not IsRnd End If If IsRnd Then Timer1.Enabled = True Else Timer1.Enabled = False End If End Sub Private Sub Form_Load() IsRnd = False Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Label1.Caption = Int(Rnd() * 80 + 1) End Sub 以上是我做的，这里有一个timer控件*vb随机数排序问题vb随机数排序问题 1.随机产生10个1,100的自然数.这是个数要显示在label里 2.对这是个数进行排序,排序结果显示在另一个label里 3.把排序结果存入到文件中 (用output语句的那个). 第一个我做了一下,就是显示在label里的时候就只能显示一个数字了.如果用print语句在form上显示就可以显示10个.第一步的代码是这样滴. Dim a(1 To 10) As Integer Randomize For i = 1 To 10 a(i) = Int(Rnd * 100 + 1) Print a(i) Next i 而且 倒数第一行和第二行语句我觉得应该顺序应该是先是next i然后 print a(i) 可是一换过来,就出错说下标越界. 我很困惑. 要是你也不明白我后面说的什么,就帮我重做一下吧! =新建 Form1 ,添加 Label1 , Label2 和 Command1 ,复制以下代码： Private Sub Command1_Click() Form_Load Dim a(1 To 10) As Integer, m As Integer Randomize For i = 1 To 10 a(i) = Int(Rnd * 100 + 1) Label1.Caption = Label1.Caption + & a(i) Next i x = MsgBox(单击“是”选择升序,单击“否”选择降序., vbYesNo + vbInformation, 排序) If x = vbYes Then m = 100 Label2.Caption = 排序结果(升序): For j = 1 To 10 For i = 1 To 10 If a(i) = m Then m = a(i) Next i For i = 1 To 10 If a(i) = m Then Label2.Caption = Label2.Caption + & a(i) a(i) = 0 End If Next i m = 1 Next j End If Open c:result.txt For Output As #1 Write #1, Label2.Caption Close #1 MsgBox 结果已经输出到 c:result.txt ., vbOKOnly + vbInformation, 结果 End Sub Public Sub Form_Load() Label1.AutoSize = True Label2.AutoSize = True Label1.Caption = 自然数: Label2.Caption = 排序结果: Command1.Caption = &Done End Sub *现数据库中有一表记录了姓名,卡号两个记录,请问如何实现从数据库中取出所有的记录,通过按下按钮command1后,随机在这些记录中抽取其中一条记录并显将所有记录读取到一个数组或者一个集合中，找出最大记录数，然后用随机数生成一个这个0和最大数之间的一个ID，安这个ID从数组或集合中取出就可以了type tRecord Name as string Code as Long end type Private Sub Command2_Click() dim gRecord() as tRecord dim Index as Long dim oRecord as tRecord rs.open Select Count(*) From Talbe,cn,adOpenDynamic, adLockOptimistic redim gRecord(rs.fields(0)-1) rs.Close Index = 0 rs.open Select * From Talbe,cn,adOpenDynamic, adLockOptimistic Do While Not rs.Eof gRecord(Index).Name = Trim(rs.Fields(Name) gRecord(Index).Code = rs.Fields(Code) Index = Index + 1 Loop rs.Close Index = (UBound(gRecord) * Rnd) set oRecord = gRecord(Index) End Sub *产生不重复随机数的问题Dim i As Integer For i = 1 To 125 Randomize Timer rndNum(i) = Int(250 * Rnd) + 1) Text1.Text = Text1.Text & rndNum(i) & vbCrLf Next i 生成 1 到 250 的125个随机数，要求无重复数。 上面的代码生成的有重复。 =Dim i As Integer For i = 1 To 125 Randomize Timer rndnum(i) = Int(250 * Rnd) + 1) If InStr(Text1.Text, rndnum(i) 0 Then i = i - 1 Else Text1.Text = Text1.Text & rndnum(i) & vbCrLf End If Next i =探索一下论坛，这类问题特多，解决方法也多。 用集合的方法： Dim iCol As Collection Dim i As Integer, index As Integer Dim Nums Set iCol = New Collection For i = 1 To 125 iCol.Add i Next For i = 1 To iCol.Count Randomize index = CInt(Rnd * (iCol.Count - 1) + 1 Nums = iCol.Item(index) Print Nums iCol.Remove index Next Set iCol = Nothing=dim data(249) as integer dim i as integer,j as integer,tmp as integer for i=0 to 249 data(i)=i+1 next Randomize for i=0 to 124 j=Int(250 * Rnd) tmp=data(i) data(i)=data(j) data(j)=tmp next 循环结束则DATA（0）到DATA（124）这125个元素就是无重复随机数=Sub finds(ByVal max As Integer, ByVal num As Integer) Dim a() As String, i As Integer, temp As Long, x As String ReDim a(1 To max) For i = 1 To max a(i) = i Next For i = 1 To num Randomize temp = i + Int(max - i) * Rnd) x = a(temp) a(temp) = a(i) a(i) = x Next ReDim Preserve a(1 To num) MsgBox Join(a, ,) End Sub Private Sub Command1_Click() finds 250, 125 End Sub=如果你要用“跳蚤”的话，下面是这个算法的一个比较完善的函数。函数写这么麻烦是因为它有个更复杂的用途。 测试代码： Dim rndNum() As Long ReDim rndNum(250) 也可以：ReDim rndNum(1 to 250) 扫描域 1-125 交换域 1-250 FleaRandom rndNum(),True,True,1,125,1,250 需要注意的是：扫描域小于交换域的情况是一种快速算法，但是它与正常算法的结果从概率角度分析是否效果一样还有待研究。曾经有人对这个快速算法提出过疑问。 这个函数的真正用途是多段用法，是相当有趣的一个东西。如果你需要给教育机构编写试卷随机生成，我可以教你怎么用。 下面是函数： FleaRandom Module KiteGirl 2005 Public Sub FleaRandom(ByRef pList() As Long, Optional ByVal pSet_Scan As Boolean = False, Optional ByVal pSet_Swap As Boolean = False, Optional ByVal pScan_Start As Long = 0, Optional ByVal pScan_End As Long = 0, Optional ByVal pSwap_Start As Long = 0, Optional pSwap_End As Long = 0) FleaRandom函数 语法：FleaRandom(pList() ,pSet_Scan, pSet_Swap, pScan_Start, pScan_End, pSwap_Start, pSwap_End ) 说明：以“跳蚤算法”对序列进行乱序处理。 参数： long pList() 必要参数。作为序列容器的数组。 boolean pSet_Scan 可选参数。扫描域设置开关。使其为true则用户设置的扫描域参数有效。 boolean pSet_Swap 可选参数。交换域设置开关。使其为true则用户设置的交换域参数有效。 long pScan_Start 可选参数。扫描域开始。 long pScan_End 可选参数。扫描域结束。 long pSwap_Start 可选参数。交换域开始。 long pSwap_End 可选参数。交换域结束。 交换设置导入 Dim tSwap_Start As Long 交换域开始 Dim tSwap_End As Long 交换域结束 If pSet_Swap Then tSwap_Start = pSwap_Start tSwap_End = pSwap_End Else tSwap_Start = LBound(pList() tSwap_End = UBound(pList() End If 交换范围 Dim tSwap_Count As Long 交换域元素数 tSwap_Count = (tSwap_End - tSwap_Start) + 1 tSwap_End - tSwap_Start = 2147483646 交换补偿 Dim tSwap_Rep As Long 交换补偿 tSwap_Rep = tSwap_Start 扫描设置导入 Dim tScan_Start As Long 扫描开始 Dim tScan_End As Long 扫描结束 If pSet_Scan Then tScan_Start = pScan_Start tScan_End = pScan_End ElseIf (Not pSet_Scan) And pSet_Swap Then tScan_Start = tSwap_Start tScan_End = tSwap_End Else tScan_Start = LBound(pList() tScan_End = UBound(pList() End If 序列扰乱 Dim tList_Index As Long 序列索引 Dim tList_Index_Sur As Long 序列索引_源 Dim tList_Index_Des As Long 序列索引_目的 For tList_Index = tScan_Start To tS