[编程交流] 更改圆形块的比例

[color="green"];rescale bubble test[/color]
  (defun c:bubsc (/ bn scl ss blk bo scl s2 dp p i ip lo st isblk)
    ;hanhphuc 28.05.2018
    (initget 7)
    (and
  (setq bn [color="purple"][b]"test"[/b][/color][color="green"] ; <-- block name to modify [/color]
               scl (getreal "\nSpecify scale factor : "))
  (setq        blk ((lambda (doc) (foreach x '(ActiveDocument Blocks) (setq doc (vlax-get doc x))))
              (vlax-get-acad-object)
              )
        ss  (ssget "X"
                   (list '(-4 . "<OR")'(-4 . "<AND")'(0 . "INSERT")(cons 2 bn)'(66 . 1)'(-4 . "AND>")
                         '(0 . "LINE")'(-4 . "OR>")'(410 . "Model")
                         ) 
                   ) 
        )
  (progn 
         (setq s2 (vl-remove-if-not ''((x) (= "LINE" (cdr (assoc 0 (entget x))))) (acet-ss-to-list ss))); grid line
         (repeat (setq i (sslength ss))
           (and (setq bo  (vlax-ename->vla-object  (ssname ss (setq i (1- i)))))
                ;(= (vla-get-Name bo) bn )
                (setq isblk (= (vla-get-ObjectName bo) "AcDbBlockReference"))         
                (vlax-invoke bo 'scaleentity
                  (setq
                    ip ((lambda        (obj / a b)
                          (vla-getboundingbox obj 'a 'b)
                          (apply 'mapcar
                                 (cons ''((a b) (/ (+ a b) 2.0)) (mapcar 'vlax-safearray->list (list a b)))
                                 ) 
                          ) 
                         bo
                         )
                    ) 
                  scl
                  ) ;_ end of vlax-invoke
           ) ;_ end of and
           (foreach x s2
             (setq lo (vlax-ename->vla-object x)
                   dp (vl-sort (mapcar ''((x) (cons (distance ip (setq p (vlax-get lo x))) p)) '(StartPoint EndPoint))
                               ''((a b) (< (car a) (car b)))
                               ) 
                   ) 
             (if (and isblk
                      (equal (angle (setq st (cdar dp)) ip)  (apply 'angle (reverse (mapcar 'cdr dp))) 0.1 )
                      ) 
               (vlax-invoke bo 'move st
                 (polar st (angle st ip) (- (* scl (caar dp)) (caar dp)))
                 ) 
               ) 
             )
           ) 
         ) ;_ end of progn
  ) ;_ end of and
    (princ)
    ) ;_ end of defun