[编程交流] 是否有类似Lisp程序的度量值a

(defun c:RAC (/ ss ent)
 ;; Rotate blocks Along Curve
 ;; Required subroutines: AT:GetSel, AT:AngleAtPoint
 ;; Alan J. Thompson, 12.20.10
 (vl-load-com)
 (if (and (setq ss (ssget "_:L" '((0 . "INSERT"))))
          (setq ent
                 (car
                   (AT:GetSel
                     entsel
                     "\nSelect curve to rotate objects along: "
                     (lambda (x)
                       (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list (car x))))
                       )
                     )
                   )
                 )
          )
     )
   (progn
     (vlax-for x (setq ss (vla-get-activeselectionset
                            (cond (*AcadDoc*)
                                  ((setq *AcadDoc* (vla-get-activedocument
                                                     (vlax-get-acad-object)
                                                   )
                                   )
                                  )
                            )
                          )
                 )
       (vl-catch-all-apply
         (function
           (lambda (/)
             (vla-put-rotation
               x
               (AT:AngleAtPoint
                 ent
                 (vlax-curve-getClosestPointToProjection ent (vlax-get x 'InsertionPoint) '(0 0 1))
               )
             )
           )
         )
       )
     )
     (vla-delete ss)
   )
 )
 (princ)
)
(defun AT:GetSel (meth msg fnc / ent good)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'errno 0)
 (while (not good)
   (setq ent (meth (cond (msg)
                         ("\nSelect object: ")
                   )
             )
   )
   (cond
     ((vl-consp ent)
      (setq good (cond ((or (not fnc) (fnc ent)) ent)
                       ((prompt "\nInvalid object!"))
                 )
      )
     )
     ((eq (type ent) 'STR) (setq good ent))
     ((setq good (eq 52 (getvar 'errno))) nil)
     ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
   )
 )
)
(defun AT:AngleAtPoint (e p)
 ;; Return angle along curve, at specified point (on curve)
 ;; e - valid curve (ENAME or VLA-OBJECT)
 ;; p - point on curve
 ;; Alan J. Thompson, 11.04.10
 (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv e (vlax-curve-getParamAtPoint e p)))
)