折腾一下午 一个点击封闭区域向内偏移的代码 东拼西凑来的 效果very good

xj6019

这半天把我给憋的，各个地方找，各个地方凑呀，里面差不多从四五个地方拼凑来的，总算没白忙活。。效果很理想。。
;;封闭区域内点击向内偏移的函数，封闭区域可以是圆，多段线，零散直线等都可以，必须是闭合区域才行。
;;代码拼凑来的，也可能不一定合理哦，反正多次测试能用了。里面应该还有几句没有用的，反正也不影响，待着去吧。
;;循环好像有点问题，感觉别扭的话就删掉循环。
;;图层跟随当前图层
(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" ssj  SS PT "")
(setq n (+ 1 n))
)
(COMMAND "_.erase"  ss "");删除生成的边界线！
)
(princ);_关闭程序返回
);_程序结束

xj6019

删掉了不少，现在应该没啥多余的了吧，循环也改了改，行了，感觉也就这么着了吧。。




(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);_关闭程序返回);_程序结束
)

xvjiex

(while
  (setq pt (getpoint "\n闭合范围里取点(退出ESC)："))
   (command "bpoly" pt "")
   (setq ssaa (entlast))
   (command "offset" ssj ssaa PT "")
   (COMMAND "_.erase" ssaa "")                ;删除生成的边界线！
)

start4444

走了不少弯路，但最终还是到达了目的地

xj6019

start4444 发表于 2020-9-23 00:08
走了不少弯路，但最终还是到达了目的地

弯路也是电脑走，最多也就相当于电脑多算一遍1+1的程度，不碍事的

999999

历害了哇，可以自己拼凑起来，，要是不怎么懂的根本放大面前都接不起来

xvjiex

恭喜！进步很快啊！

xj6019

xvjiex 发表于 2020-9-23 09:26
(while
  (setq pt (getpoint "\n闭合范围里取点(退出ESC)："))
   (command "bpoly" pt "")

不错，又可以删掉点代码了，谢谢。

xzklk

学习了，谢谢分享

hhh454

结尾加个恢复捕捉