[求助]偏移并清除原对象。
各位热情洋溢的cad高手：你们好！
能否用lisp帮我编一个偏移命令。要求偏移后原对象被清除。而且该lisp能直接贴在acadr14.lsp和acad2000doc.lsp中应用！
学生感激之情将如长江之水滔滔不绝······
程序如内
本帖最后由 mccad 于 2002-8-18 20:56:51 编辑(defun c:OFFDEL(/ oldcmdecho ofdist dist)
(princ " OFFDEL 偏移并删除源对象")
(setq oldcmdecho(getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ofdist(getvar "OFFSETDIST"))
(if (> ofdist 0)
(progn
(initget "T")
(setq dist(getdist (strcat "\n指定偏移距离或 [通过(T)] <" (rtos ofdist) ">:")))
(if (= dist nil)
(setq dist ofdist)
)
(if (or(= dist "T")(= dist "t"))
(offwithpnt)
(offwithdist dist)
)
)
(progn
(initget "T")
(setq dist(getdist "\n指定偏移距离或 [通过(T)] <通过>:"))
(if(= dist nil)
(setq dist "T")
)
(if (or(= dist "T")(= dist "t"))
(offwithpnt)
(offwithdist dist)
)
)
)
(setvar "cmdecho" oldcmdecho)
(princ"\n该命令由明经通道http://www.mjtd.com制作")
(princ)
)
(defun offwithdist( dist / obj pnt)
(while(setq obj(entsel "\n选择要偏移的对象或 <退出>:"))
(setq pnt(getpoint"\n指定点以确定偏移所在一侧:"))
(command "._offset" dist obj pnt "")
(entdel (car obj))
)
(setvar "offsetdist" dist)
(princ)
)
(defun offwithpnt(/ obj pnt)
(while (setq obj(entsel "\n选择要偏移的对象或 <退出>:"))
(setq pnt(getpoint"\n指定通过点:"))
(command "._offset" "T" obj pnt "")
(entdel (car obj))
)
(setvar "offsetdist" -1)
(princ)
)
;程序改了一下，完全仿OFFSET命令的提示。
感谢信···
谢谢版主的创作！我试了试很好用。就是有一点与被仿效的OFFSET命令不一样。原命令在选中无法偏移的对象时有提示，并且命令无法执行下去；OFFDEL命令执行过程中即使选取了无法偏移的对象后，仍然提示“指定点以确定偏移所在一侧”，如果继续执行命令，该对象就被消除了。
是否有改进的可能？
有，程序改好了，如内
(defun c:OFFDEL (/ oldcmdecho ofdist dist)(princ " OFFDEL 偏移并删除源对象")
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ofdist (getvar "OFFSETDIST"))
(if (> ofdist 0)
(progn
(initget "T")
(setq dist (getdist (strcat "\n指定偏移距离或 [通过(T)] <"
(rtos ofdist)
">:"
)
)
)
(if (= dist nil)
(setq dist ofdist)
)
(if (or (= dist "T") (= dist "t"))
(offwithpnt)
(offwithdist dist)
)
)
(progn
(initget "T")
(setq dist (getdist "\n指定偏移距离或 [通过(T)] <通过>:"))
(if (= dist nil)
(setq dist "T")
)
(if (or (= dist "T") (= dist "t"))
(offwithpnt)
(offwithdist dist)
)
)
)
(setvar "cmdecho" oldcmdecho)
(princ "\n该命令由明经通道 http://www.mjtd.com 制作")
(princ)
)
(defun offwithdist (dist / obj pnt)
(while (setq obj
(I:entself
"\n选择要偏移的对象或 <退出>:"
'((0
.
"Arc,Circle,Ellipse,Line,LightweightPolyline,Polyline,Spline,XLine"
)
)
)
)
(setq pnt (getpoint "\n指定点以确定偏移所在一侧:"))
(command "._offset" dist obj pnt "")
(entdel (car obj))
)
(setvar "offsetdist" dist)
(princ)
)
(defun offwithpnt (/ obj pnt)
(while (setq obj
(I:entself
"\n选择要偏移的对象或 <退出>:"
'((0
.
"Arc,Circle,Ellipse,Line,LightweightPolyline,Polyline,Spline,XLine"
)
)
)
)
(setq pnt (getpoint "\n指定通过点:"))
(command "._offset" "T" obj pnt "")
(entdel (car obj))
)
(setvar "offsetdist" -1)
(princ)
)
(defun I:EntSelF (Msg Filter / EntN pbDist PtPick ssPick)
(while (not EntN)
(setq EntN (if Msg
(entsel Msg)
(entsel)
)
)
(if (= (getvar "ErrNo") 52)
(setq EntN "Exit")
)
)
(cond
((/= EntN "Exit")
(setq
pbDist (abs
(/
(*
(/
(getvar "PickBox")
(cadr (getvar "ScreenSize"))
)
(getvar "ViewSize")
)
(sin (* 0.25 pi))
)
)
PtPick (cadr EntN)
)
(if (setq ssPick (ssget "_C"
(polar PtPick (* 1.25 pi) pbDist)
(polar PtPick (* 0.25 pi) pbDist)
Filter
)
)
(cons
(ssname ssPick 0)
(list PtPick)
)
)
)
)
)
经过反复折腾后的建议——再改：）
尊敬的版主： 您好！首先感谢您在百忙中抽出时间无私的为我们编写lisp。经过我（一个对cad认识极肤浅的人）刚才在r14and2002版本中，在对各种对象在各种坐标中反复应用，得出不成熟的一些认识：
1、前一个offdel虽然存在与offset有差异的局部情况，但与后一个offdel编辑相同对象时，显得更为稳定（会不会是后一个offdel增加的功能抑制了它的正常发挥？：）；
2、offset在各种坐标下应用均正常。前后两个offdel在编辑对象与当前坐标的xy平面垂直或者不在xy同一平面上时，效果根本无法令人满意。特别是对circle、闭合pline的编辑；
3、在测试过程中我主要使用前后offdel编辑circle、闭合的pline、spline、arc、line。
4、一番摆弄之余，让我领略到lisp的博大深邃，深感个人的渺小和学习的必要。渴望得到论坛的版主与同仁志士的引导和帮助！
谢谢！
是不是改起来比较麻烦呢？
现在向这么认真的回帖真的已经绝迹了 人是不满足的动物。
页:
[1]