能把帮忙改为先选中图形再运执行?谢谢

wgij007

(defun c:scc  (/ sc a b)
  (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)
    (vlax-for        obj
                (vla-get-ActiveSelectionSet
                  (vla-get-ActiveDocument (vlax-get-acad-object)))
        (if (not (VL-CATCH-ALL-ERROR-P
                   (VL-CATCH-ALL-APPLY
                     'vla-GetBoundingBox
                     (list obj 'a 'b))))
          (progn
            (vla-ScaleEntity
              obj
              (vlax-3d-point
                (mapcar
                  '*
                  '(0.5 0.5 0.5)
                  (apply 'mapcar
                         (cons '+
                               (mapcar 'vlax-safearray->list
                                       (list a b))))))
              sc
              )
            )
          )
        )
    )
  (princ)
  )

bssurvey

是這樣嗎?
(defun c:scc  (/ sc a b)                                               
  (while (ssget)                                                      
    (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))               
    (vlax-for        obj                                               
                (vla-get-ActiveSelectionSet                           
                  (vla-get-ActiveDocument (vlax-get-acad-object)))     
        (if (not (VL-CATCH-ALL-ERROR-P                                 
                   (VL-CATCH-ALL-APPLY                                 
                     'vla-GetBoundingBox                              
                     (list obj 'a 'b))))                              
          (progn                                                      
            (vla-ScaleEntity                                          
              obj                                                      
              (vlax-3d-point                                          
                (mapcar                                                
                  '*                                                   
                  '(0.5 0.5 0.5)                                       
                  (apply 'mapcar                                       
                         (cons '+                                      
                               (mapcar 'vlax-safearray->list           
                                       (list a b))))))                 
              sc                                                      
              )                                                        
            )                                                         
          )                                                            
        )                                                              
    )                                                                  
  (princ)                                                              
  )   
                                                               

wgij007

bssurvey 发表于 2020-11-3 13:54
是這樣嗎?
(defun c:scc  (/ sc a b)                                               
  (while (ssget) ...

是这样的，谢谢