[编程交流] C3D路线长度报告

(vl-load-com)
(defun c:C3dComApi (/ file)
 (if
   (setq
       file (findfile
              (strcat
                (vl-registry-read
                  (strcat "HKEY_LOCAL_MACHINE\"
                          (if vlax-user-product-key                    ; If 2013
                            (vlax-user-product-key)                    ; Use 2013 function
                            (vlax-product-key)                         ; Use legacy function
                          )
                  )
                  "ACADLOCATION"
                )
                "\\help\\civil_api_activex_reference.chm"
              )
            )
     )
   (startapp "explorer" file)
   (prompt "\n** File not found ** ")
 )
 (princ)
)

(vl-load-com)
(defun c:ALR () (c:AlignmentsLengthReport))
(defun c:AlignmentsLengthReport (/ *error*)
 (princ "\rALIGNMENTSLENGTHREPORT ")
 (defun *error* (msg)
   (if file
     (close file)
   )
   (if oShell
     (vlax-release-object oShell)
   )
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** " msg " ** ")))                         ; Fatal error, display it
   )
   (princ)
 )
 ((lambda (acApp / ss oShell filePath file alignmentName alignmentLength)
    (if (and (setq ss (ssget "_x" '((0 . "AECC_ALIGNMENT"))))
             (setq oShell (vla-getinterfaceobject
                            acApp
                            "Shell.Application"
                          )
             )
             (setq filePath
                    (strcat
                      (vl-filename-directory
                        (vl-filename-mktemp)
                      )
                      "\\Alignments Length Report_"
                      (menucmd
                        "M=$(edtime,$(getvar,date),YYYY-MO-DD)"
                      )
                      ".csv"
                    )
             )
             (princ "\nWorking, please wait... ")
             (princ)
        )
      (progn
        (setq file (open filePath "w"))
        (write-line "Civil 3D Drawing:" file)
        (write-line
          (strcat (getvar 'dwgprefix) (getvar 'dwgname))
          file
        )
        (write-line "" file)
        (write-line "Alignment Name:,Length:" file)
        (vlax-for x (setq ss (vla-get-activeselectionset (vla-get-activedocument acApp)))
          (if (and (setq alignmentName (vlax-get x 'name))
                   (setq alignmentLength (rtos (vlax-get x 'length)))
              )
            (write-line (strcat alignmentName "," alignmentLength) file)
          )
        )
        (vla-delete ss)
        (princ "Done.")
        (setq file (close file))
        (vlax-invoke oShell 'open filePath)
        (*error* nil)
      )
      (cond
        (ss
         (*error*
           "Error: Unable to create "Shell.Application" Object"
         )
        )
        ((*error* "No alignments found"))
      )
    )
  )
   (vlax-get-acad-object)
 )
)