Des_Pontos_Polys.lsp

;;; Início Des_Pontos_Polys.lsp
;;; Ver 1.2

;;; J.A.
;;; www.cadtom.com

;;; Ver 1.1 - 2004-05-21
;;; Ver 1.2 - 2007-01-29

;;; Des_Pontos_Polys.lsp - Aplicação para desenhar pontos nos vértices de Polylines


(defun C:DPPOL (/	  AERR	    AOSMD     ADECH	SGPOLY
		NUMOBJ	  NAMENT    ENTGT     TIPENT	ENPOLYA
		TSEXTRA	  SSLENP    VALPOLY   FIRSTEL	PTZVERT
		PTVERTICE ENPOLYB   VERTIC    TESSPL	TSEXTRB
		ENVERTB	  TSVCONT   PTVERTICE TEMPA	VERTIC
		TESTVER	  VERTIC
	       )

  (command "_.undo" "begin")
  (setq AERR *error*)
  (setq	AOSMD (getvar "osmode")
	ADECH (getvar "cmdecho")
  )
  (setvar "cmdecho" 0)
  (princ "\n»» Seleccione Polyline(s):\n")
  (setq SGPOLY (ssget))
  (if SGPOLY
    (progn
      (setq NUMOBJ (sslength SGPOLY))
      (while (> NUMOBJ 0)
	(setq NAMENT (ssname SGPOLY (setq NUMOBJ (1- NUMOBJ)))
	      ENTGT  (entget NAMENT)
	      TIPENT (cdr (assoc 0 ENTGT))
	)
	(if (equal TIPENT "LWPOLYLINE")
	  (DFLWPOLY)
	)
	(if (equal TIPENT "POLYLINE")
	  (DFPOLY)
	)
      )
    )
    (princ "\n»» Nenhuma entidade seleccionada!\n")
  )
  (command "_.undo" "end")
)

;;;
;;;
;;;

(defun DFLWPOLY	()

  (setq	ENPOLYA	(entget NAMENT)
	TSEXTRA	(car (cdr (assoc 210 ENPOLYA)))
  )
  (if (= TSEXTRA 0.0)
    (progn
      (setvar "osmode" 0)
      (setq SSLENP (length ENPOLYA))
      (while (> SSLENP 0)
	(setq SSLENP  (1- SSLENP)
	      VALPOLY (nth SSLENP ENPOLYA)
	      FIRSTEL (car VALPOLY)
	      PTZVERT (cdr (assoc 38 ENPOLYA))
	)
	(if (= FIRSTEL 10)
	  (progn
	    (setq PTVERTICE (list (nth 1 VALPOLY)
				  (nth 2 VALPOLY)
				  (cdr (assoc 38 ENPOLYA))
			    )
	    )
	    (command "_.point" PTVERTICE)
	  )
	)
      )
      (setvar "osmode" AOSMD)
    )
  )
)

;;;
;;;
;;;

(defun DFPOLY ()

  (setq	ENPOLYB	(entget NAMENT)
	VERTIC	(entnext NAMENT)
	TESSPL	(cdr (assoc 70 ENPOLYB))
	TSEXTRB	(car (cdr (assoc 210 ENPOLYB)))
  )
  (if (= TSEXTRB 0.0)
    (progn
      (setvar "osmode" 0)
      (while VERTIC
	(setq ENVERTB (entget VERTIC)
	      TSVCONT (cdr (assoc 70 ENVERTB))
	)
	(if (/= TSVCONT 16)
	  (progn
	    (setq PTVERTICE (cdr (assoc 10 ENVERTB)))
	    (command "_.point" PTVERTICE)
	  )
	)
	(setq TEMPA   VERTIC
	      VERTIC  (entnext TEMPA)
	      TESTVER (cdr (assoc 0 ENVERTB))
	)
	(if (/= TESTVER "VERTEX")
	  (setq VERTIC nil)
	)
      )
      (setvar "osmode" AOSMD)
    )
  )
)

;;;
;;;
;;;

(defun *error* (msg)

  (setq *error* AERR)
  (setvar "cmdecho" ADECH)
  (setvar "osmode" AOSMD)
  (command "_.undo" "end")
  (princ (strcat "»» Aplicação interrompida com erro: " msg))
)

;;;
;;;
;;;

(terpri)
(princ "\n»» Inicie aplicação digitando DPPOL \n")

;;; Fim Des_Pontos_Polys.lsp



 








Top