[编程交流] 将中心对准tw

(vl-load-com)
(defun c:test (/ i e p1 p2 ss lst q var[color="red"] f fn dat dat1[/color]) 
;hanhphuc 2014
 (set 'var (getvar 'cmdecho ))
 (setvar 'cmdecho 0) 
 (if (and (setq e (entsel "\nPlease select solid.. ")) (setq e (car e)) (= (cdr (assoc 0 (entget e))) "3DSOLID"))
   (progn (vla-GetBoundingBox (setq obj (vlax-ename->vla-object e)) 'p1 'p2)
   (mapcar ''((a b) (set a (vlax-safearray->list b))) '(p1 p2) (list p1 p2))
   (command "_explode" e)
   (setq i   0
         ss  (ssget "C" p1 p2)
         lst (mapcar '(lambda(x)
                        (setq q nil)
                        (if
                         (= (cdr (assoc 0 (entget x))) "REGION")
                         (setq q (cons (LM:reg x) q))
                         (setq q (cons (vlax-ename->vla-object x) q))
                         )
                        (if
                         (listp q)
                         (LM:flatten q)
                         q
                         )
                        )
                     (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                     ) ;_ end of mapcar
         ) ;_ end of setq
     
   (foreach o (vl-remove-if-not ''((x) (= (vla-get-ObjectName x) "AcDbCircle")) (LM:flatten lst))
     
     (setq dat(cons (princ (strcat [color="red"]"\nCIRCLE_"[/color] (itoa (setq i (1+ i))) [color="red"]" "[/color]
             (vl-princ-to-string
                 (mapcar ''((x)(vlax-get o x)) '(Radius Center))
               )))
                     dat))
       
     ) ;_ end of foreach
   (command "_.U")
[color="red"](setq fn (strcat (getvar "dwgprefix") "hole dat.csv") f (open fn "w"))
[color="blue"] ; If you don't want to override file ,to append use (open fn "a") as suggested by Marko @ post#14[/color]
(foreach $
(foreach x dat
 (setq        dat1 (cons (vl-string-translate
             " "
             ","
             (vl-list->string
               (vl-remove-if ''((a) (or (= a 10) (= a 40) (= a 41))) (vl-string->list x))
               ) ;_ end of vl-list->string
             ) ;_ end of vl-string-translate
           dat1
           ) ;_ end of cons
) ;_ end of setq
 ) ;_ end of foreach
(write-line $ f))
(write-line " " f)
(if f (close f))
(startapp "notepad" fn)[/color]     [color="blue"];<--remove this line if you don't want it to pop-up everytime[/color]
   ) ;_ end of progn
   ) ;_ end of if
 (setvar 'cmdecho var)
 (princ)
 ) ;_ end of defun

;;;http://www.cadtutor.net/forum/showthread.php?35506-How-to-get-Region-coordinates/page2
;;;adopted as sub-function
(defun LM:reg (reg / RetObj)
 (setq Reg (vlax-ename->vla-object reg))
 (if (vlax-method-applicable-p reg 'explode)
 (progn
 (setq RetObj (vlax-safearray->list (vlax-variant-value (vla-explode Reg))))
 (repeat (length RetObj)
   (if        (eq "AcDbRegion" (vla-get-ObjectName (car RetObj)))
     (setq RetObj (append RetObj (vlax-safearray->list (vlax-variant-value (vla-explode (car RetObj))))))
     (setq RetObj (append RetObj (list (car RetObj))))
     ) ;_ end of if
   (setq RetObj (cdr RetObj))
   ) ;_ end of repeat
 )
   )
 retobj
 ) ;_ end of defun
;; Flatten List  -  Lee Mac
;; Transforms a nested list into a non-nested list
;; http://www.lee-mac.com/flatten.html
(defun LM:flatten ( l )
   (if (atom l)
       (list l)
       (append (LM:flatten (car l)) (if (cdr l) (LM:flatten (cdr l))))
   )
)

[color="red"](vl-load-com)[/color][color="gray"]
(defun c:test (/ i e p1 p2 ss lst q) 
...
...
...[/color]