HERRAMIENTAS PARA COMANDOS DE AUTOCAD ;*****AJUSTE DE LAYERS (defun val (pp qq) (cdr (assoc pp (entget qq)))) (defun

c:cy () (setvar "cmdecho" 0) (setq sel (ssget) ent (car (entsel "\nSeleccione la entidad del layer de referencia : ")) col (if (val 62 ent) (val 62 ent) "bylayer") ) (command "change" sel "" "p" "la" (val 8 ent) "c" col "") (setvar "cmdecho" 1) ) ;************ (defun c:py () (setvar "cmdecho" 0) (setq ent (car (entsel "\nSeleccione la entidad para fijar layer : "))) (command "layer" "s" (val 8 ent) "") (setvar "cmdecho" 1) ) ;******** (defun c:fy () (setvar "cmdecho" 0) (setq sel (ssget) n 1 ll nil ll (append ll (list (val 8 (ssname sel 0))))) (while (< n (sslength sel)) (setq nom (ssname sel n) nom (val 8 nom) n (1+ n) ) (if (null (member nom ll)) (setq ll (append ll (list ",")) ll (append ll (list nom)) ) ) ) (command "layer" "f" (setq lf (apply 'strcat ll)) "") (setvar "cmdecho" 1) ) ;******** (defun c:of () (setvar "cmdecho" 0) (setq sel (ssget) n 1 ll nil ll (append ll (list (val 8 (ssname sel 0))))) (while (< n (sslength sel)) (setq nom (ssname sel n) nom (val 8 nom) n (1+ n) ) (if (null (member nom ll)) (setq ll (append ll (list ",")) ll (append ll (list nom)) ) ) ) (command "layer" "off" (setq lf (apply 'strcat ll)) "") (setvar "cmdecho" 1) ) ;*********

(defun c:lt () (prompt "Layer Thaw:") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "t" "*" "") (setvar "cmdecho" a) (princ) ) (defun c:lts () (prompt "Layer Thaw:") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (prompt "indique layers a descongelar:") (Command "Layer" "t" pause) (setvar "cmdecho" a) (princ) ) ***RUTINA PARA BLOQUEAR LAYERS*** (defun c:lock () (setvar "cmdecho" 0) (setq sel (ssget) n 1 ll nil ll (append ll (list (val 8 (ssname sel 0))))) (while (< n (sslength sel)) (setq nom (ssname sel n) nom (val 8 nom) n (1+ n) ) (if (null (member nom ll)) (setq ll (append ll (list ",")) ll (append ll (list nom)) ) ) ) (command "layer" "lock" (setq lf (apply 'strcat ll)) "") (setvar "cmdecho" 1) ) ;********* (defun c:un () (prompt "Layer Unlock:") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "un" "*" "") (setvar "cmdecho" a) (princ) ) (defun c:uns () (prompt "Layer Unlock:") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (prompt "indique layers a desbloquear:") (Command "Layer" "un" pause) (setvar "cmdecho" a) (princ) )

*****CAMBIO DIRECTO DE LAYER***** (defun c:mech () (prompt "Layer Actual HV-EQUIPO") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "HV-EQUIPO" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:0 () (prompt "Layer Actual 0") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "0" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:grid () (prompt "Layer Actual HV-CL") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "HV-CL" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:MISC () (prompt "Layer Actual HV-MISC") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "HV-MISC" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:SIM () (prompt "Layer Actual GR-SIMBOLOGIA") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "GR-SIMBOLOGIA" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:4 () (prompt "Layer Actual 4") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0)

(Command "Layer" "set" "4" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:5 () (prompt "Layer Actual 5") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "5" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:6 () (prompt "Layer Actual 6") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "6" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:7 () (prompt "Layer Actual 7") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "7" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:DIM () (prompt "Layer Actual ME-DIMS") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "ME-DIMS" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:8 () (prompt "Layer Actual 8") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "8" "") (setvar "cmdecho" a) (princ) ) ;*********

(defun c:MC () (prompt "Layer Actual ME-CL") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "ME-CL" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:23 () (prompt "Layer Actual 23") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "23" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:AU () (prompt "Layer Actual AU") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "AU" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:VP () (prompt "Layer Actual X-VIEWPORT") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "X-VIEWPORT" "") (setvar "cmdecho" a) (princ) ) ;********* (defun c:XR () (prompt "Layer Actual GR-XREF") (setq a (getvar "cmdecho")) (setvar "cmdecho" 0) (Command "Layer" "set" "GR-XREF" "") (setvar "cmdecho" a) (princ) ) *****TEXTOS EN LAYER M-TEXT***** (Defun c:tx () (Command "Layer" "s" "TEXT" "") (command "Dtext")) EQUIP *****DIM LEADER EN LAYER ME-DIMS***** (Defun c:LEA ()

(Command "Layer" "s" "ME-DIMS" "") (COMMAND "leader")) *****DIM HORIZONTAL EN LAYER ME-DIMS***** (Defun c:dh () (Command "Layer" "s" "ME-DIMS" "") (COMMAND "DIM1" "hor")) *****DIM VERTICAL EN LAYER ME-DIMS***** (Defun c:dV () (Command "Layer" "s" "ME-DIMS" "") (COMMAND "DIM1" "ver")) *****DIM ALINEADO EN LAYER ME-DIMS***** (Defun c:dal () (Command "Layer" "s" "ME-DIMS" "") (COMMAND "DIM1" "ali")) *****DIM ANGULAR EN LAYER ME-DIMS***** (Defun c:da () (Command "Layer" "s" "ME-DIMS" "") (COMMAND "DIM1" "ang")) *****DIM ROTADA EN LAYER ME-DIMS***** (Defun c:dr () (Command "Layer" "s" "ME-DIMS" "") (COMMAND "DIM1" "rotate")) *****LINEA EN LAYER M-CENTER***** (Defun c:lic () (Command "Layer" "s" "M-CENTER" "") (COMMAND "LINE")) *****LINEA EN LAYER ME-CL***** (Defun c:ce () (Command "Layer" "s" "ME-CL" "") (COMMAND "LINE")) *****CAMBIO DE PROPIEDADES A ENTIDADES***** (Defun c:po () (Command "matchprop")) ;*****CAMBIO DE COLOR A ENTIDADES (DEFUN C:CB (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "BYLAYER" "")) (DEFUN C:C1 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "1" "")) (DEFUN C:C2 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "2" "")) (DEFUN C:C3 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "3" "")) (DEFUN C:C4 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "4" "")) (DEFUN C:C5 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "5" "")) (DEFUN C:C6 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "6" "")) (DEFUN C:C7 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "7" "")) (DEFUN C:C8 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "8" "")) (DEFUN C:30 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "30" "")) (DEFUN C:150 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "150" ""))

(DEFUN C:252 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "C" "252" "")) ;*****CAMBIO DE LAYER DE ENTIDADES***** (DEFUN C:L0 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "0" "")) (DEFUN C:L1 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "1" "")) (DEFUN C:L2 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "2" "")) (DEFUN C:L3 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "3" "")) (DEFUN C:L4 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "4" "")) (DEFUN C:L5 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "5" "")) (DEFUN C:L6 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "6" "")) (DEFUN C:L7 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "7" "")) (DEFUN C:LAU (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "AU" "")) (DEFUN C:L8 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "8" "")) (DEFUN C:L23 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "23" "")) (DEFUN C:L21 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "21" "")) (DEFUN C:LMCO (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LA" "MARCO" "")) ;*****CAMBIO TIPO DE LINEA A ENTIDADES (DEFUN C:LB (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "BYLAYER" ""))(DEFUN C:LH (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "HIDDEN" "")) (DEFUN C:LH2 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "HIDDEN2" "")) (DEFUN C:LH50 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "HIDDEN2" "LTS" ".5" "")) (DEFUN C:LH4 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "HIDDEN4" "")) (DEFUN C:LC (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "CENTER" "")) (DEFUN C:LC2 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "CENTER2" "")) (DEFUN C:LC4 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "CENTER4" "")) (DEFUN C:LCO (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "CONTINUOUS" "")) (DEFUN C:LP (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "PHANTOM" "")) (DEFUN C:LP2 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "PHANTOM2" "")) (DEFUN C:LP4 (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "PHANTOM4" "")) (DEFUN C:G7A (/ GP) (SETQ GP (SSGET)) (COMMAND "CHPROP" GP "" "LT" "GEN7A" "")) ;*****DIMENSIONES Y DISTANCIAS (DEFUN C:DSE () (COMMAND "DIST" "END" PAUSE "END")) (DEFUN C:DNP () (COMMAND "DIST" "NEA" PAUSE "PER")) (DEFUN C:DCC () (COMMAND "DIST" "CEN" PAUSE "CEN")) (DEFUN C:DSI () (COMMAND "DIST" "INT" PAUSE "INT")) (DEFUN C:DTE () (COMMAND "DIM1" "TEDIT")) (DEFUN C:DHM () (COMMAND "DIM1" "HOM")) (DEFUN C:DN () (COMMAND "DIM1" "NEWTEXT")) (DEFUN C:DUP () (COMMAND "DIM1" "UPDATE")) (DEFUN C:ONP () (COMMAND "OFFSET" "NEA" PAUSE "PER")) ;*****PROGRAMA PARA RECTANGULO POLILINEA (defun C:SQ (/ a b c d) (setq a (getpoint "Dame primer punto del rectangulo"))(terpri) (setq c (getcorner a "Dame esquina opuesta"))(terpri) (setq b (list (car a) (cadr c))) (setq d (list (car c) (cadr a))) (command "pline" a b c d "c") )

;*****PROGRAMA PARA RECTANGULO LINEA (defun C:REC (/ a b c d) (setq a (getpoint "Dame primer punto del rectangulo"))(terpri) (setq c (getcorner a "Dame esquina opuesta"))(terpri) (setq b (list (car a) (cadr c))) (setq d (list (car c) (cadr a))) (command "line" a b c d "c") ) ;*****DIBUJO CORTE DE TUBOS (DEFUN c:CTB (/ P1 PA1 PM PB1 P2 PB2) (SETQ P1 (GETPOINT "PRIMER PUNTO: ")) (TERPRI) (SETQ P2 (GETPOINT "SEGUNDO PUNTO: ")) (TERPRI) (SETQ ANG (ANGLE P1 P2)) (SETQ X1 (CAR P1)) (SETQ Y1 (CADR P1)) (SETQ X2 (CAR P2)) (SETQ Y2 (CADR P2)) (SETQ PMX (+ (/ (- X2 X1) 2) X1)) (SETQ PMY (+ (/ (- Y2 Y1) 2) Y1)) (SETQ PAX (+ (/ (- PMX X1) 2) X1)) (SETQ PAY (+ (/ (- PMY Y1) 2) Y1)) (SETQ PBX (+ (/ (- X2 PMX) 2) PMX)) (SETQ PBY (+ (/ (- Y2 PMY) 2) PMY)) (SETQ DIS (/ (SQRT (+ (EXPT (- X2 X1) 2) (EXPT (- Y2 Y1) 2))) 12)) (SETQ PM (LIST PMX PMY)) (SETQ PA (LIST PAX PAY)) (SETQ PB (LIST PBX PBY)) (SETQ PA1 (POLAR PA (+ ANG (/ PI 2)) DIS)) (SETQ PB1 (POLAR PB (- ANG (/ PI 2)) DIS)) (SETQ PB2 (POLAR PB (+ ANG (/ PI 2)) DIS)) (COMMAND "ARC" P1 PA1 PM "ARC" PM PB1 P2 "ARC" PM PB2 P2 "") ) ;******MIRROR DIRECTO (DEFUN C:MI() (SETVAR "CMDECHO" 0) (COMMAND "OSNAP" "CEN") ;ent (car (entsel "\nSeleccione las entidades : ")) (PRINC "Seleccione objetos:") (PRINC "n/EJE:") (COMMAND "MIRROR" PAUSE "" PAUSE "@10000<90" "Y") (COMMAND "OSNAP" "NON") (SETVAR "CMDECHO" 1) ) ;*****CORTE LINEAS INTERSECTADAS (defun c:cut() (setvar "cmdecho" 0) (prompt "Cut utility\n") (prompt "select object, then intersection for cut:") (command "break" pause "f" "int" pause "int" pause) (setvar "cmdecho" 1) ) ;*****ZOOM

(defun c:w () (command "zoom" "window")) (defun c:aa () (command "zoom" "all")) (defun c:pp () (command "zoom" "previous")) (defun c:d () (command "zoom" "dynamic")) (defun c:ee () (command "zoom" "extents")) (defun c:re () (command "zoom" "^C")) ;*****OSNAP END,INT (SETVAR "CMDECHO" 0) (DEFUN C:SSS() (COMMAND "OSNAP" "END,INT,MID,CEN,INS,PER") ) ;*****OSNAP CEN (SETVAR "CMDECHO" 0) (DEFUN C:CEN() (COMMAND "OSNAP" "CEN") ) *****INSERCION DE BLOCKES ***** ******"Indicando escala"******* (defun C:Blin () (setq sym (getstring "\Nombre del block: ")) (menucmd "s=symsize") (setq siz (getreal "\nEscala: ")) (setq p1 (getpoint "\nPunto de insercion: ")) (command "insert" sym p1 siz siz 0) (menucmd "s=") (princ) ) ;******"A escala directa"******* (defun C:Blsc () (setq sym (getstring "\Nombre del block: ")) (menucmd "s=symsize") (setq siz (getvar "dimscale")) (setq p1 (getpoint "\nPunto de insercion: ")) (command "insert" sym p1 siz siz 0) (menucmd "s=") (princ) ) ****VIEWPORTS 2VERTICAL, 2HORIZONTAL & SINGLE**** (DEFUN C:2V (/ GP) (COMMAND "VPORTS" "2" "VERTICAL")) (DEFUN C:2H (/ GP) (COMMAND "VPORTS" "2" "HORIZONTAL")) (DEFUN C:SI (/ GP) (COMMAND "VPORTS" "SI")) (DEFUN C:3R (/ GP) (COMMAND "VPORTS" "3" "RIGHT")) ****PEDIT JOIN CONTINUO**** (DEFUN C:J () (COMMAND "PEDIT" PAUSE "Y" "J"))

****ROTACION A 45,90 Y 180 GRADOS ENTIDADES**** (DEFUN C:R45 (/ GP) (SETQ GP (SSGET)) (COMMAND "ROTATE" GP "" PAUSE "45")) (DEFUN C:R90 (/ GP) (SETQ GP (SSGET)) (COMMAND "ROTATE" GP "" PAUSE "90")) (DEFUN C:-45 (/ GP) (SETQ GP (SSGET)) (COMMAND "ROTATE" GP "" PAUSE "-45")) (DEFUN C:-90 (/ GP) (SETQ GP (SSGET)) (COMMAND "ROTATE" GP "" PAUSE "-90")) (DEFUN C:R180 (/ GP) (SETQ GP (SSGET)) (COMMAND "ROTATE" GP "" PAUSE "180")) ****TILEMODE ON - OFF**** (defun c:tm1 () (command "tilemode" "1")) (defun c:tm0 () (command "tilemode" "0")) ****COPIA DE ENTIDADES Y ROTACION**** (DEFUN C:CM () (SETQ SEL (SSGET)) (COMMAND "COPY" SEL "" "M") ) ;;;COPIAR CON ROTACION (DEFUN C:CR (/ SS1 P1) (PROMPT "\CR ") (IF (SETQ SS1 (SSGET)) (PROGN (SETQ P1 (GETPOINT "\nCOPY PUNTO BASE: ")) (PROMPT "\nCOPY PUNTO DE REFERENCIA: ") (COMMAND "COPY" SS1 "" P1 P1 "POINT" P1 "MOVE" SS1 (ENTLAST) "" P1 PAUSE) (PROMPT "\nANGULO DE ROTACION: ") (COMMAND "ROTATE" SS1 "" (CDR (ASSOC 10 (ENTGET (ENTLAST)))) PAUSE "REDRAW") (ENTDEL (ENTLAST)) ) ) (PRINC) ) ;;;MOVER CON ROTACION (DEFUN C:MRT (/ SS1 P1) (PROMPT "\MRT ") (IF (SETQ SS1 (SSGET)) (PROGN (SETQ P1 (GETPOINT "\nMOVE PUNTO BASE: ")) (PROMPT "\nMOVE PUNTO DE REFERENCIA: ") (COMMAND "MOVE" SS1 "" P1 P1 "POINT" P1 "MOVE" SS1 (ENTLAST) "" P1 PAUSE) (PROMPT "\nANGULO DE ROTACION: ") (COMMAND "ROTATE" SS1 "" (CDR (ASSOC 10 (ENTGET (ENTLAST)))) PAUSE "REDRAW") (ENTDEL (ENTLAST)) ) ) (PRINC) ) (DEFUN C:C45 (/ GP) (SETQ GP (SSGET)) (COMMAND "COPY" GP "" PAUSE "@" "ROTATE" "P" "" "@" "45" "REDRAW"))

(DEFUN C:C90 (/ GP) (SETQ GP (SSGET)) (COMMAND "COPY" GP "" PAUSE "@" "ROTATE" "p" "" "@" "90" "REDRAW")) (DEFUN C:C180 (/ GP) (SETQ GP (SSGET)) (COMMAND "COPY" GP "" PAUSE "@" "ROTATE" "P" "" "@" "180" "REDRAW")) ;*****UNIDADES 4 DIGITOS***** (Defun c:4D () (Command "Units" "2" "4" "1" "0" "0" "n") ) ;*****UNIDADES 0 DIGITOS***** (Defun c:0D () (Command "Units" "2" "0" "1" "0" "0" "n") ) ;*****DIBUJO ISOMETRICO***** (Defun c:ISO () (Command "Snap" "S" "I" "10") (Command "Snap" "OFF") ) ;*****DIBUJO ORTOGONAL***** (Defun c:ORT () (Command "Snap" "S" "S" "10") (Command "Snap" "OFF") ) ; ASD******************************************************************* (defun chgterr (s) (if (/= s "Function cancelled") ; If an error (such as CTRL-C) occurs (princ (strcat "\nError: " s)) ; while this command is active... ) (setq p nil) ; Free selection set (setq *error* olderr) ; Restore old *error* handler (princ) ) (defun C:ASD (/ p l n e os as ns st s nsl osl sl si chf chm olderr) (setq olderr *error* ; Initialize variables *error* chgterr chm 0) (setq p (ssget)) ; Seleccione el texto (if p (progn ; If any objects selected (while (= 0 (setq osl (strlen (setq os (getstring t "\nAnterior caracter: "))))) (princ "Null input invalid") ) (setq nsl (strlen (setq ns (getstring t "\nNuevo caracter: ")))) (setq l 0 n (sslength p)) (while (< l n) ; For each selected object... (if (= "TEXT" ; Look for TEXT entity type (group 0) (cdr (assoc 0 (setq e (entget (ssname p l)))))) (progn (setq chf nil si 1) (setq s (cdr (setq as (assoc 1 e)))) (while (= osl (setq sl (strlen

) )) (princ "Cambio ") ; Print total lines changed (princ chm) (princ " Linea(s) del texto.") (terpri) lineas de texto (setq *error* olderr) ; Restore old *error* handler (princ)

) ) (setq l (1+ l))

) (if chf (progn ; Substitute new string for old (setq e (subst (cons 1 s) as e)) (entmod e) ; Modify the TEXT entity (setq chm (1+ chm)) ))

(setq st (substr s si osl))))) (if (= st os) (progn (setq s (strcat (substr s 1 (1- si)) ns (substr s (+ si osl)))) (setq chf t) ; Found old string (setq si (+ si nsl)) ) (setq si (1+ si)) )

; comienza modemacro********************************************************* (setvar "modemacro" (strcat "Layer:$(substr,$(getvar,clayer), 1,8)" ;;;"$(if,$(getvar,orthomode), Ortho)" ;;;"$(if,$(getvar,snapmode), Snap)" ;;" Drawing:$(getvar,dwgname)" " Scale=1:$(getvar,dimscale)" " Time:$(substr,$(getvar,cdate), 10,2)" ; hora ":$(substr,$(getvar,cdate), 12,2)" ;minutos ":$(substr,$(getvar,cdate), 14,2)" ;segundos " Date:$(SUBSTR,$(GETVAR,CDATE), 7,2)" ;DIA ":$(SUBSTR,$(GETVAR,CDATE), 5,2)" ;MES ":$(SUBSTR,$(GETVAR,CDATE), 3,2)" ;AO ) ) ; termina mmodemacro********************************************************* ; ; ( DEFUN C:SUMA (/ NUESCA ANTESCA )

(terpri) (prompt "\nSUMAR VALORES DE TABLA") ;PRINCIPAL (setvar "CMDECHO" 0) ;***************************************************************************************** (defun texto (seltxt / esc n sel n1 ent ) ;******* (prompt "\nS U M A N D O V A L O R E S ...") (setq sel (if (= nil seltxt) (ssget "x" (LIST (CONS 0 "TEXT"))) seltxt ) ) (if (/= nil sel) (progn (setq n 0 n1 (sslength sel) ) (repeat n1 (setq ENT (ssname sel n)) (setq pr (entget ent)) (setq VALOR (cdr (assoc 1 pr))) (SETQ YO (ENTNEXT)) (SETQ INICIO 0) (SETQ SUMANDO (ATOF VALOR)) (PROMPT "\nEL SUMANDO ES: " ) (PRINC SUMANDO) (progn (if (= 0 n) (setq sumas (+ 0 sumando)) (setq sumas (+ sumas sumando)) ) ) (setq n (1+ n)) );repeat (PROMPT "\n\tLA SUMATORIA ES IGUAL A = ") (princ sumas) (terpri) (terpri) ;(princ sumas) );progn );if ;******* );defun ;**

; ; INICIO ; (prompt "\n\tS E L E C C I O N A V A L O R E S D E T A B L A : " ) (setq sel (ssget) sellin nil seltxt nil seldim nil selCIR nil selpol nil) (if (/= sel nil) (progn (setq n 0 sellin (ssadd) selpol (ssadd) seldim (ssadd) seltxt (ssadd) selcir (ssadd)) (repeat (sslength sel) (setq ent (ssname sel n) pr (entget ent)) (cond (( = "LINE" (cdr (assoc 0 pr))) (setq sellin (ssadd ent sellin)) ) (( = "TEXT" (cdr (assoc 0 pr))) (setq seltxt (ssadd ENT seltxt)) ) ) (setq n (1+ n)) );repeat );progn

);if

(texto seltxt) ) ;******************* (defun c:et() (command "extend")) (defun c:cc() (command "copy")) (defun c:hg() (command "change")) (defun c:mr() (command "mirror")) (defun c:th() (command "stretch")) (defun c:le() (command "lengthen;DY")) (defun c:se() (command "select"))