【转帖】lisp源码共享
 

lisp源码共享
www.dimcax.com
lisp源码共享
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;zml84制作于2006-12-07
;;;==========================================
;;;全局变量说明：
;;;edge_jl 外延距离
;;;==========================================
(defun c:tt (/ s0 s1 pt entl lx
pt0 pt0_old pt1 pt1_old)
(princ "\n★★超级修剪★★")
(setq cmdecho_old (getvar "cmdecho")
)
(setvar "cmdecho" 0)
(if (or (= edge_jl "") (= edge_jl nil))
(setq edge_jl 5.0)
)
(princ
(strcat "\n当前设置:投影="
(nth (getvar "projmode") '("不投影" "当前ucs" "当前视图"))
"，边="
(nth (getvar "edgemode") '("不延伸" "延伸"))
"，外延距离="
(rtos edge_jl 2 (getvar "luprec"))
)
)
(princ "\n选择剪切边...")
(setq s0 (ssget))
(if (= s0 nil)
(princ "\n★未选择边界，即将退出。")
(progn
(setq s1 nil)
(while (or (/= s1 nil)
(/= nil
(progn (initget 4 "p e d u")
(setq pt (getpoint
"\n选择要修剪的对象，或 [投影(p)/边(e)/外延距离(d)/放弃(u)]:"
)
)
)
)
)
(cond
((= pt "p") ;分支一：投影选项设置
(progn
(initget 4)
(setq
xx (getint
(strcat
"\n输入投影选项 [无(0)/ucs(1)/视图(2)] <"
(itoa (getvar "projmode"))
">:"
)
)
)
(if (or (= xx 0) (= xx 1) (= xx 2))
(setvar "projmode" xx)
)
)
)
((= pt "e") ;分支二：边延伸选项设置
(progn
(initget 4)
(setq xx (getint
(strcat
"\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <"
(itoa (getvar "edgemode"))
">:"
)
)
)
(if (or (= xx 0) (= xx 1))
(setvar "edgemode" xx)
)
)
)
((= pt "d") ;分支三：外延距离选项设置
(progn
(initget 4)
(setq xx (getdist
(strcat
"\n输入外延的距离 <"
(rtos edge_jl
2
(getvar "luprec")
)
">:"
)
)
)
(if (>= xx 0)
(setq edge_jl xx)
)
)
)
((= pt "u") ;分支四：撤销上一步操作
(command "_.undo" 1)
)
((listp pt) ;分支五：对选中的对象进行修剪操作
(if (ssget pt)
(progn
(setq s1 (list (ssname (ssget pt) 0) pt))
(setq entl (entget (car s1) '("*"))
lx (dxf_let entl 0)
)
(cond ;对各种对象类型进行操作。
((= lx "line")
(progn
(command "_.undo" "be")
(setq pt0_old (dxf_let entl 10)
pt1_old (dxf_let entl 11)
)
(command "_trim" s0 "" s1 "")
(setq entl (entget (car s1) '("*")))
(setq pt0 (dxf_let entl 10)
pt1 (dxf_let entl 11)
)
(if (and (equal pt0 pt0_old)
(equal pt1 pt1_old)
)
(princ "\n★对象未与边相交。")
(progn
(if (not (equal pt0 pt0_old))
;检查起点
(dxf_set
entl
10
(polar pt0
(angle pt0 pt0_old)
edge_jl
)
)
(if (not (equal pt1 pt1_old))
;检查终点
(dxf_set
entl
11
(polar pt1
(angle pt1
pt1_old
)
edge_jl
)
)
)
)
(command "_.undo" "e")
)
)
)
)
((= lx "arc")
(princ (strcat "\n★对象类型为\""
lx
"\"，暂不能处理。"
)
)
)
(t
(princ
(strcat "\n★对象类型\""
lx
"\"，拒绝操作。"
)
)
)
)
)
(princ "\n★未选择到对象。")
)
) ;结束 分支五
) ;结束 cond 结束分支
(setq s1 nil)
) ;结束 while
)
) ;结束 if
(setvar "cmdecho" cmdecho_old)
(princ "\n★正常结束。谢谢使用。")
(princ)
);结束 defun
;;;定义函数，用于提取属性。
(defun dxf_let (ent n)
(if (assoc n ent)
(cdr (assoc n ent))
nil
)
);结束 defun
;;;定义函数，用于修改属性。
(defun dxf_set (ent n nr)
(if (assoc n ent)
(progn
(setq ent (subst (cons n nr) (assoc n ent) ent)
)
(entmod ent)
)
nil
) ;结束 if
);结束 defun
(princ "\n\n★超级修剪。键入命令\"tt\"执行。")
(princ)

最好也可以说明哈功能啊 只有源代码页没有用啊

怎么没有说明什么功能啊

不怎好用,打断处怎不在交点处,还偏移5mm

这是个剪切的命令，你可以把它复制到文本txt文件后，再存为.lsp文件，再通过cad中的工具-加载应用程序里加载后，在命令行输入tt即可。