[编程交流] 用于CenterPoint导出wi的Lisp

(vl-load-com)
(defun c:XYT (/ *error* path acApp oShell f acDoc nArc nCircle nEllipse
             origin oSpace height style objectName i oMtext
            )
 (defun *error* (msg)
   (if f
     (progn (close f) (vl-file-delete path))
   )
   (if acDoc
     (vla-endundomark acDoc)
   )
   (if oShell
     (vlax-release-object oShell)
   )
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
   )
   (princ)
 )
 (if (and (setq path (getfiled "Specify .CSV file name:"
                               (getvar 'dwgprefix)
                               "csv"
                               1
                     )
          )
          (ssget '((0 . "ARC,CIRCLE,ELLIPSE")))
          (princ "\nWorking, please wait... ")
          (princ)
          (setq oShell (vla-getinterfaceobject
                         (setq acApp (vlax-get-acad-object))
                         "Shell.Application"
                       )
          )
     )
   (progn
     (setq f (open path "w"))
     (write-line
       "Serial Number:,X:,Y:,Dia (Major):,Dia (Minor):,Type:"
       f
     )
     (write-line "" f)
     (vla-startundomark
       (setq acDoc (vla-get-activedocument acApp))
     )
     (setq nArc 0)
     (setq nCircle 0)
     (setq nEllipse 0)
     (setq origin (vlax-3d-point '(0.0 0.0 0.0)))
     (setq oSpace (vlax-get acDoc
                            (if (= 1 (getvar 'cvport))
                              'paperspace
                              'modelspace
                            )
                  )
     )
     (setq height (getvar 'textsize))
     (setq style (getvar 'textstyle))
     (vlax-for x (vla-get-activeselectionset acDoc)
       ;; mtext
       (setq oMtext
              (vla-addmtext
                oSpace
                origin
                0.0
                (setq i
                       (cond
                         ((= "AcDbArc"
                             (setq objectName (vla-get-objectname x))
                          )
                          (strcat "A" (itoa (setq nArc (1+ nArc))))
                         )
                         ((= "AcDbCircle" objectName)
                          (strcat "C" (itoa (setq nCircle (1+ nCircle))))
                         )
                         ((= "AcDbEllipse" objectName)
                          (strcat "E" (itoa (setq nEllipse (1+ nEllipse))))
                         )
                       )
                )
              )
       )
       (vla-put-height oMtext height)
       (vla-put-stylename oMtext style)
       (vla-put-attachmentpoint oMtext acattachmentpointmiddlecenter)
       (vla-move oMtext
                 (vla-get-insertionpoint oMtext)
                 (vlax-3d-point (setq center (vlax-get x 'center)))
       )
       ;; write
       (write-line
         (strcat i
                 ","
                 (rtos (car center))
                 ","
                 (rtos (cadr center))
                 ","
                 (if (= "AcDbEllipse" objectName)
                   (strcat (rtos (vla-get-majorradius x))
                           ","
                           (rtos (vla-get-minorradius x))
                   )
                   (strcat (rtos (vla-get-radius x)) "," "")
                 )
                 ","
                 (vl-string-subst "" "AcDb" objectName)
         )
         f
       )
     )
     (setq f (close f))
     (vlax-invoke oShell 'open path)
     (princ "Done. ")
     (prompt "\n** UNDO will not delete the resultant .CSV file created ** ")
   )
 )
 (*error* nil)
)