土木在线论坛 \ 建筑设计 \ CAD下载及教程 \ 我想要加强修命令

我想要加强修命令

发布于:2007-04-19 09:53:19 来自:建筑设计/CAD下载及教程 [复制转发]
我想要加强修剪命令
我的是CAD2002,有没有加强修剪命令LISP
使得修剪象CAD05那样好用?

全部回复(4 )

只看楼主 我来说两句
  • 水的畅想
    水的畅想 沙发
    给的分太少了一点~~~
    别人的程序~
    不知道能不能满足你的胃口~
    2007-04-19 15:34:19

    回复 举报
    赞同0
  • 水的畅想
    水的畅想 板凳
    ;|
    思路from lijiao http://www.xdcad.net/forum/showthread.php?postid=1686237#post1686237
    可替代trim.
    参数详解:
    默认选择方式: 点中曲线,单点剪切;点于空位,启动自由画笔(sketch)方式.
    U-undo: 取消上次剪切操作,一键执行无须回车!
    R- redo: 恢复一次undo操作.
    E-edgemode开关: 控制剪切边是否延伸,含义同trim参数. 为开关型,有状态提示!
    P-投影模式 [0 无 / 1 UCS / 2 视图]
    C-框选: 框选实体边方式.
    (按住Shift键延伸):同时按shift为延伸命令,而非剪切.
    |;
    (defun c:t (/ cmd os roop dis un ss gr ga gb sel pt pt2 pts eg)
    ;; (getpts) = 取得grread跟踪点表,dis为控制精度的距离.
    (defun getpts (dis / gr pt pt0 pts)
    (while (= 5 (car (setq gr (grread t 4 0))))
    (setq pt (cadr gr))
    (if (not pt0)(setq pt0 pt pts (cons pt0 pts)))
    (if (> (distance pt pt0) dis)
    (progn
    (grdraw pt pt0 1 1)
    (setq pts (cons pt pts)
    pt0 pt)
    )
    )
    )
    (redraw)
    (reverse pts)
    )
    (defun *myerr* (msg) (setvar "cmdecho" cmd) (setvar "osmode" os) (setq *error* oe))
    (setq cmd (getvar "cmdecho")
    os (getvar "osmode")
    oe *error*
    *error* *myerr*
    roop T
    dis (* 0.01 (getvar "viewsize"))
    un 0
    )
    (setvar "cmdecho" 0)
    (setvar "osmode" 0)
    (princ "\n 选择剪切边< all >")
    (setq ss (ssget ":L"))
    (while roop
    (princ"\n U-undo R-redo E-edgemode开关 P-投影模式 选择模式:C-框选 修剪对象(按Shift键延伸)<退出>: ")
    (if (= 0 (getvar "edgemode"))
    (princ "\n边界延伸状态:*边界不延伸*")
    (princ "\n边界延伸状态:*边界延伸*")
    )
    (setq gr (grread nil 4 2) ga (car gr) gb (cadr gr))
    (cond
    ((= ga 3)
    (cond
    ((setq sel (nentselp gb))(command ".trim") (if ss (command ss))(command "")(command sel ""));;单选.
    (T (setq pts (getpts dis))
    (if (setq pts2(cdr pts))
    (progn (command ".trim") (if ss (command ss))(command "")
    (mapcar ’(lambda(x y)(command "f" x y "")) pts pts2)
    (command "")
    )
    )
    )
    )(setq un (1+ un))
    )
    ((member gr ’((2 117) (2 85)));; "U"
    (if (> un 0)
    (progn (command ".u") (setq un (1- un)))
    (princ "\n!没有可undo的内容了!")
    )
    )
    ((member gr ’((2 114)(2 82)));; "R"
    (setq un (1+ un))
    (command ".redo")
    )
    ((member gr ’((2 101)(2 69)));; "E"
    (setvar "edgemode" (abs(- (getvar "edgemode") 1)))
    )
    ((member gr ’((2 99)(2 67)));; "C"
    (if (and(setq pt (getpoint "\n框选第一点<回车退出>:"))(setq pt2 (getcorner pt "\n框选第二点<回车退出>:")))
    (progn
    (setq pts (list pt (list (car pt)(cadr pt2)) pt2 (list (car pt2)(cadr pt))))
    (command ".trim") (if ss (command ss))(command "")
    (mapcar ’(lambda(x y)(command "f" x y "")) pts (cons (last pts) pts))
    (command "")
    (setq un (1+ un))
    )
    )
    )
    ((member gr ’((2 112)(2 80)));; "P"
    (initget "0 1 2")
    (setvar "PROJMODE" (atoi (getkword "[0 无 / 1 UCS / 2 视图]:"))))
    ((member gr ’((11 0)(2 32)));; "" or enter
    (setq roop nil))
    )
    )
    (setvar "cmdecho" cmd)
    (setvar "osmode" os)
    (setq *error* oe)
    (princ)
    )
    2007-04-19 15:33:19

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

CAD下载及教程

返回版块

52.07 万条内容 · 656 人订阅

猜你喜欢

阅读下一篇

CAD中如何安装express工具栏?

在安装CAD的时候忘记安装express了 我又不想重新安装CAD 请问在哪是否可以下载一个这样的插件安装express工具栏 或者安装YY工具栏也可以请问在哪里可以下载这两个?

回帖成功

经验值 +10