偏移多段线的一段--思路简单明了--资源共享，反对收币！
本帖最后由 958620832 于 2013-11-27 15:41 编辑(defun getvp (p0 p1 p2 / r12 r0 p3) ;求垂点
(setq r12 (angle p1 p2) r0 (+ r12 (angtof "90")) p3 (polar p0 r0 1.0))
(inters p1 p2 p0 p3 nil))
(defun getep (obj / p1 p p2) ;求端点，obj由(entsel)取得
(setq ename (car obj) p0 (cadr obj))
(setq p1 (osnap p0 "end") p (osnap p0 "mid") p2 (mapcar '(lambda (x y) (- (* 2 x) y)) p p1))
(list p1 p2))
;偏移多义线的一段，也可偏移直线，不用判断。其他类型，由于本人实际工作中用不着，没有考虑，有需要的可以予以改编，思路类似。
(defun c:oo ()
(or dis1_oo (setq dis1_oo 1000))
(princ (strcat "\n指定偏移距离<" (rtos dis1_oo) ">:"))
(setq dis2_oo (getdist))
(if dis2_oo (setq dis1_oo dis2_oo) (setq dis2_oo dis1_oo))
(while (setq obj (entsel "\n选择要偏移的对象:"))
(setq p (getpoint "\n指定点以确定偏移所在一侧:"))
(setq p1 (car (getep obj)) p2 (cadr (getep obj))) ;求端点
(setq p0 (getvp p p1 p2)) ;求垂点
(setq ang (angle p0 p) p3 (polar p1 ang dis2_oo) p4 (polar p2 ang dis2_oo))
(setq ent (entget (car obj)))
(setq ys (if (assoc 62 ent) (cdr (assoc 62 ent)) 256) xx (if (assoc 6 ent) (cdr (assoc 6 ent)) "bylayer")
bl (if (assoc 48 ent) (cdr (assoc 48 ent)) 1) kd (if (assoc 40 ent) (cdr (assoc 40 ent))) ty (cdr (assoc 0 ent)))
(if (= ty "LINE")
(entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4) (cons 62 ys) (cons 6 xx) (cons 48 bl)))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
(cons 90 2) (cons 10 p3) (cons 10 p4) (cons 62 ys) (cons 6 xx) (cons 48 bl) (cons 43 kd)))))
(princ))
谢谢楼主的分享！运行效果良好，收藏备用。 资源共享，反对收币！ 感谢 958620832 楼主分享程序! 不错的源码，辛苦了,新手向楼主学习一下~附件为效果
页:
[1]