找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 2009|回复: 30

[LISP程序]:【--连接断线程序--】

[复制链接]
发表于 2004-3-29 17:14:45 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
[program]
;;;|********连接断线程序********
;;;|共线则连接,不共线则0半径倒角
;;;|制作:SNSJ 2004.3.29
(defun c:lj (/ ent ent1 pt1 pt2 pt3 pt4 ptlst ptls kj fltrad memb sel sel1 x y)
  (setq fltrad (getvar "filletrad"))(setvar "filletrad" 0)
(setq sel (entsel"\n拾取第一条线<LINE,PLINE,ARC>:") ent (car sel)
      sel1 (entsel"\n拾取另一条线<LINE,PLINE,ARC>:")ent1 (car sel1))
(setq pt1(vlax-curve-getStartPoint ent)
      pt3(vlax-curve-getStartPoint ent1)
      pt2(vlax-curve-getEndPoint ent)
      pt4(vlax-curve-getEndPoint ent1))
    (if(and(and(=(cdr(assoc 0(entget ent)))"LINE")
           (=(cdr(assoc 0(entget ent1)))"LINE"))
      (and(null(inters pt1 pt2 pt3 pt4 nil))
            (equal(angle pt1 pt3)(angle pt1 pt4)0.0000001))
           )     
      (progn
  (setq ptlst (list (list pt1 pt3)
                    (list pt1 pt4)
                    (list pt2 pt3)
                    (list pt2 pt4)
                    )
        )
(mapcar '(lambda (x)
           (setq kj (cons(apply 'distance x)kj))
           )
        ptlst
        )
(mapcar '(lambda (y)
  (if (=(apply 'distance y)(apply 'max kj))
    (setq ptls y)
    )
           )ptlst
        )
  (cond((/=(setq memb (member(car ptls)(list pt1 pt2)))nil)               
        (if(=(cadr ptls)pt3)
(vla-put-endpoint (vlax-ename->vla-object ent1)
                  (vlax-3d-point(car ptls)))
(vla-put-startpoint (vlax-ename->vla-object ent1)
                    (vlax-3d-point(car ptls)))          
          )(vl-cmdf ".erase" ent "")
        )
       (t(if(=(car ptls)pt1)
(vla-put-endpoint (vlax-ename->vla-object ent)
                  (vlax-3d-point(cadr ptls)))
(vla-put-startpoint (vlax-ename->vla-object ent)
                    (vlax-3d-point(cadr ptls)))
          )(vl-cmdf ".erase" ent1 ""))))
    (vl-cmdf ".fillet" sel sel1)  
    )(setvar "filletrad" fltrad)(princ)
  )
[/program]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2004-3-29 19:34:44 | 显示全部楼层
跟fillet有什么不同的?是升华版吗?r14好像不能用
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2004-3-29 21:38:32 | 显示全部楼层

                               
登录/注册后可看大图
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-3-29 22:54:06 | 显示全部楼层
右下角的图应该在第一个交点处fillet
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2004-3-29 23:16:12 | 显示全部楼层
有点错误,谢谢,改了:)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-3-30 08:25:45 | 显示全部楼层
我私自认为,楼主的程序用处不是很大,如果两线段平行,如何处理。
我也做过一段类似的程序,可以探讨一下。
http://www.xdcad.net/forum/showt ... d=434934#post434934
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-3-30 08:32:37 | 显示全部楼层
我有個小小的建議, 如樓主的程序可以焊接spline就可以滿足小俠的需要. 我下載試試. 呵呵. 先行謝謝了.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2004-3-30 08:50:50 | 显示全部楼层
最初由 lijiao 发布
[B]我私自认为,楼主的程序用处不是很大,如果两线段平行,如何处理。
我也做过一段类似的程序,可以探讨一下。
http://www.xdcad.net/forum/showt ... d=434934#post434934 [/B]

如果用过天正、理正的话就知道LJ连接断线命令,平行的话相当于将两平行线两边加半园,可以试下,主要修复擦除交点处的墙线等留下的缺口,如果用PEDIT命令将编程PLINE线失去原来线的属性,当然也可以自己删除一条再延伸令一条,但当断线两边都很长时候较麻烦些
看了你的程序,你写的是用于三维--》二维后的碎线,两者的用途不太一样

程序原理是:两线在一条直线上时修复断线,除此相当于0半径倒角
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2004-3-30 08:54:57 | 显示全部楼层
最初由 JOSDENNIS 发布
[B]我有個小小的建議, 如樓主的程序可以焊接spline就可以滿足小俠的需要. 我下載試試. 呵呵. 先行謝謝了. [/B]

样条曲线是不可以延伸和倒角的~~~~~
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-3-31 17:24:52 | 显示全部楼层
好用,帮楼主顶一下!
谢谢!


都白银长老了还不知道这里的规则?警告! ---  by aeo
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 488个

财富等级: 日进斗金

发表于 2004-4-1 00:17:41 | 显示全部楼层
我来贴一个吧。R14下可用.
[program]

(defun c:lj( / a b ent1 ent2 p1 p2 p3 p4 p5 p6 aline dxf rad)
(defun dxf(a b)(cdr(assoc a b)))
(defun aline(p1 p2 p3 p4)                             ;p1 p2 ,p3 p4在一直线上.
   (and(equal(sin(-(angle p1 p2)(angle p3 p4)))0 1e-3) ;平行
    (or(equal p1 p3 1e-3)                              ;p3在p1 上,angle就没了
       (equal(sin(-(angle p1 p3)(angle p1 p2)))0 1e-3) ;不是三角形
   ))
)
(if(and(setq ent1(entsel))  
        (setq a(entget(car ent1)) )
        (or(wcmatch(dxf 0 a)"LINE,ARC,*POLYLINE")(prompt"\n选的实体不能倒角"))
        (not(redraw (car ent1) 3))
        (setq ent2(entsel))
        (setq b(entget(car ent2)))
    )
   (if(and(= (dxf 0 a) "LINE")
          (= (dxf 0 b) "LINE")
          (setq p1(dxf 10 a) p2(dxf 11 a)
                p3(dxf 10 b) p4(dxf 11 b)
                pts(list p1 p2 p3 p4)
          )
          (apply 'aline pts)   
      )
     (progn                            ;是一直线上的line
      (if(equal(car p1)(car p2)1e-4)   ;x==x
        (mapcar '(lambda(x)(if(<(cadr x)(cadr p1))(setq p1 x))
                           (if(>(cadr x)(cadr p2))(setq p2 x)) ) pts)
        (mapcar '(lambda(x)(if(<(car x)(car p1))(setq p1 x))
                           (if(>(car x)(car p2))(setq p2 x)) ) pts  )
      )
      (command"undo""group")
      (entmod(setq a(subst(cons 10 p1)(assoc 10 a)(subst(cons 11 p2)(assoc 11 a)a))))
      (entdel (car ent2))
      (command"undo""end")
     )
     (progn
      (setq rad(getvar "filletrad"))
      (command ".fillet""r""0"".fillet"ent1 ent2)
      (if (/= (getvar "CmdNames") "")(command ^c))
      (setvar "filletrad" rad)
     )
  )
)(princ))
[/program]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-4-1 01:38:42 | 显示全部楼层
还需完善:
11楼:实体第一选中pl线时候无效(先选line可以)。
1楼及11楼:对同心同半径圆弧不能连接为一个。对pl线处理后,pl线只能保留端头的段,其余丢失
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 488个

财富等级: 日进斗金

发表于 2004-4-1 21:11:13 | 显示全部楼层
最初由 陌生人 发布
[B]还需完善:
11楼:实体第一选中pl线时候无效(先选line可以)。
1楼及11楼:对同心同半径圆弧不能连接为一个。对pl线处理后,pl线只能保留端头的段,其余丢失 [/B]


第一个pl线是可以的,你试了没有。
对pl线,就是调用fillet,不可能丢失的。因为我的把entsel的点也放进去了.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-4-2 00:57:11 | 显示全部楼层
最初由 aeo 发布
[B]
... [/B]

我想问的是:你自己试了没有?
如果成功,你的的确没有丢失,1楼的有,不好意思。但第一选中pl线确实不行
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2004-4-2 07:19:59 | 显示全部楼层
加加密吧,调动一下积极性~~
来个可以修复同圆弧的,点击两个端连接,点击本身两次修复弧为圆,最后加上PL线的连接和椭圆的修复正在考虑~~~
游客,如果您要查看本帖隐藏内容请回复
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-28 22:34 , Processed in 0.210648 second(s), 60 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表