[编程交流] 偏移命令w需要Lisp

(defun c:test (/ n ss p e)
;; Tharwat 27. Sep. 2011 ;;
 (if
   (and (setq n (getdist "\n Specify the Offset Distance :"))
        (setq
          ss (ssget "_+.:S:L" '((0 . "*POLYLINE,*LINE,CIRCLE,ELLIPSE")))
        )
        (setq p (getpoint "\n Specify point :"))
   )
    (progn
      (command "_.offset" n ss "_non" p "")
      (setq e (entlast))
      (if (tblsearch "LAYER" "cover")
        (command "_.chprop" e "" "_layer" "cover" "")
      )
    )
    (princ)
 )
 (princ)
)

 
(defun c:test ( / ss->lst pairpts revpl coverlayer concretelayer dist ss )
 (vl-load-com)
 
 (setq coverlayer "defpoints")
 (setq concretelayer "0")
 
 (defun ss->lst ( ss flag / id lst )
   (if (eq 'PICKSET (type ss))
     (repeat (setq id (sslength ss))
       (
         (lambda ( name )
           (setq lst
             (cons
               (if flag (vlax-ename->vla-object name)
                 name
               )lst
             )
           )
         )(ssname ss (setq id (1- id)))
       )
     )
   )
 )
 (defun pairpts ( _list / l pt )
   (foreach x (reverse _list)
     (if pt
       (setq l (cons (cons x pt) l) pt nil)
       (setq pt (cons x pt))
     )
   ) l
 )
 (defun revpl ( vla-obj / catch openpl )
   (and (eq :vlax-false (setq openpl (vla-get-closed vla-obj)))
     (vla-put-closed vla-obj :vlax-true)
   )
   (setq catch 
     (vl-catch-all-apply (function vlax-invoke)
       (list vla-obj 
         'offset (vla-get-length vla-obj)
       )
     )
   )
   (and (eq :vlax-false openpl)
     (vla-put-closed vla-obj :vlax-false)
   )
   (if (vl-catch-all-error-p catch)
     (vlax-put vla-obj 'coordinates
       (apply (function append)
         (reverse 
           (pairpts (vlax-get vla-obj 'coordinates))
         )
       )
     ) (and catch (vla-delete (car catch)))
   )
   vla-obj
 )
 
 (if (and (setq dist (getdist "\nSpecify distance to offset: "))
   (setq ss (ss->lst (ssget '((0 . "lwpolyline"))) t)))
   (foreach x ss
     (vla-put-layer x coverlayer)
     (vla-put-layer
       (car 
         (vlax-invoke (revpl x) 
           'offset dist
         )
       ) concretelayer
     )
   )
 ) (princ)
)

(setq dist 
(vla-put-layer look at 2nd one