Saludos, tengo una rutina lisp de terceros "Libre de modificar siempre que se respete a el o los creadores de la misma" denominada Corex V 2.7 para autocad, el inconveniente es que la misma no está programada para obtener los rumbos y le faltan 3 columnas que son: 1ra. Estación y Pto. Visado, 2da. Pto. Card. 3ra. Colindantes, o sea: /E-PV./P.CRD./COLINDANTES/. Soy nuevo en esto y quisiera tener ayuda o solución al respecto porque así lo piden en el cantón que yo radico acá en Ecuador. agradeciendo de antemano la ayuda, me suscribo de ustedes.
les envío el código tal cual está.
; Rutina que exporta o crea una tabla con las coordenadas de los puntos indicados
; Desarrollado por Mario Torres Pejerrey
; http://www.construcgeek.com/
;|Este es un lisp en formato original, se puede ver el código fuente, la intención, es de que el código fuente
; pueda ser modificado y adaptado a la necesidad de cada usuario, lo único que siempre se solicita en estos
; casos es de que siempre se haga referencia al autor del mismo (es decir que no se modifique la autoría del lisp),
; salvo que este se modifique ampliamente.
; Si se construye un nuevo programa tomando como partes un lisp publicado, se debería de hacer el comentario
; de que parte del nuevo programa esta basado en el autor original.|;
; Programa descargado desde http://www.construcgeek.com
; ConstrucGeek 2008
; Cargar las funciones ActiveX (Visual Lisp)
(vl-load-com)
(setq AcadObj (vlax-get-acad-object))
(setq AcadDocument (vla-get-activedocument AcadObj))
(setq mspace (vla-get-modelspace AcadDocument))
(setq util (vla-get-utility AcadDocument))
(setq VersionCorex "Corex V2.7")
(defun c:corex()
(crear_CuadroDialogo)
; Conectando con el archivo y la estructura.
(setq ind (LOAD_DIALOG fname))
(if (not (new_dialog "dlg_Corex" ind))
(exit )
);if
(Defecto)
(valores)
(acciones)
; Se visualiza el cuadro.
(IF (= 1 (START_DIALOG))
(EjecutarComando)
)
(UNLOAD_DIALOG ind)
(vl-file-delete fname)
(if (not (null RutaArchTemp))
(vl-file-delete RutaArchTemp)
)
(princ)
)
(Defun Defecto()
(setq OLDERR *error* *error* TBERROR)
(setq EstiloActual (getvar "TEXTSTYLE"))
(setq TEMPCMD (getvar "CMDECHO"))
(setq puntoCoordenada nil)
(setq RutaArchSel nil)
(setq SeIndicoVerticeExportar nil)
(setvar "CMDECHO" 0)
(setq
NumLinea 0
x_distancia 0.025
y_distancia 0.005
altura_texto 0.002
estilo_texto "Arial.ttf"
align_texto "bc"
)
(setq DondeExportar (vl-registry-read "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Donde exportar"))
(if (null DondeExportar)(setq DondeExportar "Tabla"))
(setq TextoVertice (vl-registry-read "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Texto del vertice"))
(if (null TextoVertice)(setq TextoVertice "1"))
(setq InsertarTexto (vl-registry-read "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Insertar texto vertice"))
(if (null InsertarTexto)(setq InsertarTexto "1"))
(setq InsertarCirculo (vl-registry-read "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Insertar circulo vertice"))
(if (null InsertarCirculo)(setq InsertarCirculo "1"))
(setq EscalaTextoOperar (vl-registry-read "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Escala de la tabla"))
(if (null EscalaTextoOperar)(setq EscalaTextoOperar 100))
(setq ConciCota (vl-registry-read "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Conciderar la cota"))
(if (null ConciCota)(setq ConciCota "1"))
(setq NDecimalesOperar (vl-registry-read "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Numero de decimales"))
(if (null NDecimalesOperar)(setq NDecimalesOperar 3))
)
(defun valores ()
; Se define los valores por defecto.
(SET_TILE "txtEscala" (ITOA EscalaTextoOperar))
(MODE_TILE "txtEscala" 2)
(if (= DondeExportar "Tabla")
(progn
(Setq ValorRBTabla "1")
(Setq ValorRBArchivo "0")
(MODE_TILE "cmdArchivo" 1)
(MODE_TILE "txtEscala" 0)
)
(progn
(Setq ValorRBTabla "0")
(Setq ValorRBArchivo "1")
(MODE_TILE "txtEscala" 1)
)
)
(if (= TextoVertice "1")
(progn
(Setq ValorRBAutomatico "1")
(Setq ValorRBSeleccionar "0")
)
(progn
(Setq ValorRBAutomatico "0")
(Setq ValorRBSeleccionar "1")
(MODE_TILE "chkInsertarT" 1)
(MODE_TILE "chkInsertarC" 1)
)
)
(SET_TILE "rbTabla" ValorRBTabla)
(SET_TILE "rbArchivo" ValorRBArchivo)
(SET_TILE "rbAutomatico" ValorRBAutomatico)
(SET_TILE "rbSeleccionar" ValorRBSeleccionar)
(SET_TILE "chkInsertarT" InsertarTexto)
(SET_TILE "chkInsertarC" InsertarCirculo)
(SET_TILE "chkTomarZ" ConciCota)
(SET_TILE "txtDecimales" (Itoa NDecimalesOperar))
(SET_TILE "error" "")
)
(defun acciones()
(ACTION_TILE "txtEscala" "(SET_TILE \"error\" \"\")")
(ACTION_TILE "rbTabla" "(setq DondeExportar \"Tabla\") (MODE_TILE \"cmdArchivo\" 1) (MODE_TILE \"txtEscala\" 0)")
(ACTION_TILE "rbArchivo" "(setq DondeExportar \"Archivo\") (MODE_TILE \"cmdArchivo\" 0) (MODE_TILE \"txtEscala\" 1) ")
(ACTION_TILE "cmdArchivo" "(SeleccionarArchivo)")
(ACTION_TILE "rbAutomatico" "(setq TextoVertice \"1\") (MODE_TILE \"chkInsertarT\" 0)(MODE_TILE \"chkInsertarC\" 0)")
(ACTION_TILE "rbSeleccionar" "(setq TextoVertice \"0\") (MODE_TILE \"chkInsertarT\" 1)(MODE_TILE \"chkInsertarC\" 1)")
(ACTION_TILE "chkInsertarT" "(setq InsertarTexto $Value)")
(ACTION_TILE "chkInsertarC" "(setq InsertarCirculo $Value)")
(ACTION_TILE "chkTomarZ" "(setq ConciCota $Value)")
;(setq vbarra "0")
;(ACTION_TILE "barra" "(setq vbarra $value) (SET_TILE \"error\" (strcat \"Valor de la barra: \" vbarra \"% completado.\"))")
(ACTION_TILE "accept" "(aceptar)")
(ACTION_TILE "cancel" "(DONE_DIALOG)")
(ACTION_TILE "Acerca" "(acercade)")
)
(defun SeleccionarArchivo()
(setq RutaArchSel (acet-ui-getfile "Nuevo archivo de vértices" (acet-filename-ext-remove (getvar "DWGNAME")) "csv;*" "Acet:RText" 1))
(if (= RutaArchSel "")
(setq RutaArchSel nil)
)
)
(defun aceptar()
(cond
((<= (ATOI (GET_TILE "txtEscala")) 0) (MODE_TILE "txtEscala" 2)(acet-ui-message "Debe de ingresar una escala válida." VersionCorex (+ (+ 0 48) 0)))
((< (ATOI(GET_TILE "txtDecimales")) 0) (MODE_TILE "txtDecimales" 2)(acet-ui-message "Ingrese un número de decimales válido." VersionCorex (+ (+ 0 48) 0)))
((AND (= DondeExportar "Archivo" )(null RutaArchSel))(acet-ui-message "Debe de eligir la ruta del archivo a exportar." VersionCorex (+ (+ 0 48) 0)))
(T
(setq EscalaTextoOperar (ATOI (GET_TILE "txtEscala")))
(VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Escala de la tabla" "" EscalaTextoOperar)
(setq NDecimalesOperar (ATOI(GET_TILE "txtDecimales")))
(VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Numero de decimales" "" NDecimalesOperar)
(if (= ConciCota "1")
(setq ConciderarCota "Sí")
(setq ConciderarCota "No")
)
(VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Conciderar la cota" "" ConciderarCota)
(VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Texto del vertice" "" TextoVertice)
(VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Insertar texto vertice" "" InsertarTexto)
(VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Insertar circulo vertice" "" InsertarCirculo)
(VL-REGISTRY-WRITE "HKEY_CURRENT_USER\\Software\\construcgeek.com\\Corex.Lsp\\Donde exportar" "" DondeExportar)
(DONE_DIALOG 1)
)
)
)
(defun acercade()
(acet-ui-message (strcat "Programa " VersionCorex ", Comando: Corex"
"\nLisp Desarrollado por Mario Torres P."
"\nExporta o crea una tabla con las coordenadas de puntos indicados."
) VersionCorex (+ (+ 0 64) 0))
)
(defun EjecutarComando()
(cond ;Cond1
((= DondeExportar "Archivo")
(ExportarAArchivo)
)
((= DondeExportar "Tabla")
(ExportarATabla)
(if (not (null SeIndicoVerticeExportar))
(progn
(LeerDeArchivo)
(CrearCuadricula)
)
)
)
);Cond1
(if (not (null SeIndicoVerticeExportar))
(Princ "\nSe exportaron los vertices satisfactoriamente.")
)
)
(defun ExportarAArchivo()
(if (not (null RutaArchSel))
(progn
(setq archAbierto (OPEN RutaArchSel "a"))
(if (= TextoVertice "0")
(SeleccionarVertices)
(progn
(while
(setq puntoCoordenada (getpoint "\nPike el vértice a exportar: "))
(if (not (null puntoCoordenada))
(progn
(setq SeIndicoVerticeExportar "Sí")
(ExportarVertices)
)
)
)
)
)
(close archAbierto)
)
(acet-ui-message "Debe de indicar un archivo." VersionCorex (+ (+ 0 48) 0))
)
)
(defun ExportarATabla()
(setq RutaArchTemp (vl-filename-mktemp "CorexM.txt"))
(setq archAbierto (OPEN RutaArchTemp "w"))
(if (= TextoVertice "0")
(SeleccionarVertices)
(progn
(while
(setq puntoCoordenada (getpoint "\nPike el vértice a exportar: "))
(if (not (null puntoCoordenada))
(progn
(setq SeIndicoVerticeExportar "Sí")
(ExportarVertices)
)
)
)
)
)
(close archAbierto)
)
(defun SeleccionarVertices()
(while
(setq ent (car (entsel "\nSeleccione el texto del vértice: ")))
(setq LetraVertice (vlax-ename->vla-object ent))
(vla-Highlight LetraVertice 1)
(setq vtextoVertice (vla-get-TextString LetraVertice))
(princ (strcat "<<" vtextoVertice ">>"))
(setq puntoCoordenada (getpoint "\nPike el vértice a exportar: "))
(if (not (null puntoCoordenada))
(progn
(setq SeIndicoVerticeExportar "Sí")
(ExportarVertices)
)
)
)
)
(defun ExportarVertices()
(setq xpuntoCoordenada (car puntoCoordenada)) (setq xpuntoCoordenada (rtos xpuntoCoordenada 2 NDecimalesOperar))
(setq ypuntoCoordenada (cadr puntoCoordenada))(setq ypuntoCoordenada (rtos ypuntoCoordenada 2 NDecimalesOperar))
(setq zpuntoCoordenada (caddr puntoCoordenada))(setq zpuntoCoordenada (rtos zpuntoCoordenada 2 NDecimalesOperar))
(setq NumLinea (1+ NumLinea))
;calculo de la distancia acumulada
(if (>= numlinea 2)
(setq distancia (sqrt (+ (expt (- (atof xpuntocoordenada) xpuntoauxiliar) 2 ) (expt (- (atof ypuntocoordenada) ypuntoauxiliar ) 2)
(expt (- (atof zpuntocoordenada) zpuntoauxiliar) 2 ) )))
)
(setq xpuntoauxiliar ( atof xpuntocoordenada) ) (setq ypuntoauxiliar ( atof ypuntocoordenada)) (setq zpuntoauxiliar( atof zpuntocoordenada))
;(setq distancia (+ (atoF xpuntoCoordenada) (atoF ypuntoCoordenada)))
(if (= numlinea 1 )
(setq distancia 0)
)
(setq distancia (rtos distancia 2 3))
(if (= TextoVertice "1")
(progn
(setq vtextoVertice (itoa NumLinea))
(princ (strcat "<<" vtextoVertice ">>"))
)
)
(if (= NumLinea 1)
(progn
(if (= ConciderarCota "Sí")
(setq Lineatexto (strcat "PUNTO" "," "NORTE" "," "ESTE" "," "COTA" "," "DISTANCIA" "," "E-PV."))
(setq Lineatexto (strcat "PUNTO" "," "NORTE" "," "ESTE" "," "DISTANCIA" "," "E-PV."))
)
(write-line lineaTexto archAbierto)
)
)
(if (= ConciderarCota "Sí")
(setq Lineatexto (strcat vtextoVertice "," ypuntoCoordenada "," xpuntoCoordenada "," zpuntoCoordenada "," distancia))
(setq Lineatexto (strcat vtextoVertice "," ypuntoCoordenada "," xpuntoCoordenada "," distancia))
)
(write-line lineaTexto archAbierto)
(if (= TextoVertice "0")
(vla-Highlight LetraVertice 0)
(progn
(if (= InsertarTexto "1")
(AgregarTexto)
)
(if (= InsertarCirculo "1")
(AgregarCirculo)
)
)
)
)
(defun AgregarTexto()
(setq TxtObjVert (vla-AddText mspace vtextoVertice (vlax-3d-point puntoCoordenada) (* altura_texto EscalaTextoOperar)))
(vlax-put-property TxtObjVert 'alignment acAlignmentMiddle)
(vlax-put-property TxtObjVert 'textalignmentpoint (vlax-3D-point puntoCoordenada))
)
(defun AgregarCirculo()
;(setq pt1 (vlax-3d-point (setq pt (getpoint "Center point: "))))
;(setq rad (getdist "Radius: " pt))
(vla-addcircle mspace (vlax-3d-point puntoCoordenada) (* 0.0005 EscalaTextoOperar))
;(setq TxtObjVert (vla-AddText mspace vtextoVertice (vlax-3d-point puntoCoordenada) (* altura_texto EscalaTextoOperar)))
;(vlax-put-property TxtObjVert 'alignment acAlignmentMiddle)
;(vlax-put-property TxtObjVert 'textalignmentpoint (vlax-3D-point puntoCoordenada))
)
(defun LeerDeArchivo()
(command "_style" "Arial" CC (* altura_texto EscalaTextoOperar) "1.0" "" "" "")
(setq start_pt (getpoint "\nPicke la esquina superior izquierda de la tabla: "))
(setq y (cadr start_pt))
(setq archAbierto (open RutaArchTemp "r"))
;; Leer datos
(while
(setq txt (read-line archAbierto))
(setq txt_lst (parse txt))
(setq x (car start_pt))
(setq x_distancia 0.0175)
(print_lst txt_lst)
(setq y (- y (* y_distancia EscalaTextoOperar)))
)
(close archAbierto)
)
(defun parse (txt / n count word lst in_quart)
(setq n (strlen txt) count 1 word "" in_quart nil lst nil)
(while (<= count n)
(setq char (substr txt count 1))
(if (= char "\"")
(if in_quart
(setq in_quart nil)
(setq in_quart T)
)
)
(if (and (= char ",")(= in_quart nil))
(progn
(setq lst (append lst (list word)))
(setq word "")
)
(progn
(if (/= char "\"")
(setq word (strcat word char))
)
(if (= count n)
(setq lst (append lst (list word)))
)
)
)
(setq count (1+ count))
)
(setq lst lst)
)
(defun print_lst (lst / txt txt_pt)
(foreach txt lst
(setq txt_pt (list x y))
;(command "_.text" "_s" "Arial" "_j" align_texto txt_pt "0" txt )
(setq TxtObj (vla-AddText mspace txt (vlax-3d-point txt_pt) (* altura_texto EscalaTextoOperar)))
(vlax-put-property TxtObj 'alignment acAlignmentMiddle)
(vlax-put-property TxtObj 'textalignmentpoint (vlax-3D-point txt_pt))
(setq x (+ x (* x_distancia EscalaTextoOperar)))
(setq x_distancia 0.020)
)
)
(defun tberror (S)
(if (/= S "Function cancelled")
(princ (strcat "\nError: " S))
)
(setvar "TEXTSTYLE" EstiloActual)
;(setvar "CLAYER" TEMPLA)
(setvar "CMDECHO" TEMPCMD)
(if (not (null archAbierto))
(progn
(close fn)
(close archAbierto)
(vl-file-delete fname)
(if (not (null RutaArchTemp))
(vl-file-delete RutaArchTemp)
)
)
)
(setq *error* OLDERR)
(princ)
)
(defun CrearCuadricula ()
(setq XInicial (car start_pt))
(setq YInicial (cadr start_pt))
(setq YFinal (+ y (* y_distancia EscalaTextoOperar)))
(setq DistanciaY (- YInicial YFinal))
(setq NumLineas (+ (/ DistanciaY (* y_distancia EscalaTextoOperar)) 1))
(setq NumLineas (Rtos NumLineas 2 4))
(setq NumLineas (atoi NumLineas))
(setq P1 (list (- XInicial (* 0.007 EscalaTextoOperar))(+ YInicial (* 0.0025 EscalaTextoOperar))))
(if (= ConciderarCota "Sí")
(setq P2 (list (+ XInicial (* 0.08895 EscalaTextoOperar))(+ YInicial (* 0.0025 EscalaTextoOperar))))
(setq P2 (list (+ XInicial (* 0.068 EscalaTextoOperar))(+ YInicial (* 0.0025 EscalaTextoOperar))))
)
(if (= ConciderarCota "Sí")
(progn (setq Pc (list (+ XInicial (* 0.045 EscalaTextoOperar))(+ YInicial (* y_distancia EscalaTextoOperar))))
(setq numRepeticiones 3) )
(progn (setq Pc (list (+ XInicial (* 0.0332 EscalaTextoOperar))(+ YInicial (* y_distancia EscalaTextoOperar))))
(setq numRepeticiones 2) )
)
(setq TxtObj (vla-AddText mspace "CUADRO DE COORDENADAS" (vlax-3d-point Pc) (* 0.0023 EscalaTextoOperar)))
(vlax-put-property TxtObj 'alignment acAlignmentMiddle)
(vlax-put-property TxtObj 'textalignmentpoint (vlax-3D-point Pc))
(setq LineaH (vla-addline mspace (vlax-3d-point P1)(vlax-3d-point P2)))
(setq P1Inicial P1)(setq P2Inicial P2)
(repeat NumLineas
(setq xP1(car p1))(setq yP1(cadr p1))
(setq xP2(car p2))(setq yP2(cadr p2))
(setq P1 (list xP1 (- yP1 (* y_distancia EscalaTextoOperar))))
(setq P2 (list xP2 (- yP2 (* y_distancia EscalaTextoOperar))))
(setq LineaH (vla-addline mspace (vlax-3d-point P1)(vlax-3d-point P2)))
)
(setq P1Final P1)(setq P2Final P2)
(setq LineaVI (vla-addline mspace (vlax-3d-point P1Inicial)(vlax-3d-point P1Final)))
(setq LineaVF (vla-addline mspace (vlax-3d-point P2Inicial)(vlax-3d-point P2Final)))
;Lineas Intermedias
(setq xP1(car P1Inicial))(setq yP1(cadr P1Inicial))
(setq xP2(car P1Final))(setq yP2(cadr P1Final))
(setq P1 (list (+ xP1 (* 0.014 EscalaTextoOperar)) yP1))
(setq P2 (list (+ xP2 (* 0.014 EscalaTextoOperar)) yP2))
(setq LineaHI (vla-addline mspace (vlax-3d-point P1)(vlax-3d-point P2)))
(repeat numRepeticiones
(setq xP1(car p1))(setq yP1(cadr p1))
(setq xP2(car p2))(setq yP2(cadr p2))
(setq P1 (list (+ xP1 (* 0.0205 EscalaTextoOperar)) yP1))
(setq P2 (list (+ xP2 (* 0.0205 EscalaTextoOperar)) yP2))
(setq LineaHI (vla-addline mspace (vlax-3d-point P1)(vlax-3d-point P2)))
)
)
(defun crear_CuadroDialogo ()
(setq fname (vl-filename-mktemp "CorexV2.dcl"))
(setq fn (open fname "w"))
(write-line "dlg_Corex : dialog {
label = \"Corex V2.7\";
: boxed_column {
label=\"Destino de las coordenadas \";
: row {
: radio_button {
key = \"rbTabla\" ;
label = \"&Tabla\" ;
value = \"1\" ;
}
: radio_button {
key = \"rbArchivo\" ;
label = \"&Archivo\" ;
value = \"0\" ;
}
: button {fixed_width=true; width=5; key=\"cmdArchivo\"; is_default=false; label= \"...\";}
}
: row {
: edit_box { key = \"txtEscala\"; fixed_height = true; allow_accept = true; fixed_width = true; alignment = center; label = \"&Escala\"; }
}
spacer;
} // boxed column
: boxed_column {
label=\"Texto del vértice \";
: row {
: radio_button {
key = \"rbAutomatico\" ;
label = \"A&utomático\" ;
value = \"1\" ;
}
: radio_button {
key = \"rbSeleccionar\" ;
label = \"&Seleccionar texto\" ;
value = \"0\" ;
}
}
: toggle {
label = \"Insertar un texto automaticamente\";
key = \"chkInsertarT\";
mnemonic = \"I\";
fixed_width = true;
}
: toggle {
label = \"Insertar un círculo en el vértice\";
key = \"chkInsertarC\";
mnemonic = \"c\";
fixed_width = true;
}
spacer;
} // boxed column
: boxed_column {
label=\"Coordenadas \";
: toggle {
label = \"Tomar valor del eje z (cota)\";
key = \"chkTomarZ\";
mnemonic = \"T\";
fixed_width = true;
}
: edit_box { key = \"txtDecimales\"; fixed_height = true; fixed_width = true; alignment = center; label = \"Nro de &Decimales\"; }
spacer;
} // boxed column
spacer;
: row {
: button {
fixed_width=true;
width=11;
key=\"accept\";
is_default=true;
label= \"&Aceptar\";
}
: button {
fixed_width=true;
width=11;
is_cancel=true;
key=\"cancel\";
label= \"&Cancelar\";
}
: button {
fixed_width=true;
width=11;
is_cancel=false;
key=\"Acerca\";
label= \"Acerca &de...\";
}
} // row
: text_part
{
key=\"error\";
label=\"\";
}
}" fn)
(close fn)
);defun
(PRINC (strcat "\nPrograma " VersionCorex ", Comando: Corex"))
(PRINC "\nLisp Desarrollado por Mario Torres P.")
(PRINC "\nExporta o crea una tabla con las coordenadas de puntos indicados.")
(setvar "modemacro" "http://www.construcgeek.com/")
(princ)
Lo último, los números en el polígono quedan centrados como "mc" y debería ser "bc", eso le cambié al inicio pero no se cambia al ejecutar.
@tnnaguiar para una mayor claridad @joaquim.moral ha editado el título original: Modificar Rutina Lisp Corex para Autocad de terceros.
Recuerda consultar cómo escoger el mejor título para tu post. ¡Gracias por participar!
