偏移多段线的一段--思路简单明了--资源共享，反对收币！

958620832

(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))

清风明月名字

谢谢楼主的分享！运行效果良好，收藏备用。

tender138

资源共享，反对收币！

yoyoho

感谢 958620832 楼主分享程序!

feng83

不错的源码，辛苦了,新手向楼主学习一下~附件为效果