折腾一下午 一个点击封闭区域向内偏移的代码 东拼西凑来的 效果very good
本帖最后由 xj6019 于 2020-9-22 19:59 编辑这半天把我给憋的，各个地方找，各个地方凑呀，里面差不多从四五个地方拼凑来的，总算没白忙活。。效果很理想。。
;;封闭区域内点击向内偏移的函数，封闭区域可以是圆，多段线，零散直线等都可以，必须是闭合区域才行。
;;代码拼凑来的，也可能不一定合理哦，反正多次测试能用了。里面应该还有几句没有用的，反正也不影响，待着去吧。
;;循环好像有点问题，感觉别扭的话就删掉循环。
;;图层跟随当前图层
(defun c:NM()
(vl-load-com)
;错误恢复捕捉
(defun *MYERR* (MSG)
(setvar "CMDECHO" CMD_OLD)
(setvar "OSMODE" OS_OLD)
(setq *ERROR* *OLDERR*)
(if (= MSG "完美退出。谢谢使用。")
(princ (strcat "\\n>>>" MSG))
(princ "\\n>>>虽然中途退出了，对象捕捉已经被恢复。")
)
(princ)
)
(setq *OLDERR* *ERROR*
*ERROR**MYERR*
OS_OLD (getvar "OSMODE")
CMD_OLD(getvar "CMDECHO")
)
(setvar "osmode" 0)
(if (not ssj) (setq ssj (getstring "\n请输入偏移量:")) (setq ssj (if (/= "" (setq ss2k (getstring (strcat "\n请输入偏移量<" ssj ">:")))) ss2k ssj)))
(setq a t)
(while a
(setq pt (getpoint "\n闭合范围里取点(退出ESC)："))
(command "bpoly" pt "")
(setq ssaa (entlast))
(command "select" ssaa"")
(setq ss (ssget "p" '((0 . "LWPOLYLINE,region,circle"))))
(setq len (sslength ss))
(setq n 0)
(repeat len
(setq ent (ssname ss n))
(setq obj (vlax-ename->vla-object ent))
(vla-GetBoundingBox obj 'pta 'ptb)
(command "offset" ssjSS PT "")
(setq n (+ 1 n))
)
(COMMAND "_.erase"ss "");删除生成的边界线！
)
(princ);_关闭程序返回
);_程序结束
本帖最后由 xj6019 于 2020-12-11 10:38 编辑
删掉了不少，现在应该没啥多余的了吧，循环也改了改，行了，感觉也就这么着了吧。。
(defun c:NM()
;错误恢复捕捉
(defun *MYERR* (MSG)
(setvar "CMDECHO" CMD_OLD)
(setvar "OSMODE" OS_OLD)
(setq *ERROR* *OLDERR*)
(if (= MSG "完美退出。谢谢使用。")
(princ (strcat "\\n>>>" MSG))
(princ "\\n>>>虽然中途退出了，对象捕捉已经被恢复。")
)
(princ)
)
(setq *OLDERR* *ERROR*
*ERROR**MYERR*
OS_OLD (getvar "OSMODE")
CMD_OLD(getvar "CMDECHO")
)
(setvar "osmode" 0)
(if (not ssj) (setq ssj (getstring "\n请输入偏移量:")) (setq ssj (if (/= "" (setq ss2k (getstring (strcat "\n请输入偏移量<" ssj ">:")))) ss2k ssj)))
(while
(setq pt (getpoint "\n闭合范围里取点(退出ESC)："))
(command "bpoly" pt "")
(setq ssaa (entlast))
(command "offset" ssj ssaa PT "")
(COMMAND "_.erase" ssaa "") ;删除生成的边界线！
)
(setvar"osmode" OS_OLD)
(princ);_关闭程序返回);_程序结束
)
(while
(setq pt (getpoint "\n闭合范围里取点(退出ESC)："))
(command "bpoly" pt "")
(setq ssaa (entlast))
(command "offset" ssj ssaa PT "")
(COMMAND "_.erase" ssaa "") ;删除生成的边界线！
) 走了不少弯路，但最终还是到达了目的地 start4444 发表于 2020-9-23 00:08
走了不少弯路，但最终还是到达了目的地
弯路也是电脑走，最多也就相当于电脑多算一遍1+1的程度，不碍事的:lol:lol 历害了哇，可以自己拼凑起来，，要是不怎么懂的根本放大面前都接不起来 恭喜！进步很快啊！ xvjiex 发表于 2020-9-23 09:26
(while
(setq pt (getpoint "\n闭合范围里取点(退出ESC)："))
(command "bpoly" pt "")
不错，又可以删掉点代码了，谢谢。 学习了，谢谢分享 结尾加个恢复捕捉