[编程交流] 如何读取垂直于f的多段线

(defun c:plco (/ File oFile pLin pStr pEnt nlist pLen wLine wfLine vPt wvLine)
 (if (setq File (getfiled "Create a Text File" "C:\" "txt" 9))
   (progn
     (setq oFile (open file "W"))
     (while (setq pLin (ssget "_:S" (list (cons 0 "LWPOLYLINE,POLYLINE") (cons 410 (getvar "CTAB")))))
   (sssetfirst nil pLin)
   (if (/= (setq pStr (getstring t "\nSpecify Name for Selected Polyline >> ")) "")
     (progn
       (setq pEnt (ssname pLin 0))
       (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget pEnt))))
          (foreach x (entget pEnt)
            (if (eq 10 (car x))
              (setq nlist (cons (cdr x) nlist))
            ) ;_  end if
          ) ;_  end foreach
          (setq nlist    (reverse nlist)
            pLen    (length nlist)
            wfLine    ""
          ) ;_  end setq
          (while (not (minusp (setq pLen (1- pLen))))
            (setq wLine (strcat (rtos (car (nth pLen nlist)) 2 2)
                    ","
                    (rtos (cadr (nth pLen nlist)) 2 2)
                ) ;_  end strcat
            ) ;_  end setq
            (setq wfLine (strcat wLine "\t" wfLine))
          ) ;_  end while
          (write-line (strcat pStr "\t" wfLine) oFile)
          (setq nlist nil
            wfLine    nil
          )
         )
         ((= "POLYLINE" (cdr (assoc 0 (entget pEnt))))
          (setq wvLine    ""
            pEnt    (entnext pEnt)
          ) ;_  end setq
          (while (/= (cdr (assoc 0 (entget pEnt))) "SEQEND")
            (setq vPt      (cdr (assoc 10 (entget pEnt)))
              wvLine (strcat (rtos (car vPt) 2 2)
                     ","
                     (rtos (cadr vPt) 2 2)
                     ","
                     (rtos (caddr vPt) 2 2)
                     "\t"
                     wvLine
                 ) ;_  end strcat
              pEnt      (entnext pEnt)
            ) ;_  end setq
          ) ;_  end while
          (write-line (strcat pStr "\t" wvLine) oFile)
          (setq wvLine nil)
         )
       ) ;_  end cond
     ) ;_  end progn
     (princ "\n<!> No Line Name Specified. <!>")
   ) ;_  end if
   (sssetfirst nil)
     ) ;_  end while
     (close oFile)
   ) ;_  end progn
   (princ "\n<!> No File Selected. <!> ")
 ) ;_  end if
 (princ)
) ;_  end defun

;|
   Polyline Coordinate Writer
       by Lee McDonnell
         27.01.2009
|;
(defun c:plco2 (/ File oFile ss eLst Selss pName aEnt vLst i vNme)
 (vl-load-com)
 (if (setq File (getfiled "Create a Text File" "C:\" "txt" 9))
   (progn
     (setq oFile (open File "W"))
     (if (setq    ss (ssget (list    (cons 0 "POLYLINE")
   (if (getvar "CTAB") (cons 410 (getvar "CTAB"))(cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (setq    eLst  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       Selss (ssadd))
     (foreach ent eLst
       (ssadd ent Selss)
       (sssetfirst nil Selss)
       (if    (not (setq pName (getstring t "\nSpecify Name for Selected Polyline >  ")))
         (setq pName (vl-princ-to-string ent)))
       (write-line (strcat "Polyline: " pName "\n\n") oFile)
       (setq aEnt (entnext ent))
       (while (/= "SEQEND" (cdr (assoc 0 (entget aEnt))))
         (setq vLst (cons (cdr (assoc 10 (entget aEnt))) vLst)
           aEnt (entnext aEnt)))
       (setq i    (length vLst) vNme "Vertex No: " vt 1)
       (while (not (minusp (setq i (1- i))))
         (write-line
       (strcat    vNme (rtos vt) "\t"
           (rtos (car (nth i vLst)) 2 2) ","
           (rtos (cadr (nth i vLst)) 2 2) ","
           (rtos (caddr (nth i vLst)) 2 2) "\n") oFile)
         (setq vt (1+ vt)))
       (write-line "\n" oFile)
       (setq vLst nil)
       (ssdel ent Selss)
       (sssetfirst nil nil)))
   (princ "\n<!> No Polyline Selected <!>")))
   (princ "\n<!> No File Selected <!>"))
 (close oFile)
 (princ "\n...Vertices Written to File...")
 (princ))