原地缩放

自贡黄明儒

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;原地缩放 2014.2.8
(defun c:YDSF (/ A B CENP CMD1 OLDSCALE SC)
  (vl-load-com)
  (or *DOC*
      (setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  ;(_StartUndo *DOC*)
  ;(HH:ayOSMode nil)
  (setq cmd1 (getvar "cmdecho"))
  (if (null oldscale)
    (setq oldscale 2.0)
  )
  (initget 6)
  (setq sc (getreal (strcat "\n 缩放倍数<" (rtos oldscale 2 2) ">:")))
  (if (null sc)
    (setq sc oldscale)
    (setq oldscale sc)
  )
  (while (ssget ":S")
    (vlax-for obj (vla-get-ActiveSelectionSet *DOC*)
      (if (not (VL-CATCH-ALL-ERROR-P
                 (VL-CATCH-ALL-APPLY 'vla-GetBoundingBox (list obj 'a 'b))
               )
          )
        (progn
          (setq        CenP (cons '+
                           (mapcar 'vlax-safearray->list
                                   (list a b)
                           )
                     )
          )
          (setq CenP (apply 'mapcar CenP))
          (setq CenP (mapcar '* '(0.5 0.5 0.5) CenP))
          (vla-ScaleEntity obj (vlax-3d-point CenP) sc)
        )
      )
    )
  )
  (setvar "cmdecho" cmd1)
; (HH:ayOSMode T)
; (_EndUndo *DOC*)
  (gc)
  (princ "\n 自贡运机集团黄明儒温馨提示,原地缩放命令:YDSF")
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;原地缩放 2014.2.8

qqhujunjie2000

这是什么鬼东西

cgs01

楼主可是个高手，不懂就等等看。