[编程交流] Lisp无法正常工作

(defun c:f6 (/ ll ur lr ul vlst ss clyr)
 ;;  do a polar offset of the corners
 ;;  ofs is a real of the offset value
 ;;  returns a new point list
 (defun offsetpts (ll lr ur ul ofs / ang)
   (setq ang (angle ll lr)) ; base angle
   (setq ll (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))
         lr (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
         ur (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
         ul (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))
   )
   (if ll
     (list ll lr ur ul)
   )
 )       ; end defun
 ;;  CAB 10/17/2006
 ;;  returns a point list ((lower left)(upper right))
 (defun ssboundingbox (ss / i ent lst ptlst mnpt mxpt)
   (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq lst (cons (vlax-ename->vla-object ent) lst))
   )
   (mapcar '(lambda (x)
              (vla-getboundingbox x 'mnpt 'mxpt)
              (setq ptlst (cons (vlax-safearray->list mnpt) ptlst))
              (setq ptlst (cons (vlax-safearray->list mxpt) ptlst))
            )
           lst
   )
   ;;following by Tony Tanzillo
   (list
     (apply 'mapcar (cons 'min ptlst))
     (apply 'mapcar (cons 'max ptlst))
   )
 )
 ;;=====================================================
 (setq clyr (getvar "clayer"))
 (prompt "\nSelect objects to frame.")
 (if (setq ss (ssget))
   (progn
     (setq llur (ssboundingbox ss))
     (setq LL (car llur)
           UR (cadr llur)
           LR (list (car UR) (cadr LL))
           UL (list (car LL) (cadr UR))
     )
     (setq vlst (offsetpts LL LR UR UL 2.0))
     (command "-layer" "m" "Face 6" "c" "red" "" "lt" "Dashed" "Face 6" "")
     (command "_.pline")
     (mapcar 'command vlst)
     (command "_c")
   )
 )
 (setvar "clayer" clyr)
loop
 (princ)
)

 (defun trns (pt)    (trans pt 0 1))

 
(setq ll [color=blue](trns[/color] (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))[color=blue])[/color]
         lr [color=blue](trns[/color] (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))[color=blue])[/color]
         ur [color=blue](trns[/color] (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))[color=blue])[/color]
         ul [color=blue](trns[/color] (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))[color=blue])[/color]
   )

(defun c:f6 ( / _offsetoutside _corners->list ss )
   ;; © Lee Mac 2011
   (defun _offsetoutside ( a b )
       (mapcar
           (function
               (lambda ( b c )
                   (mapcar
                       (function
                           (lambda ( b c ) ((eval b) c a))
                       )
                       b c
                   )                                
               )
           )
          '((- -) (+ -) (+ +) (- +))
           b
       )
   )
   (defun _corners->list ( a b )
       (mapcar
           (function
               (lambda ( a b ) (list (car a) (cadr b)))
           )
           (list a b b a) (list a a b b)
       )
   )
(setq clyr (getvar "clayer"))
(command "-layer" "m" "Face 6" "c" "red" "" "lt" "Dashed" "Face 6" "")
   (if (setq ss (ssget '((0 . "~VIEWPORT"))))
       (entmakex
           (append
               (list
                   (cons 0 "LWPOLYLINE")
                   (cons 100 "AcDbEntity")
                   (cons 100 "AcDbPolyline")
                   (cons 8 "Face 6")
                   (cons 90 4)
                   (cons 70 1)
               )
               (mapcar
                   (function
                       (lambda ( x ) (cons 10 x))
                   )
                   (_offsetoutside 2.0
                       (apply '_corners->list (LM:SSBoundingBox ss))
                   )
               )
           )
       )
   )
   (princ) 
(setvar "clayer" clyr)                
)
;;--------------=={ SelectionSet BoundingBox }==--------------;;
;;                                                            ;;
;;  Returns the lower-left and upper-right points of a        ;;
;;  rectangle bounding all objects in a supplied SelectionSet ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - SelectionSet for which to return the BoundingBox     ;;
;;------------------------------------------------------------;;
;;  Returns:  Point List decribing BoundingBox (in WCS)       ;;
;;------------------------------------------------------------;;
(defun LM:SSBoundingBox ( ss / i l1 l2 ll ur )
   (repeat (setq i (sslength ss))
       (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'll 'ur)
       (setq l1 (cons (vlax-safearray->list ll) l1)
             l2 (cons (vlax-safearray->list ur) l2)
       )
   )
   (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list l1 l2))
)
(vl-load-com) (princ)

5