[编程交流] 偏移和删除源

(defun c:off (/ e off p)
 ;; Get saved offset from registry or default to 1
 (setq        off (atof (cond        ((getenv "MyOffsetProgram"))
                ("1")
          )
    )
 )
 (if (and ;; Prompt for distance, if nil use default
   (setq off (cond ((getdist (strcat "\nOffset distance <" (vl-princ-to-string off) ">: ")))
                   (off)
             )
   )
   ;; Pick something to offset .. needs more error checking ( ie a block will bonk it )
   (setq e (entsel (strcat "\nPick object to offset: ")))
   ;; Pick a side to offset or use point in entsel
   (setq p (cond ((getpoint "\nSide to offset on: "))
                 ((cadr e))
           )
   )
     )
   (progn ;; Offset object
   (command "_.offset" off (car e) p "")
   ;; Delete original (entdel won't **** the bed if the object is locked)
   (entdel (car e))
          ;; Write our default offset to registry
   (setenv "MyOffsetProgram" (vl-princ-to-string off))
   )
 )
 ;; SSHHHHH!!
 (princ)
)
(vl-load-com)

(defun c:ODEL nil (c:OFFSET_DELETE))
(defun c:OFFSET_DELETE ( / )

(defun c:OFFSET_DELETE ( offset_dist / offset_dist obj_2_offset offset_side )

(progn ;; Offset object           
(command "_.offset" off )
(while (/= 0 (getvar 'cmdactive))
        (command (car e) p pause)
        (entdel (car e))
        ;; Pick something to offset .. needs more error checking ( ie a block will bonk it )
        (setq e (entsel (strcat "\nPick object to offset: ")))
        ;; Pick a side to offset or use point in entsel
        (setq p (cond ((getpoint "\nSide to offset on: "))
                 ((cadr e))
           )
        )
        (setenv "MyOffsetProgram" (vl-princ-to-string off))
)
)

(defun c:ODEL nil (c:OFFSET_DELETE))
(defun c:OFFSET_DELETE (/ e off p)
;; Get saved offset from registry or default to 1
(setq off (atof (cond ((getenv "MyOffsetProgram"))
("1")
)
)
)
(while
(if (and ;; Prompt for distance, if nil use default
(setq off (cond ((getdist (strcat "\nOffset distance <" (vl-princ-to-string off) ">: ")))
        (off)
        )
)
        ;; Pick something to offset .. needs more error checking ( ie a block will bonk it )
        (setq e (entsel (strcat "\nPick object to offset: ")))
        ;; Pick a side to offset or use point in entsel
        (setq p (cond ((getpoint "\nSide to offset on: "))
                ((cadr e))
                )
        )
        )
(progn ;; Offset object
        (while (command "_.offset" off (car e) p ""))
        ;; Delete original (entdel won't **** the bed if the object is locked)
        (entdel (car e))
                ;; Write our default offset to registry
                (setenv "MyOffsetProgram" (vl-princ-to-string off))
                )
)
)
 ;; SSHHHHH!!
 (princ)
 )
(vl-load-com)

Command: DUMPIT
Select object: ; IAcadLine: AutoCAD Line Interface
; Methods supported:
; ..........
;   Offset (1)

(setq ans "N")
(while (/= ans "Y")
(setq obj (vlax-ename->vla-object (car (entsel "\nPick object"))))
(if (= (vlax-method-applicable-p obj "Offset") T)(setq ans  "Y")(alert "Not a object that can be offset\nplease pick again"))
)

13

14