etiquetar poligono

hola estoy tratando de programar el etiquetado de los vertices de un poligono cerrado con numeracion y la longitud de cada uno de los lados asi tambien el acotado interno del poligono espero su ayuda

Hola Eduardo, hoy (29-3-2016) todavía puedes buscar en Hispacad por - lotes - o por - polilineas cerradas - que allí hay algunos lisp que te pueden orientar. Yo no vi ninguno completo (tampoco es lo mío), pero dicen que el de cofropri200 esta muy bien para lotes de terreno aunque esta compilado y no se puede ver como funciona por dentro.
Si no subes lo que que llevas, no se como te podemos ayudar aquí ??

Un saludo

Además de visitar Hispacad, ahora que todavía se puede, creo que es imprescindible adjuntar un archivo dwg con lo que quieres exactamente. Con un "antes" y un "después".

lamentablemente , parece imposible adjuntar DWG , y no hay espacio disponible para adjuntar ZIP.

Creo que debemos abrirnos a la confianza y poner nuestro mail en cada post para que quien quiera o pueda ayudar solicite se le envíe el DWG .

no e podido adjuntar ningun archivo, bueno e logrado etiquetar los vértices aunque no de la mejor manera , pero si etiquetar los lados ahora estoy intentando acotar los angulos internos del poligono cerrado espero me puedan orientar con respecto a esto y lograria culminar el lisp

eduardoceliz escribió:no e podido adjuntar ningun archivo, bueno e logrado etiquetar los vértices aunque no de la mejor manera , pero si etiquetar los lados ahora estoy intentando acotar los angulos internos del poligono cerrado espero me puedan orientar con respecto a esto y lograria culminar el lisp

Lo que puedes poner es el código como texto o como código

eduardoceliz escribió:no e podido adjuntar ningun archivo, bueno e logrado etiquetar los vértices aunque no de la mejor manera , pero si etiquetar los lados ahora estoy intentando acotar los angulos internos del poligono cerrado espero me puedan orientar con respecto a esto y lograria culminar el lisp

A qui tienes una rutina que acota angulos intermos y lados de polilineas.
un saludo

Código:

 ;Acota angulos internos y lados de una polilinea
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun ang3 (/ a1 d1 d3 dd di p4 p5)
  (setq p1    (list x1 y1)
        p2    (list x2 y2)
        p3    (list x3 y3)
        p4    (polar p2 (- (angle p1 p2) (/ pi 2.0)) 10.0)
        p5    (polar p2 (+ (angle p1 p2) (/ pi 2.0)) 10.0)
        d1    (distance p1 p2)
        d2    (distance p2 p3)
        d3    (distance p1 p3)
        dd    (distance p4 p3)
        di    (distance p5 p3)
        a1    (- 180.0 (rad_sexa (arccos (/ (- (+ (expt d1 2.0) (expt d2 2.0)) (expt d3 2.0)) (* 2.0 d1 d2)))))
        aint  (- 360.0
                  (atof (rtos (if (< dd di)
                                  (+ 180.0 a1)
                                  (- 180.0 a1)
                              )
                              2
                              16
                        )
                  )
                )
        aintxt (gms aint)
        a/2    (/ (dtr aint) 2.0)
        p6    (polar p2 (angle p2 p1) (* at11 7.5))
        p7    (polar p2 (angle p2 p3) (* at11 7.5))
        p8    (polar p2 (+ (angle p2 p1) a/2) (* at11 7.5))
  )
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun arccos (x)
  (cond ((= x 1) 0)
        ((= x -1) pi)
        ((and (< x 1) (> x -1)) (+ (atan (/ (- x) (sqrt (1+ (* x (- x)))))) (/ pi 2.0)))
        (t nil)
  )
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun rad_sexa (radianes) (/ (* radianes 180.0) pi))
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun dtr (d) (* pi (/ d 180.0)))
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo

(defun gms (angdec)
  (setq signo    (if (<= angdec 0.0)
                    "-"
                    ""
                  )
        grados  (fix (abs angdec))
        minutos  (fix (* (- (abs angdec) grados) 60.0))
        segundos (* (- (* (- (abs angdec) grados) 60.0) minutos) 60.0)
  )
  (if (< minutos 10.0)
      (setq mins (strcat "0" (rtos minutos 2 0)))
      (setq mins (rtos minutos 2 0))
  )
  (if (< segundos 10.0)
      (setq segs (strcat "0" (rtos segundos 2 0)))
      (setq segs (rtos segundos 2 0))
  )
  (strcat signo (rtos grados 2 0) (chr 176) mins "'") ;sin segundos
;;;  (strcat signo (rtos grados 2 0) (chr 176) mins "'" segs (chr 34));con segundos
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun entmakelayer (name color)
  (if (not (tblsearch "layer" name))
      (entmake (list (cons 0 "LAYER")
                    (cons 100 "AcDbSymbolTableRecord")
                    (cons 100 "AcDbLayerTableRecord")
                    (cons 70 0)
                    (cons 2 name)
                    (cons 62 color)
              )
      )
  )
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun entmaketext (value style height inspoint layer anchura rot j)
  (entmake (list (cons 0 "TEXT")
                  (cons 100 "AcDbEntity")
                  (cons 100 "AcDbText")
                  (cons 72 1) ; Justificacion
                  (cons 73 j) ; Justificacion
                  (cons 1 value)
                  (cons 7 style)
                  (cons 8 layer)
                  (cons 10 inspoint)
                  (cons 11 inspoint)
                  (cons 40 height)
                  (cons 41 anchura)
                  (cons 50 rot)
            )
  )
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun entmaketextstyle (ht wid oblique style-name font-file)
  (if (not (tblsearch "style" style-name))
      (entmake (append (list (cons 0 "STYLE")
                            (cons 100 "AcDbSymbolTableRecord")
                            (cons 100 "AcDbTextStyleTableRecord")
                            (cons 70 0)
                            (cons 40 ht)
                            (cons 41 wid)
                            (cons 50 oblique)
                            (cons 71 0)
                      )
                      (append (list (cons 2 style-name)) (list (cons 3 (strcase font-file))))
              )
      )
  )
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun entmakearc (tipol capa centro radio ang1 ang2)
  (entmake (list (cons 0 "ARC")
                  (cons 6 tipol)
                  (cons 8 capa)
                  (cons 10 centro)
                  (cons 40 radio)
                  (cons 50 ang1)
                  (cons 51 ang2)
            )
  )
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun tbox (textent / tb ll ur ul lr)
  (command "_.ucs" "_object" textent)
  (setq tb (textbox (list (cons -1 textent)))
        ll (car tb)
        ur (cadr tb)
        ul (list (car ll) (cadr ur))
        lr (list (car ur) (cadr ll))
  )
  (command "_.pline" ll lr ur ul "_close")
  (command "_.ucs" "_p")
  (princ)
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun c:ang_int (/ a/2 abase2 adir2 aintxt at1 at11 at2 at22 contador contador1 contador2 coord coord2 coord3 d2 dd
                  modos negativos os p1 p2 p3 p8 pm positivos pt1 pt2 valneg valpos vlent x1 x2 x3 y1 y2 y3
                )
  (vl-load-com)
  (command "_.undo" "_begin")
  (setq adir2  (getvar "angdir")
        abase2 (getvar "angbase")
        os    (getvar "osmode")
  )
  (setvar "angbase" 0)
  (setvar "angdir" 0)
  (setvar "osmode" 0)
  (entmaketextstyle 0.0 0.7 0 "Acotaciones" "Romans")
  (entmakelayer "Acotaciones" 2)
  (setq modos  (getvar "osmode")
        vlent  (vlax-ename->vla-object (car (entsel "\nSeleccione la polilinea")))
        coord  (vlax-safearray->list (vlax-variant-value (vlax-get-property vlent 'coordinates)))
        coord2 '()
        at1    3.5
        at2    3.5
  )
  (setq at11 (getreal (strcat "\nAltura texto de los ANGULOS< " (rtos at1 2 2) " >: ")))
  (if (not at11)
      (setq at11 at1)
  )
  (setq at22 (getreal (strcat "\nAltura texto de los LADOS< " (rtos at2 2 2) " >: ")))
  (if (not at22)
      (setq at22 at2)
  )
  (repeat (/ (length coord) 2)
      (setq coord2 (append coord2 (list (list (car coord) (cadr coord))))
            coord  (cddr coord)
      )
  )
  (setq coord    '()
        coord2    (append coord2 (list (car coord2)))
        contador1 0
  )
  (repeat (- (length coord2) 1)
      (setq pt1 (nth contador1 coord2)
            pt2 (nth (1+ contador1) coord2)
            dd  (distance pt1 pt2)
      )
      (if (equal dd 0.0 0.001)
        (setq coord2 (cdr coord2))
        (setq coord    (append coord (list pt2))
              contador1 (1+ contador1)
        )
      )
  )
  (setq coord3    coord
        coord3    (append coord3 (list (car coord)))
        positivos 0.0
        negativos 0.0
        contador2 0
  )
  (repeat (- (length coord3) 1)
      (setq x1        (car (nth contador2 coord3))
            y1        (cadr (nth contador2 coord3))
            x2        (car (nth (1+ contador2) coord3))
            y2        (cadr (nth (1+ contador2) coord3))
            valpos    (* x1 y2)
            valneg    (* x2 y1)
            positivos (+ positivos valpos)
            negativos (+ negativos valneg)
            contador2 (1+ contador2)
      )
  )
  (setq a/2 (- positivos negativos))
  (if (> a/2 0.0)
      (setq coord (reverse coord))
  )
  (setvar "osmode" 0)
  (setq coord    (append coord (list (car coord)))
        coord    (append coord (list (cadr coord)))
        contador 0
  )
  (repeat (- (length coord) 2)
      (setq x1 (car (nth contador coord))
            y1 (cadr (nth contador coord))
            x2 (car (nth (+ contador 1) coord))
            y2 (cadr (nth (+ contador 1) coord))
            x3 (car (nth (+ contador 2) coord))
            y3 (cadr (nth (+ contador 2) coord))
            pm (list (/ (+ x2 x3) 2.0) (/ (+ y2 y3) 2.0))
      )
      (ang3)
      (entmakearc "Continuous" "Acotaciones" p2 (* at11 7.5) (angle p2 p1) (angle p2 p3))
      (entmaketext aintxt "Acotaciones" at11 p8 "Acotaciones" 0.7 0.0 2)
      (setq txttemp (entlast))
      (tbox (entlast))
      (command "_.wipeout" "" (entlast) "_y" "_.wipeout" "_f" "_off")
      (entdel txttemp)
      (entmaketext aintxt "Acotaciones" at11 p8 "Acotaciones" 0.7 0.0 2)
      (if (or (< (angle p2 p3) (/ pi 2.0)) (> (angle p2 p3) (/ (* pi 3.0) 2.0)))
        (entmaketext (rtos d2 2 2) "Acotaciones" at22 pm "Acotaciones" 1.0 (angle p2 p3) 3)
        (entmaketext (rtos d2 2 2) "Acotaciones" at22 pm "Acotaciones" 1.0 (angle p3 p2) 1)
      )
      (setq contador (1+ contador))
  )
  (setvar "angdir" adir2)
  (setvar "angbase" abase2)
  (setvar "osmode" os)
  (command "_.undo" "_end")
  (princ)
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo

Y aqui tienes otra

Código:

 ;Escribe angulos internos de una polilinea.
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun c:angu_inter (/ dir base osm coord coord2 conta1 pt1 pt2 dd coord3 posi nega conta2 x1 y1 x2 y2 valpos valneg a/2 conta
                x3 y3 p1 p2 p3 p4 p5 d1 d2 d3 dd di a1 aint angu signo grad minu segu segs
              )
  (vl-load-com)
  (setq dir (getvar "angdir"))
  (setq base (getvar "angbase"))
  (setq osm (getvar "osmode"))
  (setvar "angbase" 0)
  (setvar "angdir" 0)
  (setvar "osmode" 0)
  (if (not (tblobjname "STYLE" "Angulos"))
      (entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(70 . 0)
                    '(40 . 0) '(71 . 0) '(2 . "Angulos") '(3 . "Arial")
                    )
      )
  )
  (setq coord (vlax-safearray->list
                  (vlax-variant-value
                    (vla-get-coordinates (vlax-ename->vla-object (car (entsel "\nSeleccionar polilinea: "))))
                  )
              )
  )
  (setq coord2 '())
  (repeat (/ (length coord) 2)
      (setq coord2 (append coord2 (list (list (car coord) (cadr coord)))))
      (setq coord (cddr coord))
  )
  (setq coord '())
  (setq coord2 (append coord2 (list (car coord2))))
  (setq conta1 0)
  (repeat (1- (length coord2))
      (setq pt1 (nth conta1 coord2))
      (setq pt2 (nth (1+ conta1) coord2))
      (setq dd (distance pt1 pt2))
      (if (equal dd 0.0 0.001)
        (setq coord2 (cdr coord2))
        (progn (setq coord (append coord (list pt2))) (setq conta1 (1+ conta1)))
      )
  )
  (setq coord3 coord)
  (setq coord3 (append coord3 (list (car coord))))
  (setq posi 0.0)
  (setq nega 0.0)
  (setq conta2 0)
  (repeat (1- (length coord3))
      (setq x1 (car (nth conta2 coord3)))
      (setq y1 (cadr (nth conta2 coord3)))
      (setq x2 (car (nth (1+ conta2) coord3)))
      (setq y2 (cadr (nth (1+ conta2) coord3)))
      (setq valpos (* x1 y2))
      (setq valneg (* x2 y1))
      (setq posi (+ posi valpos))
      (setq nega (+ nega valneg))
      (setq conta2 (1+ conta2))
  )
  (setq a/2 (- posi nega))
  (if (> a/2 0.0)
      (setq coord (reverse coord))
  )
  (setq coord (append coord (list (car coord))))
  (setq coord (append coord (list (cadr coord))))
  (defun ar_cos (x)
      (cond ((= x 1) 0)
            ((= x -1) pi)
            ((and (< x 1) (> x -1)) (+ (atan (/ (- x) (sqrt (1+ (* x (- x)))))) (/ pi 2.0)))
            (t nil)
      )
  )
  (setq conta 0)
  (repeat (- (length coord) 2)
      (setq x1 (car (nth conta coord)))
      (setq y1 (cadr (nth conta coord)))
      (setq x2 (car (nth (1+ conta) coord)))
      (setq y2 (cadr (nth (1+ conta) coord)))
      (setq x3 (car (nth (+ conta 2) coord)))
      (setq y3 (cadr (nth (+ conta 2) coord)))
      (setq p1 (list x1 y1))
      (setq p2 (list x2 y2))
      (setq p3 (list x3 y3))
      (setq p4 (polar p2 (- (angle p1 p2) (/ pi 2.0)) 10.0))
      (setq p5 (polar p2 (+ (angle p1 p2) (/ pi 2.0)) 10.0))
      (setq d1 (distance p1 p2))
      (setq d2 (distance p2 p3))
      (setq d3 (distance p1 p3))
      (setq dd (distance p4 p3))
      (setq di (distance p5 p3))
      (setq a1 (- 180.0
                  (/ (* (ar_cos (/ (- (+ (expt d1 2.0) (expt d2 2.0)) (expt d3 2.0)) (* 2.0 d1 d2))) 180.0) pi)
              )
      )
      (setq aint (- 360.0
                    (atof (rtos (if (< dd di)
                                  (+ 180.0 a1)
                                  (- 180.0 a1)
                                )
                                2
                                16
                          )
                    )
                )
      )
      (defun angular (dec)
        (setq signo (if (<= dec 0.0)
                        "-"
                        ""
                    )
        )
        (setq grad (fix (abs dec)))
        (setq minu (fix (* (- (abs dec) grad) 60.0)))
        (setq segu (* (- (* (- (abs dec) grad) 60.0) minu) 60.0))
        (if (< minu 10.0)
            (setq minu (strcat "0" (rtos minu 2 0)))
            (setq minu (rtos minu 2 0))
        )
        (if (< segu 10.0)
            (setq segs (strcat "0" (rtos segu 2 0)))
            (setq segs (rtos segu 2 0))
        )
        (strcat signo (rtos grad 2 0) (chr 176) minu "'" segs (chr 34))
      )
      (setq angu (angular aint))
      (setq a/2 (* pi (/ aint 360.0)))
      (entmake (list '(0 . "TEXT")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbText")
                    '(72 . 1)
                    '(73 . 2)
                    (cons 1 angu)
                    '(7 . "Angulos")
                    (cons 10 p2)
                    (cons 11 p2)
                    (cons 40 (getvar 'textsize))
                    '(41 . 0.5)
                    '(50 . 0.0)
              )
      )
      (setq conta (1+ conta))
  )
  (setvar "angdir" dir)
  (setvar "angbase" base)
  (setvar "osmode" osm)
  (princ)
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo

También existe la opción de subirlos a alguno de los depositorios gratuitos que los mantienen como un mes (no se como llamarlos) por ejemplo  http://www.4shared.com/. Yo propongo este porque me baja y sube muy rápido, pero hay montones.
Otro muy majo que es http://lolabits.es/, super rápido y que los mantiene un monton, pero cierra a final de marzo.

Un saludo

Hemos probado DROPBOX personal , es gratis y permite 2GB , de almacenaje.

Ver este hilo del foro

https://acadhispano.foroargentina.net/t14-donde-poner-nuestros-ficheros-imagenes-etc#86

gracias e logrado acotar los angulos internos pero quisirera que ayuden a modificar la etiquetar del numero de vertice de las manera que quede fuera del poligono y en direccion de la bisectriz del angulo interno

Pues hala, sube rutina y tipología de polígonos en dwg para ver si se puede hacer algo ...

Un saludo

Perdón, ya lo veo en el otro post, solo falta la tipología en dwg porque una cosa que valga para todo-todo llevaría muchas-muchísimas pruebas, lo de los ángulos es muy complejo determinar que es interior y que exterior.

En este post se indica como subir DWG y otros tipos de archivos


COMO SUBIR ARCHIVOS-FICHEROS

quisiera saber si hay alguna otra rutina que genere DIMANGULAR - acotado

Eduardo Celiz, por favor sube tu DWG, tal como lo hemos solicitado . Con un antes y un después. Recuerda que puedes hacerlo por DROPBOX .