Rutina cuenta bloques iguales de una misma capa

;|comando "blcont" cuenta bloques iguales a uno señalado
siempre que estén en la misma capa indicada.
****Prexem - 2009****
********************************************************|;
(defun C:blcont (/ cmdechant nomb lista cant)
(setq cmdechant (getvar "cmdecho"))
(setvar "cmdecho" 0)
(vl-load-com)
(setq ent (car (entsel "\nseleccione bloque a contar: ")))
(setq vle (vlax-ename->vla-object ent))
(setq nomb (vlax-get vle "name"))
(setq cap (vlax-get vle "layer"))
(setq
lista (ssget "_x"
(list (cons 0 "INSERT") (cons 2 nomb) (cons 8 cap))
)
)
(setq cant (sslength lista))
(princ
(strcat "\nCantidad de bloques con nombre " nomb ": ")
)
(princ cant)
(setvar "cmdecho" cmdechant)
(princ)
);;;fin

Rutina "long-tramos" obtiene las longitudes de los tramos de una polilínea indicada:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; by  (c) Prexem - Victor Adolfo Bracamonte - 2008 ;;;
;;;             www.prexem.blogspot.com              ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:long-tramos (/ errant *error*   e vla-e
        long i    f  v    c    cant
        xp   c1 yp   zp   p
        lp   rlp  cantp    p1
        p2   d
       )
  (vl-load-com)
  (defun errlongtramos (m) (prompt "\n*fin*"))
  (setq errant *error*
 *error* errlongtramos
  )
  (setq e
  (car
    (entsel
      "\nseleccione polilinea a medir tramos:"
      )
    )
 )
  (if
    (or
     (equal (cdr (assoc 0 (entget e))) "POLYLINE")
     (equal (cdr (assoc 0 (entget e))) "LWPOLYLINE")
    )
  (progn
  (setq
    vla-e (vlax-ename->vla-object e)
    long  (vlax-get vla-e 'length)
       v  (vlax-get vla-e 'coordinates)
  )
  (princ "\nLongitud total: ")
  (princ long)
  (setq c 0)
  (setq cant (/ (length v) 2))
  (repeat cant
    (setq xp (nth c v)
   c1 (1+ c)
   yp (nth c1 v)
   zp 0.0
   p  (list xp yp zp)
   lp (cons p lp)
   c  (1+ c1)
    )
  )
  (setq rlp (reverse lp))
  (setq cantp (length rlp))
  (setq c 0)
  (repeat cantp
    (setq p1 (nth c rlp))
    (setq c1 (1+ c))
    (setq p2 (nth c1 rlp))
    (setq d (distance p1 p2))
    (setq c (1+ c))
    (princ "\ntramo ")
    (princ c1)
    (princ ": ")
    (princ d)
  )
  )
    (princ "\n*EL OBJETO INDICADO NO ES POLILINEA*")
    )
  (setq *error* errant)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Rutina "STN" sirve para sumar grupos de textos numéricos:

;|***********************************************
     rutina "stn" suma textos numericos,
     funciona con TEXT y MTEXT no editados 
     (No formateados).
  ***********************************************
  (c) by Prexem - Victor Adolfo Bracamonte - 2008
  ****       www.prexem.blogspot.com         ****
  ***********************************************|;
(defun c:stn (/ sel p h cant index e data val n listn sum res)
  (prompt
 "\nSeleccione textos numericos a sumar, que no hayan sido editados:"
  )
  (setq sel   (ssget '((0 . "MTEXT,TEXT")))
 p     (getpoint
  "\nDar punto de inserción para texto final:"
  )
 h     (getdist p "\nDar altura de texto:")
 cant  (sslength sel)
 index 0
  );setq
  (repeat cant
    (setq e (ssname sel index)
   data  (entget e)
   val   (cdr (assoc 1 data))
   n (atof val)
   listn (cons n listn)
   index (1+ index)
    );setq
  );repeat
  (setq sum (apply '+ listn))
  (setq res (rtos sum 2 2))
  (command "_.text" p h 0 res)
  (princ)
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Rutina que sirve para cerrar grupos de polilíneas abiertas.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:close-plines (/ sel cant index obj origen final)
  (vl-load-com)
  (prompt "****\nSeleccione polilineas a cerrar\n****")
  (setq sel (ssget '((0 . "*POLYLINE")))
 cant (sslength sel)
 index 0
 )
      (repeat cant
 (setq obj (ssname sel index))
  (setq origen (vlax-curve-getstartpoint obj)
        final  (vlax-curve-getendpoint obj)
  )
  (if (equal origen final 0.001)
    (alert "Pline cerrada....")
    (command "_pedit" obj "_c" "")
  );if
 (setq index (1+ index))
      );repeat
  (princ)
);fin
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;