多段线批量偏移-支持设定内外偏移（210308更新）
本帖最后由 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 D1D
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)
) 选择对象:
命令:
命令:OTO
选择对象: 找到 1 个
选择对象:
命令:
命令:
命令: (LOAD "C:/Users/admin/Desktop/批量偏移oto.lsp") C:OTO
命令: oto
选择对象: 指定对角点: 找到 2 个
选择对象:
命令: 1028882406@qq.c 发表于 2021-3-5 20:58
版主能否增加个R角保持不变
或者直接增加个开关 圆角偏移保持相同或者不相同 自由切换 本小白一个，但是需要用到楼主的代码。搞不懂的地方：在哪个地方设置缺省值？
(setq X (nth (- (length PTS) 2) PTS))这句老报错，要怎么更改？
我是想设置下面的图形向外偏移
谢谢! C版分享程序!!!!! 感谢版主分享程序 感谢版主分享 命令: TXT
选择对象: 指定对角点: 找到 2 个
选择对象:
褰撳墠璁剧疆: 鍒犻櫎婧?= nil
鎸囧畾鍋忕Щ璺濈鎴?[鍒犻櫎婧?E)] <50>:
命令: 1、为何命令提示行会出现乱马呢？2、能否有选择项，可以自己确定要求是内偏移还是外偏移？ 谢谢版主分享！
谢谢版主分享！有你们这些热心的大佬，论坛才能有活力！！ 请教C版，偏移后的多段线不断开，应该怎么写呢？请版主指点一下吧 非常感谢，学习了