AYUDA A MODIFICAR LISP
4 participantes
Página 1 de 1.
AYUDA A MODIFICAR LISP
- 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
Re: AYUDA A MODIFICAR LISP
PREGUNTO ¡¡¡
El polígono lo construyes con un boundary, es decir dejas que autocad elija el principio 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
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:") "")
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 : 182
Fecha de inscripción : 17/03/2016
Re: AYUDA A MODIFICAR LISP
Principalmente el DWG , no por repetido, deja de ser cierto.
ACAD no maneja imágenes .
ACAD no maneja imágenes .
Re: AYUDA A MODIFICAR LISP
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
Re: AYUDA A MODIFICAR LISP
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
Dominguez- Mensajes : 152
Fecha de inscripción : 20/03/2016
Edad : 74
Localización : Zaragoza (España)
Temas similares
» Ayuda para modificar una rutina lisp
» Ayuda para modificar una rutina
» Ayuda con un lisp
» AYUDA LISP NO CORRE
» AYUDA con LISP CENTROIDE
» Ayuda para modificar una rutina
» Ayuda con un lisp
» AYUDA LISP NO CORRE
» AYUDA con LISP CENTROIDE
Página 1 de 1.
Permisos de este foro:
No puedes responder a temas en este foro.
|
|