(defun c:gg5 ( /ss i e pts ob width pac y x sss)
(SETQ OS (GETVAR "OSMODE"))
(setvar "cmdecho" 0)
(setq pac (getvar 'peditaccept))
(setvar 'peditaccept 1)
(if (not width) (setq width 1.00))
(setq width (cond ((getdist (strcat "\n 输入偏移宽度 <" (rtos width 2 2) ">: "))) (width)))
(if (setq ss (ssget '((0 . "LWPOLYLINE,LINE"))))
(repeat (setq i (sslength ss))
(setq e (ssname ss (Setq i (1- i))) sss (ssadd))
(setq pts (mapcar '(lambda (y) (list (vlax-curve-getStartPoint y) (vlax-curve-getEndPoint y)))
(mapcar 'car (mapcar '(lambda (x)
(setq ob (vlax-invoke (vlax-ename->vla-object e) 'Offset x))
(ssadd (entlast) sss) ob ) (list (setq h (* 0.5 width)) (- h))))))
(mapcar '(lambda (k l) (entmakex (list (cons 0 "LINE") (cons 10 k) (cons 11 l)))
(ssadd (entlast) sss))
(car pts)(cadr pts))
(command "_.pedit" "m" sss """j" 0.0 "")
(entdel e)))
(setvar 'peditaccept pac)
(SETVAR "OSMODE" OS )
(princ)
) 没币的帮你们坐下好事，你们要感谢就感谢14#的吧
太有用了，感谢楼上的各位大佬！！！
试了下，可用！
流动的清泉 发表于 2020-11-7 15:46
(defun c:gg5 ( /ss i e pts ob width pac y x sss)
(SETQ OS (GETVAR "OSMODE"))
(se ...
真不赖，好用
xmq1103 发表于 2020-8-10 22:41
这个行不行呀
有点小问题，望大师稍微调整下，原程序执行一次就只能选一根线偏移，不按取消键一直可以循环选线偏移就好，
GDFGFGF 发表于 2021-12-15 17:15
有点小问题，望大师稍微调整下，原程序执行一次就只能选一根线偏移，不按取消键一直可以循环选线偏移就好 ...
试试，好用就给评分加个币 :lol
(defun c:GG( /ss i e pts ob width pac y x sss)
(SETQ OS (GETVAR "OSMODE"))
(setvar "cmdecho" 0)
(setq pac (getvar 'peditaccept))
(setvar 'peditaccept 1)
(if (not width) (setq width 1.00))
(setq width (cond ((getdist (strcat "\n 输入偏移宽度 <" (rtos width 2 2) ">: "))) (width)))
(while
(if (setq ss (ssget ":s" '((0 . "LWPOLYLINE,LINE"))))
(repeat (setq i (sslength ss))
(setq e (ssname ss (Setq i (1- i))) sss (ssadd))
(setq pts (mapcar '(lambda (y) (list (vlax-curve-getStartPoint y) (vlax-curve-getEndPoint y)))
(mapcar 'car (mapcar '(lambda (x)
(setq ob (vlax-invoke (vlax-ename->vla-object e) 'Offset x))
(ssadd (entlast) sss) ob ) (list (setq h (* 0.5 width)) (- h))))))
(mapcar '(lambda (k l) (entmakex (list (cons 0 "LINE") (cons 10 k) (cons 11 l)))
(ssadd (entlast) sss))
(car pts)(cadr pts))
(command "_.pedit" "m" sss """j" 0.0 "")
(entdel e)
)
)
)
(setvar 'peditaccept pac)
(SETVAR "OSMODE" OS )
(princ)
)
xmq1103 发表于 2021-12-17 10:07
试试，好用就给评分加个币
(defun c:GG( /ss i e pts ob width pac y x sss)
(SETQ OS (GE ...
大师我说的是这段程序。有点小问题，望大师稍微调整下，原程序执行一次就只能选一根线偏移，不按取消键一直可以循环选线偏移就好。调好一定给大师评分加币
(defun c:nm( / en en1 pt p1 p2 p3 p4 dist)
(vl-load-com)
(setq dist (getdist (strcat "\n输入偏移距离:<" (rtos (getvar "OFFSETDIST")) ">")))
(if (null dist)
(setq dist (getvar "offsetdist"))
(setvar "offsetdist" dist))
;;;(while ;;加循环
(setq en (car(entsel "\n请选择线:")))
(setq p1(vlax-curve-getstartpoint en)
p2(vlax-curve-getendpoint en) )
(setvar "cmdecho" 1)
(command "offset" dist enpause "")
(setvar "cmdecho" 0)
(setq en1 (entlast))
(setq p3(vlax-curve-getstartpoint en1)
p4(vlax-curve-getendpoint en1))
(vl-cmdf "line" p1 p3 "")(setq en2 (entlast))
(vl-cmdf "line" p2 p4 "")(setq en3 (entlast))
(command "_.SELECT" en en2 en3 "")
(setq S3 (ssget "P"))
(command "pedit" en1 "j" S3 "" "");;以偏移后的对象所在层连接所有线
(princ)
)
GDFGFGF 发表于 2021-12-17 13:33
大师我说的是这段程序。有点小问题，望大师稍微调整下，原程序执行一次就只能选一根线偏移，不按取消键一 ...
(defun c:nm( / en en1 pt p1 p2 p3 p4 dist)
(vl-load-com)
(setq dist (getdist (strcat "\n输入偏移距离:<" (rtos (getvar "OFFSETDIST")) ">")))
(if (null dist)
(setq dist (getvar "offsetdist"))
(setvar "offsetdist" dist))
(while ;;加循环
(setq en (car(entsel "\n请选择线:")))
(setq p1(vlax-curve-getstartpoint en)
p2(vlax-curve-getendpoint en) )
(setvar "cmdecho" 1)
(command "offset" dist enpause "")
(setvar "cmdecho" 0)
(setq en1 (entlast))
(setq p3(vlax-curve-getstartpoint en1)
p4(vlax-curve-getendpoint en1))
(vl-cmdf "line" p1 p3 "")(setq en2 (entlast))
(vl-cmdf "line" p2 p4 "")(setq en3 (entlast))
(command "_.SELECT" en en2 en3 "")
(setq S3 (ssget "P"))
(command "pedit" en1 "j" S3 "" "");;以偏移后的对象所在层连接所有线
)
(princ)
)
GDFGFGF 发表于 2021-12-17 13:33
大师我说的是这段程序。有点小问题，望大师稍微调整下，原程序执行一次就只能选一根线偏移，不按取消键一 ...
一个捣鼓法，把while 加上就行了
建议增加填充功能