多段线批量偏移-支持设定内外偏移（210308更新）

caoyin · 发表于 2021-3-4 12:33:30

本帖最后由 caoyin 于 2021-3-8 17:01 编辑

;;; 应网友要求-多段线批量内偏移
;;; http://bbs.mjtd.com/forum.php?mo ... %BD%E1%B9%B9&page=1
;;; 要求: 可设置偏移的距离\可设置是否删除源对象\偏移生成的对象图层为当前层\偏移后多段线的每个段为独立对象

;; 多段线批量偏移 - caoyin-210308
;; 根据要求自行设定缺省值
;; $OFFSETTO-DIST$ - 偏移距离 (100)
;; $OFFSETTO-ERASE$ - 删除源 (nil=否 | T=是 )
;; $OFFSETTO-DIR$ - 偏移方向 (nil=内 | T=外 )
;; $OFFSETTO-LAYER$ - 图层 (nil=源 | T=当前层)
;; $OFFSETTO-PLMOD$ - 多段线模式 (nil=连续 | T=独立 )
(defun C:OTO (/ *ERROR* GET-PLINE-VERTEXS|BULGES ADD-2P-PLINE OFFSET-PLINES SS DOC ZIN DST)
(defun *ERROR* (M)
(if ZIN (setvar 'DIMZIN ZIN))
)
(defun GET-PLINE-VERTEXS|BULGES (ENX / P)
(if (and (setq P (assoc 10 ENX))
(setq ENX (member P ENX))
)
(cons (cons (cdr (assoc 42 ENX)) (cdr P))
(GET-PLINE-VERTEXS|BULGES (cdr ENX))
)
)
)
(defun ADD-2P-PLINE (P1 P2 B LAY NOR)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
(cons 8 LAY) '(100 . "AcDbPolyline")
'(90 . 2) '(43 . 20)
(cons 10 (trans P1 0 NOR)) (cons 42 B)
(cons 10 (trans P2 0 NOR)) (cons 210 NOR)
)
)
)
(defun OFFSET-PLINES (SS D DEL DIR LAY MOD / E D1 PTS X V ENX NOR)
(if (setq E (ssname SS 0))
(progn
(setq D1 D
PTS (GET-PLINE-VERTEXS|BULGES (entget E))
)
(if (equal (cdar PTS) (setq X (cdr (last PTS))) 1E-8)
(setq X (nth (- (length PTS) 2) PTS))
)
(setq V (mapcar (function (lambda (A B) (- (/ (+ A B) 2.0) A))) (cdar PTS) X))
(if (> (car (trans V 0 (vlax-curve-getFirstDeriv E 0))) 0)
(setq D (- D))
)
(if DIR (setq D (- D)))
(setq X (vlax-Invoke (vlax-ename->vla-object E) 'offset D))
(if DEL (entdel E))
(if MOD
(foreach O X
(setq ENX (entget (vlax-vla-object->ename O))
NOR (cdr (assoc 210 ENX))
PTS (GET-PLINE-VERTEXS|BULGES ENX)
)
(or LAY (setq LAY (vla-get-layer O)))
(mapcar (function (lambda (P1 P2)
(Add-2P-Pline (cdr P1) (cdr P2) (car P1) LAY NOR)
)
)
PTS (cdr PTS)
)
(vla-delete O)
)
(if LAY (foreach O X (vla-put-layer O LAY)))
)
(OFFSET-PLINES (ssdel E SS) D1 DEL DIR LAY MOD)
)
)
)
(if (setq SS (ssget '((0 . "LWPOLYLINE") (-4 . ">=") (90 . 3))))
(progn
(setq DOC (vla-get-ActiveDocument (vlax-get-acad-object))
ZIN (getvar 'DIMZIN)
)
(vla-EndUndoMark DOC)
(or $OFFSETTO-DIST$
(setq $OFFSETTO-DIST$ 100)
)
(while
(progn
(setvar 'DIMZIN 0)
(princ (strcat "\n当前设置: 删除源="
(if $OFFSETTO-ERASE$ "是" "否")
" 偏移方向="
(if $OFFSETTO-DIR$ "外" "内")
" 图层="
(if $OFFSETTO-LAYER$ "当前层" "源")
" 新对象段="
(if $OFFSETTO-PLMOD$ "独立" "连续")
)
)
(initget 6 "Erase Dir Layer Mode")
(setq DST (getdist (strcat
"\n指定偏移距离或 [删除源(E)/偏移方向(D)/图层(L)/新对象段(M)] <"
(rtos $OFFSETTO-DIST$) ">: "
)
)
)
(cond
((numberp DST)
(not (setq $OFFSETTO-DIST$ DST))
)
((= DST "Erase")
(setq $OFFSETTO-ERASE$ (not $OFFSETTO-ERASE$))
T
)
((= DST "Dir")
(setq $OFFSETTO-DIR$ (not $OFFSETTO-DIR$))
T
)
((= DST "Layer")
(setq $OFFSETTO-LAYER$ (not $OFFSETTO-LAYER$))
T
)
((= DST "Mode")
(setq $OFFSETTO-PLMOD$ (not $OFFSETTO-PLMOD$))
T
)
((not DST)
(not (setq DST $OFFSETTO-DIST$))
)
)
)
)
(OFFSET-PLINES SS DST $OFFSETTO-ERASE$
$OFFSETTO-DIR$
(if $OFFSETTO-LAYER$ (getvar 'CLAYER))
$OFFSETTO-PLMOD$
)
(while (= (logand 8 (getvar 'UNDOCTL)) 8)
(vla-EndUndoMark DOC)
)
(setvar 'DIMZIN ZIN)
)
)
(princ)
)

;; 多段线批量偏移 - caoyin-210308 
;; 根据要求自行设定缺省值 
;; $OFFSETTO-DIST$  - 偏移距离   (100) 
;; $OFFSETTO-ERASE$ - 删除源     (nil=否   |  T=是    ) 
;; $OFFSETTO-DIR$   - 偏移方向   (nil=内   |  T=外    ) 
;; $OFFSETTO-LAYER$ - 图层       (nil=源   |  T=当前层) 
;; $OFFSETTO-PLMOD$ - 多段线模式 (nil=连续 |  T=独立  ) 
 
 
(defun C:OTO (/ *ERROR* GET-PLINE-VERTEXS|BULGES ADD-2P-PLINE OFFSET-PLINES SS DOC ZIN DST) 
  (defun *ERROR* (M) 
    (if ZIN (setvar 'DIMZIN ZIN)) 
  ) 
  (defun GET-PLINE-VERTEXS|BULGES (ENX / P) 
    (if (and (setq P (assoc 10 ENX)) 
             (setq ENX (member P ENX)) 
        ) 
      (cons (cons (cdr (assoc 42 ENX)) (cdr P)) 
            (GET-PLINE-VERTEXS|BULGES (cdr ENX)) 
      ) 
    ) 
  ) 
  (defun ADD-2P-PLINE (P1 P2 B LAY NOR) 
    (entmake (list '(0 . "LWPOLYLINE")        '(100 . "AcDbEntity") 
                   (cons 8 LAY)               '(100 . "AcDbPolyline") 
                   '(90  . 2)                 '(43 . 20) 
                   (cons 10 (trans P1 0 NOR)) (cons 42 B) 
                   (cons 10 (trans P2 0 NOR)) (cons 210 NOR) 
             ) 
    ) 
  ) 
  (defun OFFSET-PLINES (SS D DEL DIR LAY MOD / E D1 PTS X V ENX NOR) 
    (if (setq E (ssname SS 0)) 
      (progn 
        (setq D1  D 
              PTS (GET-PLINE-VERTEXS|BULGES (entget E)) 
        ) 
        (if (equal (cdar PTS) (setq X (cdr (last PTS))) 1E-8) 
          (setq X (nth (- (length PTS) 2) PTS)) 
        ) 
        (setq V (mapcar (function (lambda (A B) (- (/ (+ A B) 2.0) A))) (cdar PTS) X)) 
        (if (> (car (trans V 0 (vlax-curve-getFirstDeriv E 0))) 0) 
          (setq D (- D)) 
        ) 
        (if DIR (setq D (- D))) 
        (setq X (vlax-Invoke (vlax-ename->vla-object E) 'offset D)) 
        (if DEL (entdel E)) 
        (if MOD 
          (foreach O X 
            (setq ENX (entget (vlax-vla-object->ename O)) 
                  NOR (cdr (assoc 210 ENX)) 
                  PTS (GET-PLINE-VERTEXS|BULGES ENX) 
            ) 
            (or LAY (setq LAY (vla-get-layer O))) 
            (mapcar (function (lambda (P1 P2) 
                                (Add-2P-Pline (cdr P1) (cdr P2) (car P1) LAY NOR) 
                              ) 
                    ) 
                    PTS (cdr PTS) 
            ) 
            (vla-delete O) 
          ) 
          (if LAY (foreach O X (vla-put-layer O LAY))) 
        ) 
        (OFFSET-PLINES (ssdel E SS) D1 DEL DIR LAY MOD) 
      ) 
    ) 
  ) 
  (if (setq SS (ssget '((0 . "LWPOLYLINE") (-4 . ">=") (90 . 3)))) 
    (progn 
      (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)) 
            ZIN (getvar 'DIMZIN) 
      ) 
      (vla-EndUndoMark DOC) 
      (or $OFFSETTO-DIST$ 
          (setq $OFFSETTO-DIST$ 100) 
      ) 
      (while 
        (progn 
          (setvar 'DIMZIN 0) 
          (princ (strcat "\n当前设置: 删除源=" 
                        (if $OFFSETTO-ERASE$ "是" "否") 
                        " 偏移方向=" 
                        (if $OFFSETTO-DIR$ "外" "内") 
                        " 图层=" 
                        (if $OFFSETTO-LAYER$ "当前层" "源") 
                        " 新对象段=" 
                        (if $OFFSETTO-PLMOD$ "独立" "连续") 
                 ) 
          ) 
          (initget 6 "Erase Dir Layer Mode") 
          (setq DST (getdist (strcat 
                               "\n指定偏移距离或 [删除源(E)/偏移方向(D)/图层(L)/新对象段(M)] <" 
                               (rtos $OFFSETTO-DIST$) ">: " 
                             ) 
                     ) 
          ) 
          (cond 
            ((numberp DST) 
             (not (setq $OFFSETTO-DIST$ DST)) 
            ) 
            ((= DST "Erase") 
             (setq $OFFSETTO-ERASE$ (not $OFFSETTO-ERASE$)) 
             T 
            ) 
            ((= DST "Dir") 
             (setq $OFFSETTO-DIR$ (not $OFFSETTO-DIR$)) 
             T 
            ) 
            ((= DST "Layer") 
             (setq $OFFSETTO-LAYER$ (not $OFFSETTO-LAYER$)) 
             T 
            ) 
            ((= DST "Mode") 
             (setq $OFFSETTO-PLMOD$ (not $OFFSETTO-PLMOD$)) 
             T 
            ) 
            ((not DST) 
             (not (setq DST $OFFSETTO-DIST$)) 
            ) 
          ) 
        ) 
      ) 
      (OFFSET-PLINES SS DST $OFFSETTO-ERASE$ 
                            $OFFSETTO-DIR$ 
                            (if $OFFSETTO-LAYER$ (getvar 'CLAYER)) 
                            $OFFSETTO-PLMOD$ 
      ) 
      (while (= (logand 8 (getvar 'UNDOCTL)) 8) 
        (vla-EndUndoMark DOC) 
      ) 
      (setvar 'DIMZIN ZIN) 
    ) 
  ) 
  (princ) 
)

注册 · 发表于 2021-3-6 09:35:14

选择对象:
命令:
命令: OTO

选择对象: 找到 1 个

选择对象:
命令:
命令:
命令: (LOAD "C:/Users/admin/Desktop/批量偏移oto.lsp") C:OTO

命令: oto

选择对象: 指定对角点: 找到 2 个

选择对象:
命令:

1028882406@qq.c · 发表于 2021-3-5 23:38:00

1028882406@qq.c 发表于 2021-3-5 20:58
版主能否增加个R角保持不变

或者直接增加个开关圆角偏移保持相同或者不相同自由切换

述学 · 发表于 2023-12-29 23:33:09

本小白一个，但是需要用到楼主的代码。搞不懂的地方：在哪个地方设置缺省值？
(setq X (nth (- (length PTS) 2) PTS))这句老报错，要怎么更改？
我是想设置下面的图形向外偏移

yoyoho · 发表于 2021-3-4 16:26:36

谢谢! C版分享程序!!!!!

Sonnenblumen · 发表于 2021-3-4 18:23:01

感谢版主分享程序

依然小小鸟 · 发表于 2021-3-4 22:31:06

感谢版主分享

注册 · 发表于 2021-3-5 08:04:10

命令: TXT
选择对象: 指定对角点: 找到 2 个

选择对象:
褰撳墠璁剧疆: 鍒犻櫎婧?= nil
鎸囧畾鍋忕Щ璺濈鎴?[鍒犻櫎婧?E)] <50>:

命令:

注册 · 发表于 2021-3-5 08:06:11

1、为何命令提示行会出现乱马呢？2、能否有选择项，可以自己确定要求是内偏移还是外偏移？

panliang9 · 发表于 2021-3-5 08:49:56

谢谢版主分享！

xj6019 · 发表于 2021-3-5 09:08:41

谢谢版主分享！有你们这些热心的大佬，论坛才能有活力！！

Sonnenblumen · 发表于 2021-3-5 10:41:35

请教C版，偏移后的多段线不断开，应该怎么写呢？请版主指点一下吧

Sonnenblumen · 发表于 2021-3-5 13:37:10

非常感谢，学习了

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

[源码] 多段线批量偏移-支持设定内外偏移（210308更新）

评分

点评

点评

本帖子中包含更多资源

点评

点评

点评

点评

点评

点评

点评