;;;                                                                      ;;;
;;; Autor : Laudemir Reis                                                ;;;
;;; Fone  : 17 - 99653-2793                                              ;;;
;;; Programador em AutoLISP                                              ;;;
;;;                                                                      ;;;
;;; E:mail -  laudemir.reis@gmail.com                                    ;;;
;;;                                                                      ;;;
;;; Ver. 1.0    -  04/2022   Rotinas diversas                            ;;;
;;;                                                                      ;;;
;;; COMANDO PARA CRIAR LINHAS DE QUADROS PARA CURRAIS                    ;;;
;;;                                                                      ;;;

;====================================================================================
;COMANDO VIA (LINE-COMMAND)               
(DEFUN C:QF() 
  (IF (= #PREEN-CF NIL) (PROGN (#Preencher_CF)    (SETQ #PREEN-CF T) ))
  (IF (= #SISTM-CF NIL) (PROGN (#CF_#Confg_System_Metrico)    (SETQ #SISTM-CF T) ))
  (#Quadrados_Filas)
)
;====================================================================================

;====================================================================================
; CARREGA A CAIXA DE DIGALOGO BOX   PELO OPEN.DCL.
(defun c:OQF()
  (command "_OPENDCL")                      ; CARREGA O DCL .ARX 
  (dcl_project_load "Y:\\OPEN.DCL\\CUR" t)  ; CARREGA O ARQUIVO CUR.DCL 
  (dcl_form_show CUR_form1)(PRINC)          ; ATIVA O DCL
)
;====================================================================================

;=====================================================================================
; BOTÃO INICIAR AS CAIXAS (QUADRADOS) FILAS                                          .
(defun c:CUR/Form1/TextButton1#OnClicked (/); <= When clicked on the [Done...]       .
  (#Get-texts-boxs)                         ; <= gets (dcl-Control-GetText )         .
  (dcl_form_close  CUR_form1)(PRINC)        ; <= closing the DCL  **************     .
  (#Quadrados_Filas)                        ; <= load the function (#Quadrados_Filas).
)
;====================================================================================

;====================================================================================
; FUNÇÃO PARA PREENCHIMENTO DO DCL. (OPEN.DCL)                         .
(defun #Preencher_CF()
    (if (= (type #CF_Qtd_Cur) 'Real )(setq #CF_Qtd_Cur (rtoi #CF_Qtd_Cur)))
    (if (= (type #CF_Qtd_Lin) 'Real )(setq #CF_Qtd_Lin (rtoi #CF_Qtd_Lin)))
    (SETQ #CF_Com_Cur (xget "\nComprimento do Curral............................(m) : " #CF_Com_Cur 2))
    (SETQ #CF_Lar_Cur (xget "\nLargura do Curral................................(m) : " #CF_Lar_Cur 2))
    (SETQ #CF_Qtd_Cur (xget "\nQtde Curral por Linha...........................(un) : " #CF_Qtd_Cur 3))
    (SETQ #CF_Qtd_Lin (xget "\nQtde Linhas.....................................(un) : " #CF_Qtd_Lin 3))
    (SETQ #CF_Esp_Lin (xget "\nEspaçamento entre Linhas currais.................(m) : " #CF_Esp_Lin 2)) 
)
;====================================================================================

;====================================================================================
; função que cria a fila de quadrados                     .
(DEFUN #Quadrados_Filas (/ #CF_Pot_Ini #CF-OSM  #CF-OSM #p1 #p2 #p3 DIST# #tXT )    
    (setq #CF_Pot_Ini (getpoint "\nEntre com o ponto" ))
    (SETQ #CF-OSM (GETVAR "OSMODE"))      (setvar "osmode" 0 )  
    (SETQ #SSG (SSADD )  #p1 #CF_Pot_Ini) 
      (repeat (rtoi #CF_Qtd_Cur)         
          (SETQ #p2 (#PTCAR #p1  #CF_Lar_Cur 1  #CF_Com_Cur 1))
          (SETQ #p3 (#PTCAR #p1  #CF_Lar_Cur 1  0 0))	
          (VL-CMDF "RECTANGLE" #p1  #p2) ;;;;;;     <<<<<<<<<<=====  (problem here in this line)                                                  .
                                                                  ;  whenever the command is found (vl-cmdf xxx) the stream loads Open.Dcl again, .
                                                                  ;  without finishing the command's purpose				          .
	  (SSADD (ENTLAST) #SSG)
	  (setq #p1 #p3)
     )     
        ;------------------------------linhas                     .
           (SETQ DIST# (+ #CF_Com_Cur   #CF_Esp_Lin))
	   (SETQ #tXT (STRCAT "@" (RTOS DIST# 2 2 ) "<180"))
 	   (repeat (rtoi #CF_Qtd_Lin)
                (VL-CMDF "COPY" #SSG "" #CF_Pot_Ini #tXT "" )	          
                (SETQ DIST# (+ DIST# (+ #CF_Com_Cur   #CF_Esp_Lin)))
  	        (SETQ #tXT (STRCAT "@" (RTOS DIST# 2 2 ) "<180"))
           )
)
;====================================================================================

;====================================================================================
; FUNÇÃO  (CAR)+- (CADR)+-  POINT                        .
(defun #PTCAR ( #ponto #Vr_X #Op_X #Vr_Y #Op_Y)
   (if (= #Op_X 0) (setq #Op_X "-") (setq #Op_X "+"))
   (if (= #Op_Y 0) (setq #Op_Y "-") (setq #Op_Y "+"))
   (setq #PTCAR_prox (list   ( (eval (read #Op_X)) (car #ponto) #Vr_X )( (eval (read #Op_Y)) (cadr #ponto) #Vr_Y )))
)
;====================================================================================

;====================================================================================
; FUNÇÃO INICIALIZA VARIAVEIS DO SISTEMA              .
(DEFUN #CF_#Confg_System_Metrico ()
   (PRINC "\nIniciando Modificado variaveis do sistema Desedentação Animal..[  ] ")                                                                                                                                                         (SETQ  #Cod_Erro_PjCad         "DSA.001.0001" )
   (vl-cmdf "_cmdecho" 0)(vl-cmdf "_UCS" "W")(vl-cmdf "_PLAN" "W" )(princ)                           ;;; wcs e PLAN ATIVOS
   (if (/= (getvar "insunits")      6) (progn (setq mod_insunits    6)   (vl-cmdf "_insunits"  6)))                    ;;; Unidade metrica medida
   (if (/= (getvar "MBUTTONPAN")    1) (progn (setq mod_MBUTTONPAN  1)   (vl-cmdf "_MBUTTONPAN"  1)))                  ;;; controla mouse para Netscrool como PAN
   (if (/= (getvar "MEASUREMENT")   1) (progn (setq mod_MEASUREMENT 1)   (vl-cmdf "_MEASUREMENT" 1)))                  ;;; Sistema metrico
   (if (/= (getvar "INSUNITSDEFSOURCE") 6) (progn (setq mod_INSUNITSDEFSOURCE 6)   (vl-cmdf "_INSUNITSDEFSOURCE" 6)))  ;;; Insert em metros
   (if (/= (getvar "INSUNITSDEFTARGET") 6) (progn (setq mod_INSUNITSDEFTARGET  6)   (vl-cmdf "_INSUNITSDEFTARGET" 6))) ;;; Força bloco em metros
                                                                                                                                              (SETQ  #Cod_Erro_PjCad         "DSA.001.0002" )
   (if (/= (getvar "AUNITS") 0) (progn (setq mod_AUNITS      0)   (SETVAR "AUNITS" 0)))                         ;;; Unidade para angulos (0 = Decimal)
   (if (/= (getvar "ANGDIR") 1) (progn (setq mod_ANGDIR      0)   (SETVAR "ANGDIR" 1)))                         ;;; Rotação Sentido (1 = S.horario)
   (if (/= (getvar "LUPREC") 2) (progn (setq mod_LUPREC      2)   (SETVAR "LUPREC" 2)))                         ;;; Medidas com 2 casas Decimais
   (if (/= (getvar "LUNITS") 2) (progn (setq mod_LUNITS      2)   (SETVAR "LUNITS" 2)))                         ;;; Sistema linear (2 = decimal)
   (if (/= (getvar "AUPREC") 2) (progn (setq mod_AUPREC      2)   (SETVAR "AUPREC" 2)))                         ;;; Casa decimal angulo 2 casas
   (if (/= (getvar "DIMDEC") 2) (progn (setq mod_DIMDEC      2)   (SETVAR "DIMDEC" 2)))                         ;;; medidas com 2 casas Decimais
   (if (/= (getvar "ATTREQ") 1) (progn (setq mod_ATTREQ  1) (SETVAR "ATTREQ" 1)))                               ;;; Força o comando insert a fazer perguntas se existir Att 
   (if (/= (getvar "ATTDIA") 0) (progn (setq mod_ATTDIA  0) (SETVAR "ATTDIA" 0)))                               ;;; Ao abrir arquivo abre um caixa dialogo
   (if (/= (getvar "OSNAPZ") 1) (progn (setq mod_OSNAPZ  1) (SETVAR "OSNAPZ" 1)))                               ;;; Toda entidade criada é forçada no Z=0
   (if (/= (getvar "ANGBASE") (/ PI 2) )(progn (setq mod_ANGBASE (/ PI 2) )(SETVAR "ANGBASE" (/ PI 2) ))) (princ)    ;;; Angulo base para Norte.
   (if (/= (getvar "ANGBASE") (/ PI 2) )(progn (setq mod_ANGBASE (/ PI 2) )(SETVAR "ANGBASE" (/ PI 2) ))) (princ)    ;;; Angulo base para Norte.
                                                                                                                    (SETQ  #Cod_Erro_PjCad         "DSA.001.0003" )
   (PRINC "\rIniciando Modificado variaveis do sistema Desedentação Animal..[ok] ")
)
;====================================================================================

;====================================================================================
; INICIALIZA E PREENCHE OS TEXTBOX EM CADA LINHA                                    .
(defun c:CUR/Form1#OnInitialize (/)
   (dcl-Control-SetText CUR/Form1/TextBox1  (RTOS #CF_Com_Cur  2 1))
   (dcl-Control-SetText CUR/Form1/TextBox2  (RTOS #CF_Lar_Cur  2 1))
   (dcl-Control-SetText CUR/Form1/TextBox3  (RTOS #CF_Qtd_Cur  2 1))
   (dcl-Control-SetText CUR/Form1/TextBox4  (RTOS #CF_Qtd_Lin  2 1))
   (dcl-Control-SetText CUR/Form1/TextBox5  (RTOS #CF_Esp_Lin  2 1))
  )
;====================================================================================

;====================================================================================
; CARREGA VARIAVES BOX                                          .
(defun #Get-texts-boxs ()
 (setq #CF_Com_Cur  (ATOF (dcl-Control-GetText  CUR/Form1/TextBox1 )))
 (setq #CF_Lar_Cur  (ATOF (dcl-Control-GetText  CUR/Form1/TextBox2 )))
 (setq #CF_Qtd_Cur  (ATOF (dcl-Control-GetText  CUR/Form1/TextBox3 )))
 (setq #CF_Qtd_Lin  (ATOF (dcl-Control-GetText  CUR/Form1/TextBox4 )))
 (setq #CF_Esp_Lin  (ATOF (dcl-Control-GetText  CUR/Form1/TextBox5 )))
)
;====================================================================================

;====================================================================================
(DEFUN RTOI ( #NUM)    (SETQ #NUM (FIX #NUM))    #NUM )
;====================================================================================
;;; Autor : Laudemir Reis
;;; GET multiplo
;;; xtxt = o texto a ser exibido "pergunta ao usuario"    
;;; xvar = a Variável - Texto, Real, inteiro ou Distância 
;;; nr   = numero inteiro que representa os GETS          
;;;        0 = string porem quando digita espaço = enter  
;;;        1 = string espaço = espaço                     
;;;        2 = Real                                       
;;;        3 = inteiro                                    
;;;        4 = getdist                                    
;;;        5 = getangle                                   
(DEFUN XGET ( #Strng #XVar #Num / #ResLets) (setq fac 57.2957914331)
      (IF  (= #XVar NIL)  (SETQ #XVar ""))
  (if (or (= #XVar nil)(= #XVar "") )
     (progn
         (if (= #Num 0) (setq #ResLets (getstring    #Strng)))
         (if (= #Num 1) (setq #ResLets (getstring t  #Strng)))
         (if (= #Num 2) (setq #ResLets (getreal      #Strng)))
         (if (= #Num 3) (setq #ResLets (getint       #Strng)))
         (if (= #Num 4) (setq #ResLets (getdist      #Strng)))
         (if (= #Num 5) (setq #ResLets (getangle     #Strng)))
      )(progn
         (setq #XVar-olds #XVar)
         (if (= #Num 0) (setq #Strng (strcat #Strng " << " #XVar " >> ")        #ResLets (getstring      #Strng)))
         (if (= #Num 1) (setq #Strng (strcat #Strng " << " #XVar " >> ")        #ResLets (getstring t    #Strng)))
         (if (= #Num 2) (setq #Strng (strcat #Strng " << " (rtos #XVar) " >> ") #ResLets (getreal        #Strng)))
         (if (= #Num 3) (setq #Strng (strcat #Strng " << " (itoa #XVar) " >> ") #ResLets (getint         #Strng)))
         (if (= #Num 4) (setq #Strng (strcat #Strng " << " (rtos #XVar) " >> ") #ResLets (getdist        #Strng)))
         (if (= #Num 5) (setq #Strng (strcat #Strng " << " (rtos (* #XVar fac)) " >> ") #ResLets (getangle   #Strng)))

         (if (or (= #ResLets nil)(= #ResLets "") )(setq #ResLets #XVar-olds))
  ))

        (if (OR  (= #Num 0) (= #Num 1))(setq #ResLets (strcase #ResLets) txtpal #ResLets))
        #ResLets
)
;====================================================================================

