[Visual_Lisp] 批量物体中心缩放_中心缩放lisp-优快云博客

本文介绍了一个名为scc的命令，用于在指定物体上进行中心缩放操作，适用于圆形、方形等形状。通过选择物体并输入比例因子，实现物体的中心缩放效果。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

;; 程序功能: 物体中心缩放，命令 scc，作者:qjchen
;; 注:此中心指的是物体的boundingbox(外包围圈矩形)的中心，非真正的形心
;; 仅对于圆形，方形等，此中心同形心
(vl-load-com)
(defun c:scc ()
  (zxs)
  (princ)
)
;;;subrountine to scale
(defun zxs (/ ssets scal len-ssets i entss objss res midpoint)
  (prompt "\n请选择需要进行中心缩放的物体:")  
  (setq ssets (std-sslist (ssget)))
  (setq scal (getreal "\n比例因子:"))
  (foreach x ssets
    (setq objss (vlax-ename->vla-object x))
    (setq res (xyval1 objss))
    (setq midpoint (midp (list (nth 0 res) (nth 1 res)) (list (nth 2 res) (nth 3 res))))
    (vla-scaleentity objss (vlax-3D-point midpoint) scal) ;_ end of vla-scaleentity
  )
)
;;; _ end of xyval
;;;;---The following codes are copy from Tony Hotchkiss at cadalyst
;;Get the boundingbox of one object
(defun xyval1 (obj / minpt maxpt pt1 pt2)
  (vla-GetBoundingBox obj 'minpt 'maxpt)
  (setq pt1 (vlax-safearray->list minpt)
 pt2 (vlax-safearray->list maxpt)
  )           ; _ end of setq
  (list (car pt1) (cadr pt1) (car pt2) (cadr pt2))
);;; =======================================================================;
;;; selection to list, by Reini Urban                                      ;
;;; =======================================================================;
(defun std-sslist  (ss / n lst)
  (if (eq 'pickset (type ss))
    (repeat (setq n (fix (sslength ss))) ; fixed
      (setq lst (cons (ssname ss (setq n (1- n))) lst))))
)
;-------------------------------------------------------
(defun midp (p1 p2)
  (mapcar '(lambda (x) (/ x 2.)) (mapcar '+ p1 p2))
)
(princ "\n By qjchen@gmail.com, 选择物体分别进行中心缩放, The command is scc")
(princ)