[原创]：利用机箱喇叭来放音乐,两只老虎

xshrimp

;;利用PC喇叭来放音乐,两只老虎.
;;xshrimp 2007.7.2
;;blog http://hi.baidu.com/xshrimp
;;使用方法,拷贝至cad搜索支持目录中加载两只老虎.lsp文件即可.

;;根据autoit的脚本转换为autolisp的程序.
;;http://autoit.net.cn/viewthread. ... ra=page%3D1#?page=2
;;Quicktool Win32Api For Lisp 作者:陈秋荣


[php]
;|
大家可以拿去随便修改
只是要解释一下用法，用book函数播放的用法

有三个参数，第一个是乐谱，是简谱，每个音符后边可以加H、L、Q、S，意思是：
h高一个8度
l低一个8度
Q半拍时间
S两拍时间

第二个参数，一拍的时间(毫秒)，第三个参数是音调，用"C"代表C调或者"D"代表D调
|;

(defun frequency($scale $melody / i)
(if (= $scale "0") (setq i 0))
(if (null $melody) (setq $melody "C"))
(cond ( (= $melody "C")
         (cond  ((= "1" $scale) (setq i 264))
                ((= "2" $scale) (setq i 297))
                ((= "3" $scale) (setq i 330))
                ((= "4" $scale) (setq i 352))
                ((= "5" $scale) (setq i 396))
                ((= "6" $scale) (setq i 440))
                ((= "7" $scale) (setq i 495))
           ) )
        ( (= $melody "D")
         (cond  ((= "1" $scale) (setq i 297))
                ((= "2" $scale) (setq i 334))
                ((= "3" $scale) (setq i 371))
                ((= "4" $scale) (setq i 396))
                ((= "5" $scale) (setq i 446))
                ((= "6" $scale) (setq i 495))
                ((= "7" $scale) (setq i 557))
           ) )
)
i
)
(defun book ($book $speed $melody / $duration $frequency i j jj)
(if $book
(progn
(setq $book (strcase  $book))
(if (null $melody) (setq $melody "C"))
(if (null $speed)  (setq $speed  500))
(setq j 1)
(repeat (strlen $book)
  (setq i (substr $book j 1))
  (setq $frequency (frequency i $melody))
  (if $frequency
  (progn
  (setq $Duration $speed)
  (setq jj (substr $book (+ 1 j) 1))
  (cond  ((= jj "H") (setq $frequency (*  (frequency i $melody) 2)))
         ((= jj "L") (setq $frequency (/  (frequency i $melody) 2)))
         ((= jj "Q") (setq $Duration (/ $speed 2)))
         ((= jj "S") (setq $Duration (* $speed 2)))
         )
  (if  (= $frequency 0)   
  (command "_.delay"   $speed)   
  (win32api "kernel32" "Beep" (list $frequency $Duration))
  )
  ))
  (setq j (+ j 1))
  )
  )
  )
)   
(defun c:lh() (book "12311231345034505Q6Q5Q4Q315Q6Q5Q4Q3126L1026L1" 300 "D"))     
(load "QTWin32Api.VLX")     ;加载Lisp程序接口
(setq path (vl-filename-directory (findfile "QTWin32Api.VLX"))) ;路径
(Quicktool_Initialize path)     ;初始化接口,参数指向Quicktool.dll文件所在目录
(load "QTWin32Api.VLX")
(princ "\n两只老虎.命令:lh")
(c:lh)
(princ)
[/php]
下载地址
http://groups.google.com/group/gpscad/web/tiger.zip

[iframe h=320 w=620]http://groups.google.com/group/gpscad/files[/iframe]