单边偏移求助
源码出自：http://bbs.mjtd.com/thread-90498-1-1.html希望高手解决一下能够实现每次只偏移多边形的一条边或弧线，偏移以后同源对象延长线或倒角闭合任然形成多段线，偏移后将源对象删除，只保留偏移后对象。
哈哈 这个有难度前来围观高手猎奇 http://bbs.mjtd.com/thread-110058-1-1.html
;;;LWPOLYLINE线单边移动函数
;;;by edata @mjtd
;;;2014-5-13
(defun sk_offset_single(/ ANG1 ANG2 CPT ENT ENT1 INDEXMAX INDEXMAX1+ INDEXMAX2 INDEXMIN INDEXMIN1 INDEXMIN1- IPT1 IPT1_A IPT1_B
IPT2 IPT2_A IPT2_B IS_CLOSED NEW1 NEW2 NEW3 NEW4 OBJOF_DIST1 P0 P1 P11 P11BULGE P11MIN- P2 P21
P21BULGE P21MAX+ PPX PX SK_COORDS VB_NEW1 VB_NEW2 VB_NEW3 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)
)
(defun *error*_New (msg)
(and *error*_Old(setq *error* *error*_Old))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(if (= (getvar "LOCALE") "CHS")
(princ "\n用户按了<Esc>强制退出")
(princ "\nYou cancelled The operation!")
)
(princ (strcat "\n" msg))
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setvar "cmdecho" 0)
(command "undo" "e")
(setvar "cmdecho" 1)
(princ)
)
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq *error*_Old *error*) ;保存出错处理函数
(setq *error* *error*_New)
;;;;;主程序
(vl-load-com)
(if(setq of_dist1(getdist (strcat "\n输入偏移距离["(if of_dist (rtos of_dist) "0")"]:")))(setq of_dist of_dist1))
(while(and of_dist (/= of_dist 0)
(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+)))
p11bulge(vla-getbulge obj indexmin1-)
p21bulge(vla-getbulge obj indexmax))
(if(not(equal p21bulge 0.0 1e-8))(setq p21max+(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj (1+ indexmax1+))))))
(if(not(equal p11bulge 0.0 1e-8))
(progn
(setq p11min-(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj (if (zerop indexmin1-) (1- sk_Coords)(1- indexmin1-))))))
)
)
(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))
(if p11min- (setq ipt1_a(inters p1 p2 p11 p11min- nil)
ipt1_b(inters new1 new2 p11 p11min- nil)
ipt1(polar ipt1_b (angle p1 p2)(distance ipt1_a p1))
new3(polar ipt1_b (angle p11 p11min-)(distance ipt1_a p11))
vb_new3(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car new3)(cadr new3)))))
(if p21max+ (setq ipt2_a(inters p1 p2 p21 p21max+ nil)
ipt2_b(inters new1 new2 p21 p21max+ nil)
ipt2(polar ipt2_b (angle p2 p1)(distance ipt2_a p2))
new4(polar ipt2_b (angle p21 p21max+)(distance ipt2_a p21))
vb_new4(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car new4)(cadr new4)))))
(setq vb_new1(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car ipt1)(cadr ipt1)))
vb_new2(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car ipt2)(cadr ipt2)))
)
(if vb_new3 (progn
(vla-put-Coordinate obj indexmin1- vb_new3)
(vla-put-Coordinate obj indexminvb_new1))
(vla-put-Coordinate obj indexminvb_new1)
)
(if vb_new4 (progn
(vla-put-Coordinate obj indexmax1+ vb_new4)
(vla-put-Coordinate obj indexmaxvb_new2))
(vla-put-Coordinate obj indexmaxvb_new2)
)
(progn
(setq p11min- nil
p21max+ nil
vb_new1 nil
vb_new2 nil
vb_new3 nil
vb_new4 nil
))
(vla-update obj)
)
)
)
(if ent1 (redraw (car ent1) 4))
(and *error*_Old(setq *error* *error*_Old))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)
(defun c:tt nil
(sk_offset_single)
(princ)
)
(prompt "轻多段线(LWPOLYLINE)单边边偏移命令 TT")
(princ)
xtjd 发表于 2022-11-15 13:16
http://bbs.mjtd.com/thread-110058-1-1.html
;;;LWPOLYLINE线单边移动函数
;;;by edata @mjtd
非常棒:handshake，能不能再给看看偏移闭合多段线起点和终点位置的时候不闭合，能给解决一下吗，大神。 谢谢大佬的分享！！！！ xtjd 发表于 2022-11-15 13:16
http://bbs.mjtd.com/thread-110058-1-1.html
;;;LWPOLYLINE线单边移动函数
;;;by edata @mjtd
大师，在用户坐标系下使用会出错呢
页:
[1]