fangmin723 发表于 2019-11-18 08:48:17

【基础源码】单条直线批量周偏（周向偏移） 2019.11.18

本帖最后由 fangmin723 于 2019-11-18 08:57 编辑

;;说明:直线批量周向偏移 作者：fangmin723-2019.11.18
(defun c:AO(/ dis dist edata ent lst n pte pts ss)
(if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (setq dis (getreal "\n请输入周边距离<150>：") n 0)
      (if (or (= dis nil) (= dis "") (< dis 0)) (setq dis 150))
      (while (and (setq ent (ssname ss n)) (> dis 0))
      (setq
          pts (cdr (assoc 10 (setq edata (entget ent))))
          pte (cdr (assoc 11 edata))
          dist (/ dis (sin (* pi 0.25)))
          lst (list
                (polar pts (- (angle pte pts) (* pi 0.25)) dist)
                (polar pts (+ (angle pte pts) (* pi 0.25)) dist)
                (polar pte (- (angle pts pte) (* pi 0.25)) dist)
                (polar pte (+ (angle pts pte) (* pi 0.25)) dist)
            )
      )
      (entmake
          (append
            (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) (cons 70 1))
            (mapcar '(lambda (pt) (cons 10 pt)) lst)
          )
      )
      (setq n (1+ n))
      )
    )
)
(princ)
)

sdbaijiao 发表于 2019-11-18 09:29:49

谢谢楼主的分享。

yoyoho 发表于 2019-11-19 06:54:05

谢谢! 楼主的分享!!!!!!!

maiko 发表于 2019-11-19 09:54:11

谢谢! fangmin723的分享!!!!!!!

zixuan203344 发表于 2019-11-19 18:29:43

小青春牛叉！点个赞

fangmin723 发表于 2019-11-20 07:52:30

zixuan203344 发表于 2019-11-19 18:29
小青春牛叉！点个赞

这评论受之有愧啊

296715530 发表于 2019-12-11 22:39:14

两头增加圆角处理就更完美了

fangmin723 发表于 2019-12-12 07:54:34

296715530 发表于 2019-12-11 22:39
两头增加圆角处理就更完美了

基础源码啊，需要的话可以根据自己的需求进行调整修改

zmzk 发表于 2022-2-6 21:16:16

写的好，但是我工作中 貌似用不到

水洗可口可乐 发表于 2023-6-12 19:54:12

CAD2007

命令: _appload 已成功加载 试试.LSP。
命令: 错误 : 输入的字符串有缺陷
命令:
页: [1]
查看完整版本: 【基础源码】单条直线批量周偏（周向偏移） 2019.11.18