[编程交流] 寻找LISP的比例

;; Scale About Center  -  Lee Mac
(defun c:sac ( / ll sel obj ur )
   (initget 6)
   (if
       (and
           (setq *scl*
               (cond
                   (   (getdist (strcat "\nSpecify Scale Factor" (if *scl* (strcat " <" (rtos *scl* 2) ">: ") ": "))))
                   (   *scl*   )
               )
           )
           (ssget "_:L")
       )
       (progn
           (vlax-for obj (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
               (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
                   (vla-scaleentity obj
                       (vlax-3D-point
                           (mapcar '(lambda ( a b ) (/ (+ a b) 2.0))
                               (vlax-safearray->list ll)
                               (vlax-safearray->list ur)
                           )
                       )
                       *scl*
                   )
               )
           )
           (vla-delete sel)
       )
   )
   (princ)
)
(vl-load-com) (princ)

 ; a roughy
(defun c:test (/ sc ss x)
(setq sc (Getreal "\nEnter scale"))
(setq ss (ssget "x" (list(cons 0 "INSERT"))))
(repeat (SETQ X (SSLENGTH SS))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(vla-put-XScaleFactor obj sc)
(vla-put-YScaleFactor obj sc)
)
)
(c:test)