[LISP程序]：【－－连接断线程序－－】

snsj

[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]

conn

跟fillet有什么不同的？是升华版吗？r14好像不能用

snsj

                               
登录/注册后可看大图

陌生人

右下角的图应该在第一个交点处fillet

snsj

有点错误，谢谢，改了：）

lijiao

我私自认为，楼主的程序用处不是很大，如果两线段平行，如何处理。
我也做过一段类似的程序，可以探讨一下。
http://www.xdcad.net/forum/showt ... d=434934#post434934

JOSDENNIS

我有個小小的建議, 如樓主的程序可以焊接spline就可以滿足小俠的需要. 我下載試試. 呵呵. 先行謝謝了.

snsj

最初由 lijiao 发布
[B]我私自认为，楼主的程序用处不是很大，如果两线段平行，如何处理。
我也做过一段类似的程序，可以探讨一下。
http://www.xdcad.net/forum/showt ... d=434934#post434934 [/B]

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

程序原理是:两线在一条直线上时修复断线，除此相当于0半径倒角

snsj

最初由 JOSDENNIS 发布
[B]我有個小小的建議, 如樓主的程序可以焊接spline就可以滿足小俠的需要. 我下載試試. 呵呵. 先行謝謝了. [/B]

样条曲线是不可以延伸和倒角的～～～～～

andyhua5240

好用,帮楼主顶一下!
谢谢!


都白银长老了还不知道这里的规则?警告! ---  by aeo

aeo

我来贴一个吧。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]

陌生人

还需完善：
11楼：实体第一选中pl线时候无效（先选line可以）。
1楼及11楼：对同心同半径圆弧不能连接为一个。对pl线处理后，pl线只能保留端头的段，其余丢失

aeo

最初由 陌生人 发布
[B]还需完善：
11楼：实体第一选中pl线时候无效（先选line可以）。
1楼及11楼：对同心同半径圆弧不能连接为一个。对pl线处理后，pl线只能保留端头的段，其余丢失 [/B]

第一个pl线是可以的，你试了没有。
对pl线，就是调用fillet,不可能丢失的。因为我的把entsel的点也放进去了.

陌生人

最初由 aeo 发布
[B]
... [/B]

我想问的是：你自己试了没有？
如果成功，你的的确没有丢失，1楼的有，不好意思。但第一选中pl线确实不行

snsj

加加密吧，调动一下积极性～～
来个可以修复同圆弧的，点击两个端连接，点击本身两次修复弧为圆,最后加上PL线的连接和椭圆的修复正在考虑~~~

游客，如果您要查看本帖隐藏内容请回复