Hi, how are you
REPLACE SOME OF MY LINES WITH LISP FORUM THAT SENT ME BUT HAVE NOT WANT WHAT I WANT TO GET TO KNOW ME IF YOU CAN PLEASE AMEND
(defun folder1 (a / cm cn)
;Dimensiones necesarias para la image_tile: Ancho:15; Altura: 15
(setq cm 15 cn 0)
(start_image a)
(foreach x '(
( 252 251 251 251 251 251 251 251 251 251 252 9 9 9 9 9)
( 250 253 253 253 253 253 253 253 253 252 251 9 9 9 9 9)
( 250 251 253 253 253 253 253 253 253 253 252 251 9 9 9 9)
( 250 250 253 9 9 9 253 253 253 253 253 250 8 9 9 9)
( 250 253 8 251 251 251 9 9 9 9 9 253 251 9 9 9)
( 250 253 253 253 253 252 250 250 250 250 250 250 252 9 9 9)
( 250 253 253 253 253 253 253 253 253 252 251 9 9 9 9 9)
( 250 254 254 254 254 9 250 250 250 250 252 9 9 9 9 9)
( 8 250 250 250 250 252 9 9 9 9 9 9 9 9 9 9)
( 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9)
( 9 9 9 9 9 18 18 18 9 9 18 18 18 18 9 9)
( 9 9 9 9 9 18 7 18 9 18 7 7 7 9 18 9)
( 9 9 9 9 9 18 7 18 18 7 7 7 7 7 7 18)
( 9 9 9 9 9 18 7 18 18 7 7 7 7 7 7 18)
( 9 9 9 9 9 18 7 18 9 18 9 7 7 7 18 9)
( 9 9 9 9 9 18 18 18 9 9 18 18 18 18 9 9)
)
(foreach y x (apply 'fill_image (list cn cm 1 1 y)) (setq cn (1+ cn)))
(setq cm (1- cm) cn 0)
)
(end_image)
)
(defun seleccionate (a / cm cn)
;Dimensiones necesarias para la image_tile: Ancho:15; Altura: 15
(setq cm 15 cn 0)
(start_image a)
(foreach x '(
( 9 9 9 9 250 251 251 251 251 251 251 251 251 251 251 251)
( 9 9 9 9 250 9 9 9 9 9 253 9 9 9 253 251)
( 9 9 9 9 250 254 254 254 254 145 159 254 254 254 9 251)
( 9 9 9 9 250 9 9 9 155 159 159 167 9 9 253 251)
( 9 9 9 9 9 9 9 157 177 156 169 159 253 9 253 251)
( 18 18 18 18 18 18 253 253 9 156 159 156 167 254 253 251)
( 18 7 7 7 7 18 253 253 253 148 177 253 253 253 253 251)
( 18 18 18 18 18 18 253 253 157 148 153 253 253 253 253 251)
( 9 9 18 18 9 253 253 145 156 177 253 253 253 253 252 251)
( 9 18 7 7 18 9 177 156 167 253 253 253 253 253 252 251)
( 18 9 7 7 7 18 252 253 253 253 253 253 253 253 252 251)
( 18 7 7 7 7 18 9 252 251 251 251 251 252 9 253 251)
( 18 7 7 7 7 18 9 251 7 7 7 254 251 250 250 252)
( 18 7 7 7 9 18 7 252 251 251 251 251 252 7 7 7)
( 9 18 7 7 18 9 9 9 9 9 9 9 9 9 9 9)
( 9 9 18 18 9 9 9 9 9 9 9 9 9 9 9 9)
)
(foreach y x (apply 'fill_image (list cn cm 1 1 y)) (setq cn (1+ cn)))
(setq cm (1- cm) cn 0)
)
(end_image)
)
(defun var (blist / m) (setq alcup nil racup nil)
(vl-load-com)
(defun alex(pa pb)
(cond
((> pa pb)t)
((= pa pb )t)
(t nil)
))
(foreach m blist
(while (and racup(alex m(car racup)))(setq alcup(cons(car racup)alcup)racup(cdr racup)))
(while (and alcup(alex(car alcup)m))(setq racup(cons(car alcup)racup)alcup(cdr alcup)))
(setq racup(cons m racup))
)
(append(reverse alcup)racup)
)
(defun saveVars()
(setq esc1 (get_tile "esc1"))
(setq esd1(atoi(get_tile "ess1")))
(setq esd2(atoi(get_tile "ess2")))
(setq esd3(atoi(get_tile "ess3")))
(setq esd4(atoi(get_tile "ess4")))
(setq esd5(atoi(get_tile "ess5")))
(setq blkList(list)) ;;;--- Setup a list to hold the selected items
(setq ignlist(get_tile "bloqlist")) ;;;--- Save the list setting
(setq count 1) ;;;--- Setup a variable to run through the list
;;;--- Cycle through the list getting all of the selected items
(while (setq fila (read ignlist))
(setq blkList(append blkList (list (nth fila bloList))))
(while
(and
(/= " " (substr ignlist count 1))
(/= "" (substr ignlist count 1))
)
(setq count (1+ count))
)
(setq ignlist (substr ignlist count))
)
)
(defun blokinf ()
(setq bloList(list)) ;;;--- Set up an empty list
(if (findfile "1-DWG-TOMACORRIENTES.txt") ;;;--- Open the text file
(progn
(if (setq ruta(open (findfile "C:/Program Files/AutoCAD 2008/1-DWG-TOMACORRIENTES.txt") "r"))
(progn
(read-line ruta) ;;;--- Skip the first three lines
(while (setq pa (read-line ruta)) ;;;--- Read the lines of data in the text file
(setq bloList ;;;--- Add the data to the list
(append
bloList
(list (list pa))
)
)
)
(close ruta) ;;;--- Close the file.
)
)
)
)
bloList ;;;--- Sort the list
)
;;;;;;;;;;;;;;;;;;;;;; End of Bloque listing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:E1 (/ esc1$ bloqlist$ Return# bname key grr ip lastpt ent)
(if (not *E1@) (setq *E1@ (list nill "" "")))
(setq esc1$ (nth 1 *E1@)
bloqlist$ (nth 2 *E1@))
(setvar "cmdecho" 0)
(setq bloList(blokinf)) ;;;--- Get the layer names
(if bloList ;;;--- If a master list was found
(progn
(setq dcl_id (load_dialog "C:/Program Files/AutoCAD 2008/Support/CADMASTER 2008/RUTINAS/INSERT-1.dcl")) ;;;--- Load the DCL file
(if (not (new_dialog "INSERTA" dcl_id "" (cond (*screenpointE1*) ('(-1 -1))))) ;;;--- See if the dialog box is already loaded
(progn
(princ "\nLisp Cancelado VERIFICAR FALLA")
(exit)
)
)
(folder1 "load") ;;;;AGREGAR LINEA PARA CARGAR FOTOS
(seleccionate "save") ;;;;AGREGAR LINEA PARA CARGAR FOTOS
(setq bloNames(list)) ;;;--- Get the layer names
(foreach pa bloList
(setq bloNames(append bloNames(list (car pa))))
)
;;;--- Add the layer names to the dialog box
(start_list "bloqlist" 1)
(mapcar 'add_list bloNames)
(end_list)
(set_tile "esc1" esc1$)
(set_tile "bloqlist" bloqlist$)
(action_tile "esc1" "(setq esc1$ $value)")
(action_tile "bloqlist" "(setq bloqlist$ $value)")
(action_tile "cancel" "(setq *screenpointE1* (done_dialog 1))")
(action_tile "accept" "(saveVars)(setq *screenpointE1* (done_dialog 2))")
(action_tile "save" "(done_dialog 3)")
(action_tile "load" "(actualiza)")
(action_tile "centrado" "(done_dialog 5)")
(setq ddiag (start_dialog))
(unload_dialog dcl_id)
(setq *E1@ (list nil esc1$ bloqlist$))
(if (= ddiag 3) (carga))
(if (= ddiag 5) (centroide))
(if (= ddiag 4) (actualiza))
(if (= ddiag 1) (prompt "\nPrograma Cancelado..."))
;;;--- If the "Okay" button was pressed
(if (= ddiag 2)
(progn
(cond
((= esc1 "ess1") (setq pv 2))
((= esc1 "ess2") (setq pv 1))
((= esc1 "ess3") (setq pv 1.5))
((= esc1 "ess4") (setq pv 0.5))
((= esc1 "ess5") (setq pv 20))
)
(cond
((= esd1 1)(setq pv 2))
((= esd2 1)(setq pv 1))
((= esd3 1)(setq pv 1.5))
((= esd4 1)(setq pv 0.5))
((= esd5 1)(setq pv 20))
)
(if (> (length blkList) 0)
(progn
(foreach pa blkList
(setvar "cmdecho" 0)
(setq MIL (getvar "insunits"))
(setvar "insunits" 4)
(setvar "cmdecho" 0)
(setq mxb (strcat "\nGirar [I]zquierda / [D]erecha\n" "Ubicacion [T]emporal, Punto [B]ase: "))
(while ; exit on ENTER or picked point
(cond
;;----------------------------------------------
;; keyboard input
((eq 2 (car (setq grr (grread t 7 0))))
(setq key (cadr grr))
(cond
;;-------------------------------------------
((= key 13) ; ENTER- where done here
(and ent (entdel ent))
(princ "\n**Cancel**.")
nil ; exit loop
)
;;-------------------------------------------
((member (chr key) '("H" "h")) ; Word entry 'Help'
(vl-cmdf "_.insert" (car pa) )
(while (= (logand (getvar "cmdactive") 1) 1)
(command pause)
)
t ; stay in loop
)
((member (chr key) '("T" "t")) ; Insert with OSNAP
(vl-cmdf "_.move" ent "" "_non" lastpt)
(while (= (logand (getvar "cmdactive") 1) 1) (command pause))
nil ; stay in loop
)
((member (chr key) '("I" "i")) ; Left or CCW
(vl-cmdf "_.rotate" ent "" "_non" ip 90.0)
t ; stay in loop
)
((member (chr key) '("D" "d")) ; Right or CW
(vl-cmdf "_.rotate" ent "" "_non" ip -90.0)
t ; stay in loop
)
((member (chr key) '("B" "b")) ; Basepoint
(vl-cmdf "_.move" ent "" (getpoint "\n>> Especifica punto base: ") ip)
(princ mxb)
t ; stay in loop
)
;;-------------------------------------------
((princ "\nTecla Invalidada.") (princ mxb))
) ; end cond
)
;;=====================================================
((eq 3 (car grr)) ; point picked, make final star
; (setq ip (cadr grr))
(setq cursor_position (cadr grr))
nil ; exit
)
;;=====================================================
((eq 5 (car grr)) ; point from mouse, update object
;;(setq ip (cadr grr))
(setq cursor_position (cadr grr))
(setq ID_point
(cond
((osnap cursor_position "_end,_mid,_int")) ;"_end,_mid,_int"
(cursor_position)
))
(if (null lastpt) ; first time through
(progn
;;(setq lastpt ip)
(setq lastpt ID_point)
(princ mxb)
(vl-cmdf "_.insert" (car pa) "_S" pv "_R" 0.0 "_non" ID_point)
; (vl-cmdf "_.insert" (car pa) "_S" pv "_R" 0.0 ID_point)
(setq ent (entlast))
)
)
; (if (> (distance ip lastpt) 0.00001)
(if (> (distance ID_point lastpt) 0.00001)
; (vl-cmdf "_.move" ent "" "_non" lastpt "_non" ip)
(vl-cmdf "_.move" ent "" "_non" lastpt "_non" ID_point)
;;;(vl-cmdf "_.move" ent "" lastpt ip)
)
; (setq lastpt ip)
(setq lastpt ID_point)
)
) ; end cond
;;=====================================================
) ; while
(redraw)
(command "explode" ent "")
(setvar "insunits" MIL)
(setvar "cmdecho" 1)
)
)
)
)
)
)
)
(princ))
(princ)
(defun carga (/ Conjunto Ubicacion)
(vl-load-com)
(defun AUX_SelectSaveFile (Extension / Directorio EntNombre EntNuevoName)
(setq Nombre (vla-get-Effectivename(vlax-ename->vla-object Conjunto )))
;;;(setq Blockname (substr Nombre 11))
;;;(setq Prefijo "1-DEU-DWG ")
(setq EntNombre (strcase Nombre))
(setq EntNuevoName (vl-filename-base (substr (vl-filename-mktemp (strcat EntNombre Extension)) 1 3)))
(setq Liga (strcat EntNombre EntNuevoName))
(setq Liga1 (strcat "C:/Program Files/AutoCAD 2008/Support/CADMASTER 2008/BLOCKS/TOMACORRIENTES-1/" Liga))
(cond
((setq Directorio (getfiled "Guardar Bloque version 1.3 A.E.CAD 2014" Liga1 Extension 1))
(setq EntNombre (strcat (vl-filename-directory Directorio) "\\"))))
Directorio )
(if (setq Conjunto (car (entsel "\nSelecciona bloque a guardar: "))
EntPto (cdr (assoc 10 (entget Conjunto))))
(cond
((setq Ubicacion (AUX_SelectSaveFile "dwg"))
(setvar "cmdecho" 0)
(command "_undo" "_begin")
(if (findfile Ubicacion)
(vl-cmdf "_.-WBLOCK" Ubicacion "_Y" "" EntPto Conjunto "")
(vl-cmdf "_.-WBLOCK" Ubicacion "" '(0 0 0) Conjunto "")
)
(startapp "explorer" (strcat "/n,/e," Ubicacion))
(command "_undo" "_end")
(setvar "cmdecho" 1))))
(alert "\nMueva el bloque al eje 0,0,0 ")
(princ))
(princ)
(defun actualiza (/ Conjunto Ubicacion)
(defun AUX_SelectSaveFile (Extension / Directorio EntNombre EntNuevoName)
(setq EntNombre "C:/Program Files/AutoCAD 2008/1-DWG-TOMACORRIENTES.txt")
(setq EntNuevoName (vl-filename-base (substr (vl-filename-mktemp (strcat EntNombre Extension)) 1 3)))
(cond
((setq Directorio (getfiled "Abrir Bloque version 1.3 A.E.CAD 2014" (strcat EntNombre EntNuevoName) Extension 4))
(setq EntNombre (strcat (vl-filename-directory Directorio) "\\"))))
Directorio)
(cond
((setq Ubicacion (AUX_SelectSaveFile "txt"))
(setvar "cmdecho" 0)
(findfile Ubicacion)
(startapp "explorer" (strcat "/n,/e," Ubicacion))
(setvar "cmdecho" 1)))
(princ))
(princ)
