[求助]偏移并清除原对象。

活塞

各位热情洋溢的cad高手：
你们好！
     

     能否用lisp帮我编一个偏移命令。要求偏移后原对象被清除。而且该lisp能直接贴在acadr14.lsp和acad2000doc.lsp中应用！
     学生感激之情将如长江之水滔滔不绝······

mccad

(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命令执行过程中即使选取了无法偏移的对象后，仍然提示“指定点以确定偏移所在一侧”，如果继续执行命令，该对象就被消除了。

活塞

mccad

(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 "ickBox")
                      (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的博大深邃，深感个人的渺小和学习的必要。渴望得到论坛的版主与同仁志士的引导和帮助！
    谢谢！

活塞

yjr111

现在向这么认真的回帖真的已经绝迹了

king3d

人是不满足的动物。