一个连接断线的LSP，是点选的，求高手改成框选

xxdxx001

连接断线，是点选的，求高手改成框选
;****************************************************连接断线程序
(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)
  )

ucuc2003

上面的程序仅支持连接直线段

sicky111

貌似楼主的那个程式我用下面这一行就够了。
(defun C:C0() (command ".chamfer" "d" "0" "0" ".chamfer"))

xxdxx001

你这个自己试过吗，我试了没有用

669423907

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;批量连线（相连的线成一条）
(defun c:jj()
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "peditaccept" 1) ;加入这个系统变量的代码
(if (setq KX (ssget '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE"))))
(command "_pedit" "m" KX "" "j" "0.1" ""))
(setvar "cmdecho" cm)
(princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;直线line → 多段线xline（多选）（idljb）
;(defun c:(/ ss alts pt gr s1 lt newscale)
;(setq ss (ssget '((8 . "~3中心线")))
;alts (getvar "LTSCALE") pt (getpoint "\n请指定一个点: "))
;(while (= (car (setq gr (grread nil 5 0))) 5)
;(redraw)(grdraw (cadr gr) pt 1 1)(setq i -1)
;(while (setq s1 (ssname ss (setq i (1+ i))))
;(if (setq lt (cdr (assoc 6 (entget s1))))(progn
;(setq zq (cdr (assoc 40 (tblsearch "ltype" lt))))
;(if (/= zq 0)
;(setq newscale (/ (distance (cadr gr) pt) zq alts 1.))
;(setq newscale 1)))
;(progn (setq zq (cdr (assoc 40 (tblsearch "ltype"
;(cdr (assoc 6
;(tblsearch "layer" (cdr (assoc 8 (entget s1))))))))))
;(if (/= zq 0)(setq newscale (/ (distance (cadr gr) pt) zq alts 1.))
;(setq newscale 1))))
;(vla-put-LinetypeScale (vlax-ename->vla-object s1) newscale)))
;(redraw)
;(command "pedit" "m" ss "" "j" "0.1" "" "")
;(princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;连线pedit（yoyoho 2011-1-15 21:55:35）
;(defun c:(/ kst sset i pp d1 yn f1)
;(setvar "cmdecho" 0)
;(princ "\n请选择要连接的直线,多义线,圆弧:")
;(setq sset (ssget '((-4 . "<OR") (0 . "LWPOLYLINE")(0 . "LINE")(0 . "ARC") (-4 . "OR>"))) i 1 entt (ssname sset 0))
;(while (< i (sslength sset))(if (entget (setq ent (ssname sset i)))
;(if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (vl-cmdf "_PEDIT" entt "J" ent "" "") (vl-cmdf "_PEDIT" entt "J" sset "" "")))
;(setq i (1+ i)))
;(princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;(defun fsxm-silenceexit (/ *error*) ;无声退出 ;by fsxm
;(t (setq *error* strcat)))
;(defun c:(/ ss *error*)         ;连接多义线
;(defun *error* (msg) (princ))
;(princ "\n连接多义线")
;(setq ss (ssget '((8 . "~3中心线")(8 . "~0")(-4 . "<or")
;(-4 . "<AND") (0 . "LWPOLYLINE") (70 . 0) (-4 . "AND>")
;(0 . "LINE")
;(0 . "ARC")
;(-4 . "or>"))))
;(or ss (fsxm-silenceexit))
;(setvar "cmdecho" 0)
;(setvar "PEDITACCEPT" 1)
;(if (= (sslength ss) 1)
;(vl-cmdf "PEDIT" (ssname ss 0) "j" "all" "" "")
;(command "PEDIT" "m" "P" "" "j" "0.1" "" ""))
;(setvar "PEDITACCEPT" 0)
;(princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;(defun c:(/ ss *error*)         ;连接多义线
;(defun *error* (msg) (princ))
;(princ "\n连接多义线")
;(setq ss (ssget '((8 . "~3中心线")(-4 . "<or")
;(-4 . "<AND") (0 . "LWPOLYLINE") (70 . 0) (-4 . "AND>")
;(0 . "LINE")
;(0 . "ARC")
;(-4 . "or>"))))
;(or ss (fsxm-silenceexit))
;(setvar "cmdecho" 0)
;(setvar "PEDITACCEPT" 1)
;(if (= (sslength ss) 1)
;(vl-cmdf "PEDIT" (ssname ss 0) "j" "all" "" "")
;(command "PEDIT" "m" "P" "" "j" "0.1" "" ""))
;(setvar "PEDITACCEPT" 0)
;(princ))

ucuc2003

;;;;;框选共线直线并批量连接:mjj
;返回共线四点最远2点
(defun maxlong (p1 p2 p3 p4)
  (setq ptlst '(p1 p2 p3 p4))
  (setq n '())
  (setq i -1)
  (while (setq a (nth (setq i (1+ i)) ptlst)) ;返回表的第N个元素
    (setq b (cdr (member a ptlst)))        ;返回a后面的剩余元素,包括a,并去掉a的表
    (setq n (append (mapcar '(lambda (x) (list a x)) b) n))
  )
  (setq
    a1 (mapcar '(lambda        (x)
                  (list        (distance (vl-symbol-value (car x))
                                  (vl-symbol-value (cadr x))
                        )
                        x
                  )
                )
               (reverse n)
       )
  )
  (setq a2 (vl-sort a1 '(lambda (x y) (> (car x) (car y)))))
  (setq a3 (car a2))
  (setq a4 (cadr a3))
)
;检测3点是否共线
(defun pppl (pp1 pp2 pp3)
  (setq dis1 (distance pp1 pp2))
  (setq dis2 (distance pp2 pp3))
  (setq dis3 (distance pp1 pp3))
  (if (or (<= (abs (- dis1 (+ dis2 dis3))) 0.000001)
          (<= (abs(- dis2 (+ dis1 dis3))) 0.000001)
          (<= (abs(- dis3 (+ dis2 dis1))) 0.000001)

      )
    1
    nil
  )

)

;框选共线直线并批量连接
(defun C:mjj (/ ss flag n1 n2 ln1 pn1 p1 p2 la ln2 pn2 p3 p4 pp px1 px2 lk la)
  (command "._UNDO" "_BEGIN")
  (princ "\n框选共线直线并批量连接,请选择对象:")
  (setq ss (ssget '((0 . "LINE"))))
                                        ;(setq sn (sslength ss))
  (setq flag 0)                                ;选择集变动标志
  (setq n1 0)
  (while (< n1 (sslength ss))                ;读取选择集图元数量
    (setq n2 (+ n1 1))
    (while (< n2 (sslength ss))
      (setq ln1 (ssname ss n1))                ;把选择集第一个图元名赋给变量ln
      (setq pn1 (entget ln1))                ;获取图原名的定义数据
      (setq p1 (cdr (assoc 10 pn1)))        ;直线起点
      (setq p2 (cdr (assoc 11 pn1)))        ;直线终点
      (setq la (assoc 8 pn1))           ;直线所在图层
      (setq ln2 (ssname ss n2))
      (setq pn2 (entget ln2))
      (setq p3 (cdr (assoc 10 pn2)))        ;直线起点
      (setq p4 (cdr (assoc 11 pn2)))        ;直线终点
      (if (and (pppl p1 p2 p3) (pppl p1 p2 p4))
                                        ;判断4点共线
        (progn
          (setq pp (maxlong p1 p2 p3 p4)) ;返回共线4点中距离最远的2点
          (setq        px1 (vl-symbol-value (car pp)) ;第1点
                px2 (vl-symbol-value (cadr pp)) ;第2点
          )
          (setq
            lk (entmakex
                 (list '(0 . "LINE") (cons 10 px1) la (cons 11 px2))
               )
          )                                ;生成1到2的直线
          (entdel ln1)                        ;删除共线直线lm
          (entdel ln2)                        ;删除共线直线ln
          (ssdel ln1 ss)                ;删除选择集中共线图元lm
          (ssdel ln2 ss)                ;删除选择集中共线图元ln
          (ssadd lk ss)                        ;增加新生成直线到选择集末尾
          (setq flag 1)
        )
      )
      (if (= flag 1)
        (progn
          (setq n2 (+ n1 1))
          (setq flag 0)
        )
        (setq n2 (+ n2 1))
      )
    )
    (setq n1 (+ n1 1))
  )
  (command "._UNDO" "_END")
  (princ)
)

xxdxx001

能用,谢谢了

李青松

669423907的程序非常好

yiqisese

谢谢 分享

ymcui

谢谢 分享