;; METRE_TL

 (if pw-foreign
  (progn
   (Prompt "\nMETRE_TL Surveying trough line type (c) G-EAUX 2001 ")
   (prompt "\nNeed Power-Clic installed to run")
   (prompt "\nEnter METRE_TL at Autocad prompt")
  )
  (progn
   (Prompt "\nMETRE_TL Métré par type de ligne (c) G-EAUX 2001 ")
   (prompt "\nNécéssite Power-Clic pour bibliothèques")
   (prompt "\nEntrez METRE_TL à l'invite autocad")
  )
 )

;;Power-CLic freeware/shareware :
;;HTTP://WWW.POWER-CLIC.COM
;;**************************************************************
;;** génère un rapport sur la longueur des lignes et polylignes
;;** classées par type de ligne.
					;
(defun c:metre_tl (/)			;  f ntxt sel sel2 l ll lg-tot lg lent elist )
  (pw_setvar1 "CMDECHO" 0)
  (setq	ntxt (Getfiled   (if pw-foreign  "Survey file name ?" "Nom du fichier de métré ?")
		       (getvar "dwgprefix")
		       "MET"
		       1
	     )
  )
  (setq f (open ntxt "w"))
  (if pw-foreign
   (prompt "\nselect entities for surveying :")
   (prompt "\nselectionnez les objets pour métré :")
  )
  (setq sel (ssget))
  (setq ltl (pw_list_tabl "LTYPE"))
  (setq lg-tot 0)
  (foreach l ltl
    ;;traite les lignes
    (setq sel2 (ssget "_p" (list (cons 6 l) '(0 . "LINE"))))
    (setq lent (pw_listsel sel2))
    (foreach ll	lent
      (setq elist (entget ll))
      (setq lg (distance (cdr (assoc 10 elist)) (cdr (assoc 11 elist))))
      (setq lg-tot (+ lg lg-tot))
    )
    ;;traite les polys
    (command "_select" (eval sel) "")
    ;; reprend le jeu de base
    (setq sel2 (ssget "_p" (list (cons 6 l) '(0 . "LWPOLYLINE"))))
    (setq lg (lin_jslong sel2))
    (setq lg-tot (+ lg lg-tot))
    ;;rapport
    (write-line
      (strcat "TL : " l " Longueur : " (rtos lg-tot))
      f
    )
    (command "_select" (eval sel) "")
    ;; reprend le jeu de base
    (setq lg-tot 0)
  )
  (close f)
  (pw_setvar2 "CMDECHO")
  (if pw-foreign
   (prompt "\nSurveying done.")
   (prompt "\nMétré terminé .")
  )

  (princ)
)
;;****************************************************************************
;;** lin_js delivre la longueur totale des polylignes du jeu "js"
(Defun lin_jslong (js / tempo js nb i)
  (setq tempo 0)
  (if (/= js nil)
    (progn
      (setq nb (sslength js)
	    i  0
      )
      (while (< i nb)
	(setq tempo (+ tempo (long_pol (ssname js i))))
	(setq i (+ i 1))
      )					;** fin while
    )					;** fin progn
  )					;** fin if
  tempo
)
;;****************************************************************************
;;** delivre une liste de distances à partir d'une liste de points
(defun ldis (lp)
  (cond	((not (cadr lp)) nil)
	(t
	 (cons (distance (car lp) (cadr lp))
	       (ldis (cdr lp))
	 )
	)
  )
)

;;****************************************************************************
;;** delivre la longueur d'une polyligne
(defun long_pol	(ent)
  (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
    (apply '+ (ldis (pw_lsomm ent)))
    (apply '+ (ldis (lsomm3d ent)))

  )
)
;;***************************************************************************
;;** Délivre la liste des coordonnes des sommets d'une polyligne 3d
(Defun lsomm3d (nepol / ls lc suiv)
  (setq ls nil)
  (while (/= (cdr
	       (assoc 0 (setq lc (entget (setq suiv (entnext nepol)))))
	     )
	     "SEQEND"
	 )
    (setq ls (append ls (list (cdr (assoc 10 lc)))))
    (setq nepol suiv)
  )
  (setq ls ls)
)