社区 › AutoLISP/Visual LISP 编程技术 › 能把帮忙改为先选中图形再运执行?谢谢

wgij007 发表于 2020-11-3 12:26:23

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

(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 发表于 2020-11-3 12:26:24

是這樣嗎?
(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 发表于 2020-11-3 18:00:30

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

是这样的，谢谢

查看完整版本: 能把帮忙改为先选中图形再运执行?谢谢