几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量  


返回   几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量 » 仿射空间:CAX软件开发(三)二次开发与程序设计 » CAD二次开发 » AutoCAD二次开发 » 数据库ObjectDBX
用户名
密码
注册 帮助 会员 日历 银行 搜索 今日新帖 标记论坛为已读


回复
 
主题工具 搜索本主题 显示模式
旧 2009-04-28, 09:45 AM   #1
yang686526
高级会员
 
注册日期: 06-11
帖子: 14579
精华: 1
现金: 224494 标准币
资产: 234494 标准币
yang686526 向着好的方向发展
默认 【转帖】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即可。
yang686526离线中   回复时引用此帖
GDT自动化论坛(仅游客可见)
回复


主题工具 搜索本主题
搜索本主题:

高级搜索
显示模式

发帖规则
不可以发表新主题
不可以回复主题
不可以上传附件
不可以编辑您的帖子

vB 代码开启
[IMG]代码开启
HTML代码关闭



所有的时间均为北京时间。 现在的时间是 05:03 AM.


于2004年创办,几何尺寸与公差论坛"致力于产品几何量公差标准GD&T | GPS研究/CAD设计/CAM加工/CMM测量"。免责声明:论坛严禁发布色情反动言论及有关违反国家法律法规内容!情节严重者提供其IP,并配合相关部门进行严厉查处,若內容有涉及侵权,请立即联系我们QQ:44671734。注:此论坛须管理员验证方可发帖。
沪ICP备06057009号-2
更多