acad hispano
¿Quieres reaccionar a este mensaje? Regístrate en el foro con unos pocos clics o inicia sesión para continuar.

ayuda con rutina

2 participantes

Ir abajo

ayuda con rutina Empty ayuda con rutina

Mensaje por mario198501 Vie Abr 07, 2017 6:57 pm

hola de nuevo acabo de encontrar esta rutina pero no funcina bien al parecer falla osnap activados y desactivados y no se como arreglarlo ayudenme por fabor

Código:
(defun C:Estribos () ;******************** (substxpos 4 2 (a b c)) = (a 4 c)

(defun substxpos (valor posicion lista / i caso L)
  (setq i 1)
  (foreach caso lista
     (if (/= i posicion)
        (setq L (cons caso L))
        (setq L (cons valor L))
     )
     (setq i (1+ i))
  )
  (reverse L)
)

;*****************

;;;

(setq PuntoIncial (getpoint "\nPunto inicial de columna:"))
(setq AcN (getdist "\nAncho de columna<0.25>:"))
(if (/= AcN nil) ()(setq AcN 0.25))
(setq Hv (getdist "\nAltura de viga<0.50>:"))
(if (/= Hv nil) ()(setq Hv 0.50))
(setq EspRec (getreal "\nEspesor de recubrimiento<0.05>:"))
(if (/= EspRec nil) ()(setq EspRec 0.05))
(setq PiLL (getpoint "\nPunto inicial de luz libre de viga:"))
(setq PfLL (getpoint "\nPunto final de luz libre de viga:"))



;;;

;;Hallando Lv, Lh, An

(setq Lh (- (car PfLL)(car PiLL)) )
;Lh: Longitud Horizonta de la luz libre

(setq Lv (- (car (cdr PfLL))(car (cdr PiLL))) )
;Lv: Longitud vertical de la luz libre

(setq An (angle PiLL PfLL))
;An: Angulo de inclinacion de la vigaen radianes
;;

;;; Hallando X1,Y1
(setq XY PuntoIncial)
;XY

(setq x1y1 (SUBSTXPOS (+ (nth 0 XY) AcN) 1 XY))
; Trabajando con X1

(setq x1y1 (SUBSTXPOS (- (nth 1 x1y1) EspRec) 2 x1y1))
; Trabajando con Y1

;;; Fin X1,Y1

;;Tomando distribucion de estribos

;;Fin de Tomando distribucion de estribos

;Hallando puntos:
;Pto1 = (X+Acn,Y-Hv)

(setq Pto1 (SUBSTXPOS (+ (nth 0 XY) AcN 0.001) 1 XY))
; Trabajando con Pto1x

(setq Pto1 (SUBSTXPOS (- (nth 1 Pto1) Hv) 2 Pto1))
; Trabajando con Pto1y

;Pto2 = (X+Acn+S1,Y+Lv)
(setq Pto2 (SUBSTXPOS (+ (nth 0 XY) AcN 0.001) 1 XY))
; Trabajando con Pto2x

(setq Pto2 (SUBSTXPOS (- (nth 1 Pto2) Lv) 2 Pto2))
; Trabajando con Pto2y

;Pto3 = (X+Lh+Acn-Sn*cosAn/2,Y+Lv)
(setq Pto3 (SUBSTXPOS (- (+ (nth 0 XY) Lh AcN) 0.001 ) 1 XY))
; Trabajando con Pto3x

(setq Pto3 (SUBSTXPOS (- (nth 1 Pto3) Lv) 2 Pto3))
; Trabajando con Pto3y

;Pto4 = (X+Lh/2,Y-Hv)
(setq Pto4 (SUBSTXPOS (- (+ (nth 0 XY) Lh Acn) 0.001) 1 XY))
; Trabajando con Pto4x

(setq Pto4 (SUBSTXPOS (- (nth 1 Pto4) Hv) 2 Pto4))
; Trabajando con Pto4y

;Ptomedio = (X1+Lh,Y1+Lv/2-e-X/2)
(setq X (sqrt (+ (expt (* (/ (sin An)(Cos An)) (- Hv (* 2 EspRec)) )2 )(expt (- Hv (* 2 EspRec)) 2))))

;Hallo X=Hv-2*EspRec

(setq Ptomedio (SUBSTXPOS (+ (nth 0 X1Y1) (/ Lh 2) ) 1 X1Y1))
; Trabajando con Pto1x

(setq Ptomedio (SUBSTXPOS (+ (- (nth 1 Ptomedio)  EspRec (/ X 2)) (/ Lv 2)) 2 Ptomedio))
; Trabajando con Pto1y

;;Puntos para iniciar el conteo de estribos
(setq ContPunIniEstrib x1y1)
;;


;; Inicio Rutina para dibujar estribos
  ;Tomando datos de letras:
   ;Guarda,  saca segu elem, busca asoc a 1, da la lista d ent, toma nombre, toma entidad
  (setq LetraEstr (cdr (assoc 1 (entget (car ( entsel "\nTomar indicación de los estribos" ))))))
     ;Bucle para para armar base de datos
      ;;Crear una nueva capa para los estribos
     (command "_layer"    "_M"    "VIGA ESTRIBOS"  "_C"    "141"  "" "_LW" "0.09"      ""             "" )
       ;Crea una nueva capa VIGA ESTRIBOS  
       ;;
       (setq contador 0)
       (setq Le 0.0)

       

            ( while (<= Le (/ Lh 2))      ;Busca una cifra distinta de cero en la misma columna
         (setq contador (+ contador 1))   ;Contador
            (IF (equal "," (substr LetraEstr (+ (* 8 contador)(- contador 1)) 1));Condición; 8*k+(k-1)
         



         (progn ;;Si si "," = var
           (setq NroEst (atof (substr LetraEstr (+ (* 8 contador)(- contador 1) 2) 1) )) ;Tomo 8*k+(k-1)+2, Nro de estribos
           (setq SnEst (atof (substr LetraEstr (+ (* 8 contador)(- contador 1) 4) 4) ))  ;Tomo 8*k+(k-1)+4, Separacion de estribos Sn
           (setq ContNroEst 1)                                                           ;Cuenta el numero de estribos
           
           (while (if (> Le (/ Lh 2)) nil ( progn (if (> ContNroEst NroEst) nil T)))     ;Ini While xxx Terminar si Le>Lh/2 ó ContNroEst > NroEstr
              (progn                                                                     ;Ini Contenido While
           (setq ContPunIniEstrib (SUBSTXPOS (+ (nth 0 ContPunIniEstrib) (* (cos An) SnEst)) 1 ContPunIniEstrib))        ; Trabajando con x del inico de cada estribo (punto superior del estribo)
           (setq ContPunIniEstrib (SUBSTXPOS (+ (nth 1 ContPunIniEstrib) (* (sin An) SnEst)) 2 ContPunIniEstrib))        ; Trabajando con x del inico de cada estribo (punto superior del estribo)
                 (setq Le (- (nth 0 ContPunIniEstrib) (nth 0 x1y1)))                                                     ;Hallo el nuevo Le
                 (if (> Lh Le)
              (progn;ini si si
                 (setq X (sqrt (+ (expt (* (/ (sin An)(Cos An)) (- Hv (* 2 EspRec)) )2 )(expt (- Hv (* 2 EspRec)) 2))))  ;Hest=Hv-e*2; X=((tng(An)*Hest)^2+(Hest)^2)^0.5
                 (setq ContPunIniEstriby ContPunIniEstrib)
                 (setq ContPunFinEstrib (SUBSTXPOS (- (nth 1 ContPunIniEstriby) X) 2 ContPunIniEstriby))                 ;punto inferior de inserción del estribo
                 (setq ContPunIniEstriby ContPunIniEstrib)
                 (command "_line" ContPunIniEstrib ContPunFinEstrib "")                                                  ;Dibujar estribo
               );Fin si si
              )
                (setq ContNroEst (+ ContNroEst 1))
               );Fin contenido while
             );Fin While xxx
           
           );;Fin Si si "," = var
         



         ( progn ;;Si no "-" = var
                                                                                          ;Aqui el numero de estrinos es indefinido en función a Lh/2
           (setq SnEst (atof (substr LetraEstr (+ (* 8 contador)(- contador 1) 8) 4) ))   ;Tomo 8*k+(k-1)+8, Separacion de estribos Sn
           (setq ContNroEst 0.0)

            (while (if (> Le (/ Lh 2)) nil T)                                             ;Terminar si Le > Lh/2
               (progn                                                                     ;Ini Contenido While
           (setq ContPunIniEstrib (SUBSTXPOS (+ (nth 0 ContPunIniEstrib) (* (cos An) SnEst)) 1 ContPunIniEstrib))        ; Trabajando con x del inico de cada estribo (punto superior del estribo)
           (setq ContPunIniEstrib (SUBSTXPOS (+ (nth 1 ContPunIniEstrib) (* (sin An) SnEst)) 2 ContPunIniEstrib))        ; Trabajando con x del inico de cada estribo (punto superior del estribo)
                 (setq Le (- (nth 0 ContPunIniEstrib) (nth 0 x1y1)))                                                     ;Hallo el nuevo Le
                 (if (> Lh Le)
              (progn;ini si si
                 (setq X (sqrt (+ (expt (* (/ (sin An)(Cos An)) (- Hv (* 2 EspRec)) )2 )(expt (- Hv (* 2 EspRec)) 2))))  ;Hest=Hv-e*2; X=((tng(An)*Hest)^2+(Hest)^2)^0.5
                 (setq ContPunIniEstriby ContPunIniEstrib)
                 (setq ContPunFinEstrib (SUBSTXPOS (- (nth 1 ContPunIniEstriby) X) 2 ContPunIniEstriby))                 ;punto inferior de inserción del estribo
                 (setq ContPunIniEstriby ContPunIniEstrib)
                 (command "_line" ContPunIniEstrib ContPunFinEstrib "")                                                  ;Dibujar estribo
               );Fin si si
              )
                (setq ContNroEst (+ ContNroEst 1))
               );Fin contenido while
            )
          )
        )
                     
       );Fin de While

     ;Fin Bucle para para armar base de datos
  ;Fin de tomando datos
;; Fin  Rutina para dibujar estribos

;;;Tomando estrivos, rotandolos y copiandolos

(command "_Rotate" "_wp" pto1 pto2 pto3 pto4 "" "" ptomedio "_copy" 180 "")


;wp es uno de los tipos de captura y otro C

;Pt1,pt2,pt3,pt4 son los puntos del poligono que agarra los elementos llenos, ptmedio el eje de jiro
;;;Fin Tomando estrivos, rotandolos y copiandolos


)




Última edición por mario198501 el Mar Jun 06, 2017 5:38 pm, editado 3 veces (Razón : Poner el código como Código)

mario198501

Mensajes : 13
Fecha de inscripción : 18/11/2016

Volver arriba Ir abajo

ayuda con rutina Empty Adjuntar el DWG

Mensaje por devitg Dom Abr 09, 2017 12:42 am

Me imagino y/o adivino que el LISP lo aplicas en un DWG ya hecho . Te ruego envíes o adjuntes el mismo . lo puedes hacer a mi dirección


Última edición por Admin el Dom Abr 09, 2017 12:45 am, editado 1 vez (Razón : borrar lo inecesario)

devitg
Admin

Mensajes : 257
Fecha de inscripción : 16/03/2016
Edad : 75
Localización : CORDOBA ARGENTINA

https://acadhispano.foroargentina.net

Volver arriba Ir abajo

ayuda con rutina Empty Re: ayuda con rutina

Mensaje por mario198501 Mar Abr 11, 2017 7:17 am

ya lo mando entonces

mario198501

Mensajes : 13
Fecha de inscripción : 18/11/2016

Volver arriba Ir abajo

ayuda con rutina Empty Re: ayuda con rutina

Mensaje por mario198501 Vie Abr 14, 2017 5:01 pm

?
con este texto debe funcionar
Ø3/8'' , 3@0.05 , 4@0.10 , 3@0.15 - Resto@0.20m es un txt

no puedo cargar mi archivo ejeemplo en .dwg en .zip

mario198501

Mensajes : 13
Fecha de inscripción : 18/11/2016

Volver arriba Ir abajo

ayuda con rutina Empty Re: ayuda con rutina

Mensaje por mario198501 Mar Jun 06, 2017 6:12 pm

alguna opinion....de tiempo je

mario198501

Mensajes : 13
Fecha de inscripción : 18/11/2016

Volver arriba Ir abajo

ayuda con rutina Empty Re: ayuda con rutina

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba

- Temas similares

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