AYUDA A MODIFICAR LISP

Ver el tema anterior Ver el tema siguiente Ir abajo

AYUDA A MODIFICAR LISP

Mensaje por eduardoceliz el Sáb Abr 02, 2016 4:41 am

Código:
(defun rad_sex1 (g / g1 g2 g3)
   (setq g (* 180 (/ g pi))
         g1 (fix g)
         g2 (fix (* 60 (- g g1)))
         g3 (* 3600 (- g g1 (/ g2 60.0)))
   )
   (if (> 0.0001 (abs (- g3 60))) (setq g3 (- g3 60) g2 (1+ g2)))
   (if (> 0.0001 (abs (- g2 60))) (setq g2 (- g2 60) g1 (1+ g1)))
      
   (if (< g3 9.5) (setq g3 (strcat "0" (rtos g3 2 0))) (setq g3 (rtos g3 2 0)))
   (if (< g2 10) (setq g2 (strcat "0" (rtos g2 2 0))) (setq g2 (rtos g2 2 0)))
   (strcat (itoa g1) "°" g2 "'" g3 "''")
)
;_____
(defun azim2 (a b / c dx dy)
  (setq dx (- (cadr a) (cadr b))
 dy (- (car a) (car b))
  )
  (cond ((> 10e-7 (abs dy))
         (if (> dx 0)  (setq c 0)
                      (setq c pi)
         )
        )
        (T (if (> dy 0) (setq c (atan dy dx))
                        (setq c (+ (atan dy dx) (* 2 pi)))
           )        
        )
  )
  (setq lado (sqrt (+ (* dx dx) (* dy dy))))
  ;(princ "\ndx = ")(princ (* dx dx))(princ " - dy = ")(princ dy)
  c
)
 ;_____
(defun hace_lista (/ p0)
  (foreach p0 (entget (entlast))
           (if (= 10 (car p0))
       (setq lista (cons (cdr p0) lista))
   )
  )
  ;(auxiliar)
  (setq lista (cons (last lista) lista)
 lista (cons (nth (- (length lista) 2) lista) lista)
  )
  ;
)  
;_____
(defun hace_angulo (/ u w1 w2 w3)
  (setq u 0)
  (while (< (setq u (1+ u)) (1- (length lista)))
 (setq w1 (azim2 (nth (1- u) lista) (nth u lista))
       w2 (azim2 (nth (1+ u) lista) (nth u lista))
       w3 (- w2 w1)
 )
 (if (< w3 0) (setq w3 (+ w3 (* 2 pi))))
                 (auxiliar)
 (setq w3 (rad_sex1 w3)
                       lista2 (cons (list (itoa u)
  (strcat (itoa u) "-" (if (< u (- (length lista) 2)) (itoa (1+ u)) "1"))
  (rtos lado 2 2)
  w3
  (rtos (car (nth u lista)) 2 2)
  (rtos (cadr (nth u lista)) 2 2)
    )
    lista2
       )
 )
   )
  
)          
;_____
(defun auxiliar (/ v w dux duy)
  (setq v -8
        w (+ w1 (/ w3 2) pi)
  )
  (if (> w (* 2 pi)) (setq w (- w (* 2 pi))))
  ;(princ "\nw = ")(princ v)
  (setq dux (* v (cos w))
 duy (* v (sin w))
  )
  (command "text" "j" "mc" (list (+ duy (car (nth u lista))) (+ dux (cadr (nth u lista)))) 5 0 (itoa u))
)
;_____
(defun c:ag2 (/ alt_txt i p lista lado lista2)

  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "aunits" 3)
  (setvar "angbase" 0)
  (setvar "angdir" 0)
  (setvar "osmode" 0)
  ;(princ "\nLista = ")(princ (entlast))

  (setq p (entlast)
 i (command "boundary" (getpoint "\nPicar punto dentro del polígono:") "")
  )
  (if (not (equal p (entlast)))
      (progn (setq alt_txt 4)
     (hace_lista)
             (command "erase" (entlast) "")
             (hace_angulo)
             (sct4)
      )
  )
  (princ "\nLista2 = ")(princ lista2)
  (princ)

)





HOLA LO QUE QUIERO HACER ES QUE EMPIECE A ENUMERAR DE ACUERDO AL TRAZADO DEL POLÍGONO EN LA IMAGEN SE VE EN EL PRIMER VÉRTICE EL NUMERO 7 LO CUAL NO CORRESPONDE YA QUE ES EL 1 QUISIERA QUE ME AYUDEN A REALIZAR ESTA MODIFICACIÓN

eduardoceliz

Mensajes : 20
Fecha de inscripción : 29/03/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: AYUDA A MODIFICAR LISP

Mensaje por nolo el Sáb Abr 02, 2016 6:22 pm

PREGUNTO ¡¡¡
El polígono lo construyes con un boundary, es decir dejas que autocad elija el principio de la polilinea

Código:
(command "boundary" (getpoint "\nPicar punto dentro del polígono:") "")
Que criterio se puede utilizar para localizar el punto uno de los vértices de la polilinea ????

Yo tengo alguna rutina por ahí de numerar polígono, pero parte de la polilinea ya hecha y pido picar cerca del vertice nº 1.
Te valdría añadir picar punto cercano al vértice nº1 ????
También eta lo de numerar de izquierda a derecha o al revés, se pregunta el sentido o se toma un punto de selección sobre la polilinea para buscar el sentido del siguiente punto ???

Un poquito +, un poquito + de datos
Un saludo

nolo

Mensajes : 98
Fecha de inscripción : 17/03/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: AYUDA A MODIFICAR LISP

Mensaje por Admin el Sáb Abr 02, 2016 9:14 pm

Principalmente el DWG , no por repetido, deja de ser cierto.

ACAD no maneja imágenes .

Admin
Admin

Mensajes : 124
Fecha de inscripción : 16/03/2016
Edad : 68
Localización : CORDOBA ARGENTINA

Ver perfil de usuario http://acadhispano.foroargentina.net

Volver arriba Ir abajo

Re: AYUDA A MODIFICAR LISP

Mensaje por eduardoceliz el Dom Abr 03, 2016 5:35 am

el boundary era el problema  lo quite y se soluciono tomando el poligono como entidad ya quedo solucionado

eduardoceliz

Mensajes : 20
Fecha de inscripción : 29/03/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: AYUDA A MODIFICAR LISP

Mensaje por Dominguez el Vie Jun 24, 2016 12:34 pm

Esta rutina coloca el inicio de una polilinea en el vertice que desee el usuario ademas del sentido de avance.
Código:
 ; Coloca el inicio de una polilinea, en el vertice designado, y el sentido de crecimiento.
;Luis Dominguez Gomez ©2013
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun c:ini_pol (/ p_ini e_ana poli tipo e_data l_vert l2 l1 i x y x_cg y_cg pc var01 comp p1 p2 an di an_ref px senti
                  l_name_act osnap_act l_name_ent color_ant
                )
  (setvar 'cmdecho 0)
  (setq l_vert nil)
  (setq l1 nil)
  (setq l2 nil)
  (setq x 0)
  (setq y 0)
  (setq i 0)
  (setq l_name_act (getvar 'clayer))
  (setq osnap_act (getvar 'osmode))
  (while (= (and (/= e_ana nil) (= tipo "LWPOLYLINE")) nil)
      (setvar 'osmode 1)
      (while (= (setq p_ini (getpoint "\nUbica el inicio de la Polilinea: ")) nil))
      (setvar 'osmode 0)
      (setq p_ini (list (car p_ini) (cadr p_ini)))
      (if (/= (ssget p_ini) nil)
        (progn (setq poli (ssget p_ini))
                (setq e_ana (ssname (ssget p_ini) 0))
                (setq tipo (cdr (assoc 0 (entget (ssname poli 0)))))
        )
      )
      (if (= tipo "POLYLINE")
        (progn (command "_convertpoly" "_L" poli "")
                (setq poli (ssget p_ini))
                (setq tipo (cdr (assoc 0 (entget (ssname poli 0)))))
        )
      )
      (if (/= tipo "LWPOLYLINE")
        (princ "\nEl Objeto seleccionado no es LWPOLYLINE")
      )
  )
  (setq poli (ssget p_ini))
  (setq e_data (entget e_ana))
  (setq l_name_ent (cdr (assoc 8 e_data)))
  (foreach temp e_data
      (if (= (car temp) 10)
        (setq l_vert (append l_vert (list (cdr temp))))
      )
  )
  (setq l2 (member p_ini l_vert))
  (repeat (- (length l_vert) (length l2)) (setq l1 (append l1 (list (nth i l_vert)))) (setq i (1+ i)))
  (if (/= l1 nil)
      (setq l_vert (append l2 l1))
      (setq l_vert l2)
  )
  (setq i 0)
  (foreach temp l_vert (setq x (+ x (car temp))) (setq y (+ y (cadr temp))) (setq i (1+ i)))
  (setq x_cg (/ x i))
  (setq y_cg (/ y i))
  (setq pc (list x_cg y_cg))
  (setq var01 (car l_vert))
  (setq comp (list var01))
  (foreach temp (cdr l_vert)
      (if (> (distance var01 temp) 0.01)
        (setq comp (append comp (list temp)))
      )
      (setq var01 temp)
  )
  (setq l_vert comp)
  (setq color_ant (getvar 'cecolor))
  (setq p1 (nth 0 l_vert))
  (setq p2 (nth 1 l_vert))
  (setq an (angle p1 p2))
  (setq di (distance p1 p2))
  (setq an_ref (angle pc p1))
  (setq p1 (polar p1 an_ref (* 0.4 di)))
  (setvar 'cecolor "3")
  (setq px (polar p1 an (* 0.8 di)))
  (command "_PLINE" p1 px "_w" (* 0.1 di) 0 (polar px an (* 0.2 di)) "")
  (initget "S s n N")
  (setq senti (getkword "\nEs correcto el Sentido (S/N)<S>: "))
  (if (= senti nil)
      (setq senti "S")
  )
  (cond ((or (= senti "N") (= senti "n"))
          (setq l_vert (append (list (nth 0 l_vert)) (reverse (cdr l_vert))))
        )
        (t senti)
  )
  (setvar 'cecolor color_ant)
  (entdel (entlast))
  (setvar 'clayer l_name_ent)
  (command "_PLINE")
  (foreach temp l_vert (command temp))
  (command "_c")
  (entdel e_ana)
  (setvar 'clayer l_name_act)
  (setvar 'osmode osnap_act)
  (prin1)
)
;;;oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
Saludos

Dominguez

Mensajes : 48
Fecha de inscripción : 20/03/2016
Edad : 66
Localización : Zaragoza (España)

Ver perfil de usuario

Volver arriba Ir abajo

Re: AYUDA A MODIFICAR LISP

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.