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


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


回复
 
主题工具 搜索本主题 显示模式
旧 2009-04-26, 02:02 PM   #1
yang686526
高级会员
 
注册日期: 06-11
帖子: 14579
精华: 1
现金: 224494 标准币
资产: 234494 标准币
yang686526 向着好的方向发展
默认 [求助]求一个自动打断并倒角的lisp

[求助]求一个自动打断并倒角的lisp
www.dimcax.com
[求助]求一个自动打断并倒角的lisp
哪位朋友能编个lisp,实现第一个图编为第二图

d
这个可满足楼主的要求:
;+---------------------+
;+ 四条直线快速修剪 +
;+ 文件名: trim4.lsp +
;+---------------------+
(defun c:t4( / index index1 ss p0 ss1 entn ent ty l_p1 l_p2 p1 p2 p3 p4 ang1 ang2
ang3 dist1 dist2 )
(defun inivar()
(setq osm (getvar "osmode"))
(setq cly (getvar "clayer"))
)
(defun resvar()
(setvar "osmode" osm)
(setvar "clayer" cly)
)
(inivar) ;初始化系统变量
(setvar "blipmode" 1)
(setq index 1
ss (ssadd) ;构件一个空选择集
) ;setq end
(setvar "osmode" 512) ;设定捕捉模式为nearest
(setq ss (ssget '((0 . "line"))))
(while (/= (sslength ss) 4)
(progn
(print "未选到四条直线,请重新选择")
(setq ss (ssget '((0 . "line"))))
)
)
(setvar "osmode" 0)
(setvar "blipmode" 0)
(setq index 0
l_p1 '()
l_p2 '()
) ;setq end
(repeat 4 ;获取每一根线的起点、终点
(setq ent (entget (ssname ss index))
index (+ 1 index)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
l_p1 (cons p1 l_p1)
l_p2 (cons p2 l_p2)
) ;setq end
) ;repeat end
(setq index 0 n 4
l_int '()
)
(repeat (1- n) ;计算交点
(setq p1 (nth index l_p1)
p2 (nth index l_p2)
index1 (1+ index)
index (1+ index)
) ;setq end
(repeat (- n index)
(setq p3 (nth index1 l_p1)
p4 (nth index1 l_p2)
index1 (1+ index1)
pt (inters p1 p2 p3 p4) ;求交点
l_int (if pt (cons pt l_int) l_int)
) ;setq end
) ;repeat end
) ;repeat end
(setq index 0
la (cdr (assoc 8 ent))
) ;setq end
(repeat n ;删除原直线
(setq entn (ssname ss index)
index (1+ index)
) ;setq end
(entdel entn)
) ;repeat end
(setq index 0)
(command "layer" "s" la "")
(repeat (1- n) ;重新画线
(setq p3 (nth index l_int)
index2 (1+ index)
index (1+ index)
) ;setq end
(repeat (- n index)
(setq index1 0
p4 (nth index2 l_int)
index2 (1+ index2)
) ;setq end
(repeat n
(setq p1 (nth index1 l_p1)
p2 (nth index1 l_p2)
index1 (1+ index1)
) ;setq end
(setq ang1 (angtos (angle p1 p2) 0 1)
ang2 (angtos (angle p1 p3) 0 1)
ang3 (angtos (angle p1 p4) 0 1)
) ;setq end
(if (= ang1 ang2 ang3)
(progn
(setq dist1 (distance p1 p3)
dist2 (distance p1 p4)
) ;set end
(if (< dist1 dist2)
(progn
(command "line" p1 p3 "")
(command "line" p4 p2 "")
) ;progn end
(progn
(command "line" p1 p4 "")
(command "line" p3 p2 "")
) ;progn end
) ;if end
) ;progn end
) ;if end
) ;repeat end
) ;repeat end
) ;repeat end
(redraw)
(resvar) ;还原系统变量
(princ)
) ;defun end
d
楼上的只能一次打断四条线,如果想打断井字梁的话还是去找一个全部打断的程序 然后用vla-get-length把长度小于梁宽(比如400)的线段用vla-delete删除!就可以实现楼主的效果
d
yang686526离线中   回复时引用此帖
GDT自动化论坛(仅游客可见)
回复


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

高级搜索
显示模式

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

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



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


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