[编程交流] 多段线长度

(vl-load-com)
(defun  c:mult-info_po2CSV ( / js file_name cle f_open key_sep str_sep oldim  lst_lay-seg lst_id-seg lst_pt lst_length lst_alpha lst_rad nb id
                             n obj ename pr dist_start dist_end pt_start pt_end seg_len seg_bulge rad alpha)
 (princ "\nSelectionner les polylignes optimisees.")
 (while (null (setq js (ssget '((0 . "LWPOLYLINE")))))
   (princ "\nSelection vide, ou ce ne sont pas des LWPOLYLINE!")
 )
 (command "_.ddunits"
   (while (not (zerop (getvar "cmdactive")))
     (command pause)
   )
 )
  (setq file_name (getfiled "Nom du fichier a creer ?: " (strcat (substr  (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3)) "csv") "csv"  37))
 (if (null file_name) (exit))
 (if (findfile file_name)
   (progn
     (prompt "\nFichier existe deja!")
     (initget "Ajoute Remplace annUler _Add Replace Undo")
     (setq cle
       (getkword "\nDonnees dans fichier? [Ajouter/Remplacer/annUler] <R>: ")
     )
     (cond
       ((eq cle "Add")
         (setq cle "a")
       )
       ((or (eq cle "Replace") (eq cle ()))
         (setq cle "w")
       )
       (T (exit))
     )
     (setq f_open (open file_name cle))
   )
   (setq f_open (open file_name "w"))
 )
 (initget "Espace Virgule Point-virgule Tabulation _SPace Comma SEmicolon Tabulation")
 (setq key_sep (getkword "\nSeparateur [Espace/Virgule/Point-virgule/Tabulation]? <Point-virgule>: "))
 (cond
   ((eq key_sep "SPpace") (setq str_sep " "))
   ((eq key_sep "Comma") (setq str_sep ","))
   ((eq key_sep "Tabulation") (setq str_sep "\t"))
   (T (setq str_sep ";"))
 )
 (setq oldim (getvar "dimzin"))
 (setvar "dimzin" 0)
 (setq
   lst_lay-seg '()
   lst_id-seg '()
   lst_pt '()
   lst_length '()
   lst_alpha '()
   lst_rad '()
   nb 0
   id 0
 )
 (repeat (setq n (sslength js))
   (setq
     obj (ssname js (setq n (1- n)))
     ename (vlax-ename->vla-object obj)
     pr -1
     id (1+ id)
     nb 1
   )
   (repeat (fix (vlax-curve-getEndParam ename))
     (setq
       dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
       dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
       pt_start (vlax-curve-GetPointAtParam ename pr)
       pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
       seg_len (- dist_end dist_start)
       seg_bulge (vla-GetBulge ename pr)
       rad (if (zerop seg_bulge) 0.0 (/ seg_len (* 4.0 (atan seg_bulge))))
       alpha (if (zerop seg_bulge) (angle pt_start pt_end) 0.0)
       lst_lay-seg (cons (cdr (assoc 8 (entget obj))) lst_lay-seg)
       lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa nb)) lst_id-seg)
       lst_pt (cons pt_start lst_pt)
       lst_length (cons seg_len lst_length)
       lst_rad (cons (abs rad) lst_rad)
       lst_alpha (cons alpha lst_alpha)
       nb (1+ nb)
     )
   )
   (if (eq (vla-get-closed ename) :vlax-false)
     (setq lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa nb)) lst_id-seg))
     (setq lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa (- nb (fix (vlax-curve-getEndParam ename))))) lst_id-seg))
   )
   (setq
     lst_pt (cons pt_end lst_pt) lst_lay-seg (cons (cdr (assoc 8 (entget obj))) lst_lay-seg)
     lst_length (cons 0.0 lst_length) lst_rad (cons 0.0 lst_rad) lst_alpha (cons 0.0 lst_alpha)
     nb (1+ nb)
   )
 )
 ;(write-line (strcat "Sommaire de " (itoa (sslength js)) " LWPOLYLINES") f_open)
 (foreach n
   (reverse
     (mapcar'list
       (append (mapcar '(lambda (x) (strcat x str_sep)) lst_lay-seg) (list (strcat "Calque" str_sep)))
       (append (mapcar '(lambda (x) (strcat x str_sep)) lst_id-seg) (list (strcat "N°" str_sep)))
       (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) (mapcar 'car lst_pt)) (list (strcat "Coordonnees X" str_sep)))
       (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) (mapcar 'cadr lst_pt)) (list (strcat "Coordonnees Y" str_sep)))
       (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_length) (list (strcat "Longueurs" str_sep)))
       (append (mapcar '(lambda (x) (strcat (angtos x) str_sep)) lst_alpha) (list (strcat "Angles" str_sep)))
       (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_rad) (list (strcat "Rayons" str_sep)))
     )
   )
   (write-line (apply 'strcat n) f_open)
 )
 (close f_open)
 (setvar "dimzin" oldim)
 (prin1)
)