直线偏移连动~偏移后修改与其相接触的直线
有时候需要对直线组成的“矩形”某一条边进行修改，可以选择 STRETCH命令，也可以选择offset偏移。但是对于斜向的平行四边形用stretch的时候会改变斜线的角度，（不修改UCS snapang的情况).而用偏移则需要修改偏移后的直线与原直线的关系，使其保持平行四边形关系，为了解决这个问题，所以编写此代码。====================================
========================================
代码
(defun sk_load_com()
;;;组码值提取(sk_dxf 图元名 组码)
(defun sk_dxf(en code)
(if(and(=(type en) 'ENAME)(= (type code) 'INT))
(cdr(assoc code (entget en))))
)
;;;=========================
;;;(sk_entmod 图元名 组码 新值 强制模式)
(defun sk_entmod (en code new mode / e)
(if (and (= (type en) 'ENAME)
(= (type code) 'INT)
new)
(progn
(setq e(entget en))
(if (assoc code e)(entmod(subst(cons code new)(assoc code e)e))
(if mode (entmod(reverse(cons(cons code new)(reverse e)))) nil))
)
)
)
;;;=========================
;;;计算cp到p1 p2的垂足点
(defun PerToLine(cp p1 p2 / norm)
(setq norm (mapcar '- p2 p1)
p1 (trans p1 0 norm)
cp (trans cp 0 norm)
)
(trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
)
;;;=========================
;;;三点共线
(defun ColinearP(p1 p2 p3)
(
(lambda (a b c)
(or
(equal (+ a b) c 1e-8)
(equal (+ b c) a 1e-8)
(equal (+ c a) b 1e-8)
)
)
(distance p1 p2)
(distance p2 p3)
(distance p1 p3)
)
)
;;;=========================
;;高亮图元或选择集
(defun sk_highlight (ss flag / i en)
(if (= (type ss) 'PICKSET)
(progn
(setq i -1)
(repeat(sslength ss)
(setq en(ssname ss (setq i (1+ i))))
(redraw en (if flag 3 4))
)
)
)
(if(= (type ss) 'ENAME)(redraw ss (if flag 3 4)))
)
;;;==========================
(princ)
)
(defun c:oo(/ ANG1 CPT EN ENT0 IP12 MODCODE NEW1 newp1 newp2 NEW2OF_DIST1 P0 P1 P2 P3 P4 SS SS1
ANG2PX1 PX2 PX3 PX4)
(sk_load_com)
(if(setq of_dist1(getdist (strcat "\n输入偏移距离["(if of_dist (rtos of_dist) "0")"]:")))(setq of_dist of_dist1))
(if (setq ss(ssget":E:S" '((0 . "line"))))
(progn
(setq sk_cmd(getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq ent0 (ssname ss 0)
p1 (sk_dxf ent0 10)
p2 (sk_dxf ent0 11)
ang2(angle p1 p2)
px1(polar p1 (+ ang2 (* 0.5 pi)) of_dist)
px2(polar p2 (+ ang2 (* 0.5 pi)) of_dist)
px3(polar p1 (+ ang2 (* 1.5 pi)) of_dist)
px4(polar p2 (+ ang2 (* 1.5 pi)) of_dist)
)
(command "_.zoom" p1 p2)
(setq ss1(ssget "_c" p1 p2 '((0 . "line"))))
(command "_.zoom" "p")
(grdraw px1 px2 6 3)
(grdraw px3 px4 6 3)
(sk_highlight ss1 t)
(if (setq p0(getpoint"\n指定偏移方向:"))
(progn
(sk_highlight ss1 nil)
(setq ss1(ssdel ent0 ss1))
(setq cpt(PerToLine p0 p1 p2 )
ang1(angle cpt p0)
new1(polar p1 ang1 of_dist)
new2(polar p2 ang1 of_dist)
)
(while(setq en(ssname ss1 0))
(setq p3(sk_dxf en 10)
p4(sk_dxf en 11)
modcode nil
)
(if (or (equal p3 p1 1e-8)
(equal p4 p1 1e-8)
(ColinearP p1 p3 p4)
)
(setq newp1(inters new1 new2 p3 p4 nil))
)
(if(or (equal p3 p2 1e-8)
(equal p4 p2 1e-8)
(ColinearP p2 p3 p4))
(setq newp2(inters new1 new2 p3 p4 nil)))
(if (ColinearP p3 p1 p2)(setq modcode 10))
(if (ColinearP p4 p1 p2)(setq modcode 11))
(if modcode
(progn
(setq ip12(inters new1 new2 p3 p4 nil))
(sk_entmod en modcode ip12 nil)))
(setq ss1(ssdel en ss1))
)
(sk_entmod ent0 10 (if newp1 newp1 new1) nil)
(sk_entmod ent0 11 (if newp2 newp2 new2) nil)
)
(progn
(princ "\n未指定方向点!")
(sk_highlight ss1 nil)
)
)
(if sk_cmd (setvar 'cmdecho sk_cmd))
)
)
(redraw)
(princ)
)
(princ)
edata 发表于 2014-5-9 18:09
LWPOLYLINE线单边偏移关联(仅多段线)
非常完美啦能不能再优化成 连续执行 把重复的输入偏移距离给优化掉 受这个程序启发做了自己用的偏移拉伸
超爽
现在才发现
这个帖子当时我居然没有回复和评分?
必须补上 谢谢E大，这个功能不起眼，但是却是非常实用的 大师这个实用。偏移+修剪+延伸。三合一。学习了。 我的CAD2014，没反应啊。
(command "_.zoom" p1 p2)
(setq ss1(ssget "_c" p1 p2 '((0 . "line"))))
(command "_.zoom" "p")点32个赞 哦，习惯多段线了。没看程序啊，用直线就ok了。 这个实用。偏移+修剪+延伸和在一起了，牛哇 对多义线不起作用 楼主高人，以你为榜样！ 太厉害了~~~ LWPOLYLINE线单边偏移关联(仅多段线)
(defun c:tt(/ ANG1 ANG2 CPT ENT ENT1 INDEXMAX INDEXMAX1+ INDEXMAX2 INDEXMIN INDEXMIN1 INDEXMIN1- IPT1 IPT2 IS_CLOSED NEW1 NEW2 OBJP0 P1 P11 P2 P21 PPX PX SK_COORDS VB_NEW1 VB_NEW4 )
;;;组码值提取(sk_dxf 图元名 组码)
(defun sk_dxf(en code)
(if(and(=(type en) 'ENAME)(= (type code) 'INT))
(cdr(assoc code (entget en))))
)
;;;计算cp到p1 p2的垂足点
(defun PerToLine(cp p1 p2 / norm)
(setq norm (mapcar '- p2 p1)
p1 (trans p1 0 norm)
cp (trans cp 0 norm)
)
(trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
)
;;;;;主程序
(if(setq of_dist1(getdist (strcat "\n输入偏移距离["(if of_dist (rtos of_dist) "0")"]:")))(setq of_dist of_dist1))
(if(and (and(setq ent1(entsel "\n选择线:"))(or (= (sk_dxf (car ent1) 0 ) "LWPOLYLINE")(= (sk_dxf (car ent1) 0 ) "LINE")))
(car (list t(redraw (car ent1) 3)))
(setq p0(getpoint "\n指定偏移方向:")))
(if(= (sk_dxf (car ent1) 0 ) "LWPOLYLINE")
(progn
(setq ent(car ent1)
px(cadr ent1)
obj(vlax-ename->vla-object (car ent1)))
(setq is_closed (sk_dxf ent 70)
sk_Coords (sk_dxf ent 90))
(setq ppx(vlax-curve-getClosestPointTo obj px)
indexmin1(fix (vlax-curve-getParamAtPoint obj ppx))
indexmax2(1+ indexmin1)
indexmin(min indexmin1 indexmax2)
indexmax(max indexmin1 indexmax2)
)
(if(and (= indexmin (1- sk_Coords))(= indexmax sk_Coords))
(setq indexmin1- (1- indexmin )
indexmax 0
indexmax1+ 1)
(if (and (= indexmin 0)(/= indexmax (1- sk_Coords)))
(setq indexmin1- (1- sk_Coords)
indexmax1+ (1+ indexmax ))
(if (= indexmax (1- sk_Coords))
(setq indexmax1+0 indexmin1- (1- indexmin))
(setq indexmin1- (1- indexmin)
indexmax1+ (1+ indexmax )))))
(setq p1(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmin)))
p2(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmax)))
p11(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmin1-)))
p21(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmax1+))))
(setq cpt (PerToLine p0 p1 p2)
ang1(angle cpt p0)
ang2(angle p1 p2)
new1(polar p1 ang1 of_dist)
new2(polar p2 ang1 of_dist)
ipt1(inters new1 new2 p1 p11 nil)
ipt2(inters new1 new2 p2 p21 nil)
)
(if(and (= is_closed 0) (= indexmin 0) )
(setq ipt1 new1))
(if(and (= is_closed 0) (= indexmax (1- sk_Coords)) )
(setq ipt2 new2))
(setq vb_new1(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car ipt1)(cadr ipt1)))
vb_new4(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car ipt2)(cadr ipt2))))
(vla-put-Coordinate obj indexminvb_new1)
(vla-put-Coordinate obj indexmaxvb_new4)
)
;;直线偏移部分
)
(princ "\n未选择对象")
)
(if ent1 (redraw (car ent1) 4))
(princ)
)