[编程交流] 将现有Lisp修改为includ

; Pilout - write the X and Y coordinates of all inserts of a block to a file.
; Copyright 1997 by Rocket software
; The other kind.
; Subroutine Frat - returns the value of the first filled attribute found,
; otherwise "".  Takes one argument, the insertion ename.
(DEFUN FRAT (enam / str)
 (while (and (null str)
             (/= "SEQEND"
             (cdr (assoc 0 (setq entt (entget (setq enam (entnext enam))))))))
        (setq vall (cdr (assoc 1 entt)))
        (while (= (substr vall 1 1) " ") (setq vall (substr vall 2)))
        (if (/= vall "") (setq str vall)))
 (if str str ""))
; Frat end.
(DEFUN C:PILOUT (/ num bl enampt entt ss filnam fn rad len so pa datstr)
 (setvar "cmdecho" 0)
 (setq num 0)
 (setq bl (getstring "Block to use or <Return> to select: "))
 (if (and (= bl "")
          (setq enampt (entsel "Select a block: ")))
     (progn
          (setq entt (entget (car enampt)))
          (setq bl (cdr (assoc 2 entt)))
          (if bl (prompt bl))))
 (if bl (setq ss (ssget "X" (list (cons 2 bl)))))
 (if ss
    (progn
         (setq filnam (getfiled "Data File" "Piles.cdf" "" 1))
         (if filnam (setq fn (open filnam "w")))
         (setq rad (/ (getvar "viewsize") 25))
         (setq len (strcat "/" (itoa (sslength ss))))
         (while (setq so (ssname ss num))
                (setq entt (entget so))
                (setq num (1+ num))
                (grtext -2 (strcat (itoa num) len))
                (setq pa (cdr (assoc 10 entt)))
; Translate point data to current ucs.
                (setq pa (trans pa 0 1))
                (grdraw (polar pa (/ pi 4) rad)
                        (polar pa (* 1.25 pi) rad) 7)
                (grdraw (polar pa (* pi 0.75) rad)
                        (polar pa (* pi 1.75) rad) 7)
                (setq datstr (strcat (frat so) ","
                                     (rtos (car pa) 2 6) ","
                                     (rtos (cadr pa) 2 6)))
                (write-line datstr fn))
         (if fn (close fn)))
    (if bl
          (write-line "\nCan't find any such block. ")
          (write-line "\nSome type of error...")))
 (if ss (write-line (strcat "\nLines written to file: " (itoa num))))
(princ))

(setq datstr (strcat (frat so) ","
                                     (rtos (car   pa) 2 6) ","
                                     (rtos (cadr  pa) 2 6) ","
                                     (rtos (caddr pa) 2 6)
                             )
                )

(setq filnam (getfiled "Data File" "Piles.csv" "" 1))