一个连接断线的LSP，是点选的，求高手改成框选
连接断线，是点选的，求高手改成框选;****************************************************连接断线程序
(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)
)
上面的程序仅支持连接直线段
貌似楼主的那个程式我用下面这一行就够了。
(defun C:C0() (command ".chamfer" "d" "0" "0" ".chamfer")) 你这个自己试过吗，我试了没有用 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;批量连线（相连的线成一条）
(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)) ;;;;;框选共线直线并批量连接: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)
) 能用,谢谢了 669423907的程序非常好 谢谢 分享 谢谢 分享