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

958620832 · 发表于 2013-11-27 16:14:24

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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

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

st788796 · 发表于 2013-11-27 18:15:13

支持一个

st788796 · 发表于 2013-11-27 21:13:59

本帖最后由 st788796 于 2013-11-27 22:18 编辑

API这样写

(defun c:tt (/ d e p typ arc dis e1 index info key ln pcen pts radius)
(defun offsetLine (e p tf / e1 d sp ep)
(setq sp (xdrx_curve_getstartpoint e)
ep (xdrx_curve_getendpoint e)
d (xdrx_point_dist2line p sp ep)
e1 (xdrx_curve_getoffsetcurves
e
(if (minusp d)
(- (getvar "offsetdist"))
(getvar "offsetdist")
)
)
)
(if (minusp (* (xdrx_point_dist2line
(xdrx_curve_getstartpoint (ssname e1 0))
sp
ep
)
d
)
);_判断是否异向
(xdrx_entity_mirror e1 (list sp ep) t)
)
(xdrx_entity_setpropertiesfrom e1 e)
(if tf
(xdrx_entity_delete e)
)
)
(if (setq
d (getdist
(strcat "\n偏移距离<" (rtos (getvar "offsetdist")) ">: ")
)
)
(setvar "offsetdist" d)
(setq d (getvar "offsetdist"))
)
(if (minusp (getvar "offsetdist"))
(progn
(princ "\n默认距离1000!")
(setvar "offsetdist" 1000.)
)
)
(while (and
(setq e (xdrx_entsel "\n拾取Line或Pline线段: " '((0 . "Line,Lwpolyline"))))
(setq p (getpoint "\n偏移方向: "))
)
(progn
(setq typ (xdrx_getpropertyvalue (car e) "IsA"))
(if (= typ "AcDbLine")
(setq e1 (offsetline (car e) p nil))
(progn
(setq key (xdrx_polyline_segtype
(car e)
(setq index
(fix (apply 'xdrx_curve_getparamatpoint e))
)
)
)
(and
(= key "kLine")
(setq pts (xdrx_polyline_getlinesegat (car e) index)
ln (xdrx_line_make pts)
)
(offsetline (ssname ln 0) p t)
)
(and (= key "kArc")
;;( T (42260.6 17638.3 0.0) 5260.35 6.09389 1.66863)
;;逆时针T、顺指针NIL
(setq info (xdrx_polyline_getarcsegat (car e) index)
pcen (cadr info)
radius (caddr info)
dis (distance p pcen)
)
(if (< dis radius)
(setq dis (- radius (getvar "offsetdist")))
(setq dis (+ radius (getvar "offsetdist")))
)
;;(xdrx_arc_make <圆心> <半径> <起始角> <终止角>)
(setq arc (apply 'xdrx_arc_make
(if (car info)
(list pcen
dis
(nth 3 info)
(last info)
)
(list pcen
dis
(last info)
(nth 3 info)
)
)
)
)
(xdrx_entity_setpropertiesfrom arc (car e))
)
)
)
)
)
(princ)
)

(defun c:tt (/ d e p typ arc dis e1 index info key ln pcen pts radius) 
  (defun offsetLine (e p tf / e1 d sp ep) 
    (setq sp (xdrx_curve_getstartpoint e) 
          ep (xdrx_curve_getendpoint e) 
          d  (xdrx_point_dist2line p sp ep) 
          e1 (xdrx_curve_getoffsetcurves 
               e 
               (if (minusp d) 
                 (- (getvar "offsetdist")) 
                 (getvar "offsetdist") 
               ) 
             ) 
    ) 
    (if        (minusp        (* (xdrx_point_dist2line 
                     (xdrx_curve_getstartpoint (ssname e1 0)) 
                     sp 
                     ep 
                   ) 
                   d 
                ) 
        );_判断是否异向 
      (xdrx_entity_mirror e1 (list sp ep) t) 
    ) 
    (xdrx_entity_setpropertiesfrom e1 e) 
    (if        tf 
      (xdrx_entity_delete e) 
    ) 
  ) 
  (if (setq 
        d (getdist 
            (strcat "\n偏移距离<" (rtos (getvar "offsetdist")) ">: ") 
          ) 
      ) 
    (setvar "offsetdist" d) 
    (setq d (getvar "offsetdist")) 
  ) 
  (if (minusp (getvar "offsetdist")) 
    (progn 
      (princ "\n默认距离1000!") 
      (setvar "offsetdist" 1000.) 
    ) 
  ) 
  (while (and 
           (setq e (xdrx_entsel "\n拾取Line或Pline线段: " '((0 . "Line,Lwpolyline")))) 
           (setq p (getpoint "\n偏移方向: ")) 
         ) 
    (progn 
      (setq typ (xdrx_getpropertyvalue (car e) "IsA")) 
      (if (= typ "AcDbLine") 
        (setq e1 (offsetline (car e) p nil)) 
        (progn 
          (setq        key (xdrx_polyline_segtype 
                      (car e) 
                      (setq index 
                             (fix (apply 'xdrx_curve_getparamatpoint e)) 
                      ) 
                    ) 
          ) 
          (and 
            (= key "kLine") 
            (setq pts (xdrx_polyline_getlinesegat (car e) index) 
                  ln  (xdrx_line_make pts) 
            ) 
            (offsetline (ssname ln 0) p t) 
          ) 
          (and (= key "kArc") 
               ;;( T (42260.6 17638.3 0.0) 5260.35 6.09389 1.66863) 
               ;;逆时针T、顺指针NIL 
               (setq info (xdrx_polyline_getarcsegat (car e) index) 
                     pcen (cadr info) 
                     radius (caddr info) 
                     dis  (distance p pcen) 
               ) 
               (if (< dis radius) 
                 (setq dis (- radius (getvar "offsetdist"))) 
                 (setq dis (+ radius (getvar "offsetdist"))) 
               ) 
               ;;(xdrx_arc_make <圆心> <半径> <起始角> <终止角>) 
               (setq arc (apply        'xdrx_arc_make 
                                (if (car info) 
                                  (list        pcen 
                                        dis 
                                        (nth 3 info) 
                                        (last info) 
                                  ) 
                                  (list        pcen 
                                        dis 
                                        (last info) 
                                        (nth 3 info) 
                                  ) 
                                ) 
                         ) 
               ) 
               (xdrx_entity_setpropertiesfrom arc (car e)) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

958620832 · 发表于 2013-11-27 21:48:28

st788796 发表于 2013-11-27 21:13
API这样写

用了好多特殊函数，都不是系统本来就有的，对于一个不怎么熟悉这些特殊函数的读者而言，读起来确实有点费劲。看来，要想看懂你的程序，额外还得学习很多函数啊。
不过，刻苦钻研的这种精神倒挺让人敬佩的。
另外，顺便问一下，API 是什么意思？

st788796 · 发表于 2013-11-27 21:49:59

958620832 发表于 2013-11-27 21:48
用了好多特殊函数，都不是系统本来就有的，对于一个不怎么熟悉这些特殊函数的读者而言，读起来确实有点费 ...

这些都是 ARX 定义的函数，也是 Autodesk 自家东西
多加载一个 ARX 而已

958620832 · 发表于 2013-11-27 21:53:56

st788796 发表于 2013-11-27 21:49
这些都是 ARX 定义的函数，也是 Autodesk 自家东西
多加载一个 ARX 而已

一个什么ARX文件，这些函数，我怎么从没看过？

st788796 · 发表于 2013-11-27 22:00:39

958620832 发表于 2013-11-27 21:53
一个什么ARX文件，这些函数，我怎么从没看过？

在这个论坛混老大 XdRxAPI 都不知道!{:soso_e114:}
http://bbs.xdcad.net/thread-668896-1-1.html

enn09 · 发表于 2014-4-16 10:15:05

感谢分享，好程序，很实用

liuchong1988 · 发表于 2014-4-18 14:12:36

支持一个

bzhjl · 发表于 2014-4-23 17:48:08

感谢7楼附上示例文件！

sunyukun · 发表于 2017-6-19 00:48:22

很早就想要这样的一个功能了

jxwfz19740724 · 发表于 2017-6-19 08:01:37

支持共享，呵呵

lescad2016 · 发表于 2017-9-5 22:46:26

太强大了，谢谢！！！

香远益清 · 发表于 2019-11-17 20:54:33

这个功能对于野外调绘图形房角纠正非常实用，省的做辅助线了，很好，赞一个！

账号		自动登录	找回密码
密码			立即注册

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

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

点评

点评

点评

浏览过的版块