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

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

本帖最后由 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)
)

;;说明:直线批量周向偏移 作者：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

谢谢楼主的分享。

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

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

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

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

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

小青春牛叉！点个赞

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

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

这评论受之有愧啊

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

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

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

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

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

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

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

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

CAD2007

命令: _appload 已成功加载试试.LSP。
命令: 错误 : 输入的字符串有缺陷
命令:

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

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