Rutina Lisp en Autocad

CaNaRy_r00lz #1 Jul '17 Inocente

Buenas, no creo que haya gente aqui que controle de autocad, pero bueno de perdidos al rio, que seguro que ingenieros tiene mv!

Me gustaría hacer 2 rutinas en autocad, pero no tengo ni idea de como hacerlas ni donde mirar información para aprender y demás, pk todo lo que veo son ejemplos sin explicar de donde vienen las cosas o para que se usan o pk se usan.

Mi primera rutina que me gustaría hacer es: en un dibujo de autocad poder enumerar y sacar las coordenadas de los puntos que designe, exportando esto a un archivo txt, cvs o pts. Me explico mejor, no tiene pk ser un punto tal cual, puede ser una interseccion o cualquier punto que yo designe.
Vamos que si pincho en una intersección/centro de un circulo/esquina, cree un número en el dibujo (para seguir un orden y saber los que he pillado) de 1 en adelante y cuando termine cree un archivo ya sea txt/cvs/pts , sería genial que preguntase si quieres X,Y o X,Y,Z pero vamos con lo primero me conformo

La segunda rutina sería: tienes una línea con ciertas propiedades, digamos discontinua + color "X" con una inclinación de 92º, y lo que quiero es seleccionar un texto y que se alinee con la linea (92º) y que además se separe digamos no se 3 unidades, así todos los textos siempre tendrán la misma alineacion a la línea que selecciones, las mismas propiedades e inclinación, sino se entiende esto puedo subir un pantallazo con ejemplo

Si alguien sabe donde puedo buscar o ayudarme a hacerlo lo agradecería mucho. Gracias y saludos

elfito #2 Jul '17

Hace mil años que no toco autocad, y ahora ando con fusion para diseño 3D así que no te puedo ayudar al 100%

Pero hay un par de tutoriales para hacer routines LISP. http://www.cadtutor.net/forum/showthread.php?1390-How-to-use-the-LISP-routines-in-this-archive

Entiendo que programar lo que pides no es que sea muy complicado en función de lo que permita el conjunto de instrucciones.

Y si no siempre puedes buscar lisp ya hechos: https://www.cadcorner.ca/lisp.php

2 respuestas

CaNaRy_r00lz #3 Jul '17 Inocente

#2 Si para alguien entedido no creo que sea excesivamente complicado, de hecho tengo una rutina que describe lo 2º que quiero hacer, pero sin hacer el match properties y la separación

spoiler

(defun   C:RT () (setvar "cmdecho" 0) (setq OB (entsel "\nSelect object for base angle: "))
;;;  (setvar "osmode" 0)
  (setq DB (entget (car OB)))
  (setq SP (osnap (cadr OB) "nea"))
  (setq ENT (cdr (assoc 0 DB)))
  (cond
    ((equal "LINE" ENT)
     (setq
       ST  (cdr (assoc 10 DB))
       END (cdr (assoc 11 DB))
     ) ;_ end of setq
    )
    ((or (equal "ARC" ENT) (equal "CIRCLE" ENT))
     (setq DIST (distance (cdr (assoc 10 DB)) SP))
     (setq AA (angle (cdr (assoc 10 DB)) SP))
     (setq
       ST  (cdr (assoc 10 DB))
       END (polar ST (+ AA (cvunit 90 "degree" "radian")) DIST)
     ) ;_ end of setq
    )
    ((or (equal "POLYLINE" ENT) (equal "LWPOLYLINE" ENT))
     (setq MID (osnap (cadr OB) "mid"))
     (if (< (car MID) (car SP))
       (setq
         ST  MID
         END SP
       ) ;_ end of setq
     ) ;_ end of if
     (setq
       ST  SP
       END MID
     ) ;_ end of setq
    )
  ) ;_ end of cond
  (setq AG (angle ST END))
  (if (and (<= AG 4.71239) (> AG 1.5708))
    (setq AG (angle END ST))
  ) ;_ end of if
  (setq AGL (car (list (cons 50 AG))))
  (setq N 0)
  (princ "\nNow, Select the text to rotate you turd burglar")
  (setq TXT (ssget))
  (repeat (sslength TXT)
    (setq
      ELIST
       (subst
         AGL
         (assoc 50 (entget (ssname TXT N)))
         (entget (ssname TXT N))
       ) ;_ end of subst
    ) ;_ end of setq
    (entmod ELIST)
    (entupd (ssname TXT N))
    (setq N (+ N 1))
  ) ;_ end of repeat
  (setvar "cmdecho" 1)
  (princ)
) ;_ end of defun
(princ   "\nType 'rt' to rotate the text at the same angle of the selected object")
;_ end of princ
(princ)

Pero claro sin tener ni puta idea la veo y me quedo igual haha, gracias por los links voy a ver si consigo sacar algo

kotapab #4 Jul '17

La forma más "sencilla" de extraer coordenadas:

-En lugar de clickear, hacés una polilínea. Los vértices deben estar en los puntos que te interesan.
-Usás el comando LIST para listar las coordenadas de la polilínea
-Copiás y pegás el resultado en excel.
-Usás "texto a columnas" para separar lo pegado (usar espacios y "=" como separadores).

Listo, tenés las coordenadas XYZ en excel.

Te recomiendo aprender VBA y/o .NET en lugar de LISP, porque te sirve para muchos otros programas además de Autocad. Además podés escribir una macro en excel que extraiga información de Autocad, la pase a Word, la dibuje en Power Point, y en cualquier programa que use macros VBA.

1 respuesta

CaNaRy_r00lz #5 Jul '17 Inocente

#4 Pero yo no busco la forma más sencilla, es como lo necesito, soy topógrafo y necesito que sea así, no siempre necesito todas las coordenadas de una línea, por eso busco que sea donde hago el click y que se numeren, así cuando voy con el plano a obra se que número buscar dentro de mi controller para replantear esas coordenadas por ejemplo

1 respuesta

kotapab #6 Jul '17

#5 Esta macro VBA te alinea textos con una línea (LINE):

Para usarla ejecutás la macro, seleccionás la línea, y a punto seguido los textos a alinear.
Lo que hace es mover los "insertion points" de los textos hacia la línea.

spoiler

Option Explicit
Const x As Integer = 0
Const y As Integer = 1
Const z As Integer = 2

Sub AlinearTextoaLinea()
'-----------------From the HELP file--------------------------------------
'Bitcodes for Object Snap Modes:
' 0 NONe
' 1 ENDpoint
' 2 MIDpoint
' 4 CENter
' 8 NODe
' 16 QUAdrant
' 32 INTersection
' 64 INSertion
' 128 PERpendicular
' 256 TANgent
' 512 NEArest
' 1024 QUIck
' 2048 APParent Intersection
' 4096 EXTension
' 8192 PARallel
'
'To specify more than one object snap, enter the sum of their values.
'To find out the current bitcode combination you have, simply enter OSMODE
'and the number will be inside < >
'-------------------------------------------------------------------------
Dim iOsnapMode As Integer
Dim Linea As AcadLine
Dim Texto As AcadEntity
Dim Punto As Variant
Dim PtoInsercion As Variant

    ThisDrawing.Utility.GetEntity Linea, Punto, "Seleccione la línea para alineación"
    
    Dim Textos As AcadSelectionSet
    On Error Resume Next
     ThisDrawing.SelectionSets("TEXTOS").Delete
     Set Textos = ThisDrawing.SelectionSets.Add("TEXTOS")
    On Error GoTo 0
    Textos.SelectOnScreen
    
    ' Add objects to a selection set by prompting user to select on the screen
    '        Set Textos = ThisDrawing.SelectionSets.Add("textos")
    '  Selectonscreen(filtertype,filterdata)
    'Fyltertype
    '0 Object Type (String) Such as “Line,” “Circle,” “Arc,” and so forth.
    '2 Object Name (String) The table (given) name of a named object.
    '8 Layer Name (String)  Such as “Layer 0.”
    '60  Object Visibility (Integer)  Use 0 = visible, 1 = invisible.
    '62  Color Number (Integer)  Numeric index values ranging from 0 to 256.
    'Zero indicates BYBLOCK. 256 indicates BYLAYER. A negative value indicates that the layer is turned off.
    '67 Model/paper space indicator (Integer) Use 0 or omitted = model space, 1 = paper space.
    '
    'Filterdata="circle","text",etc.

    Dim InterseccPoint(x To z) As Double
    For Each Texto In Textos
        If InStr(LCase(Texto.ObjectName), "text") > 0 Then
            PtoInsercion = Texto.InsertionPoint
            With Linea
                Dim cosAng As Double
                cosAng = (PtoInsercion(x) - .StartPoint(x)) * (.EndPoint(x) - .StartPoint(x)) / .Length + _
                         (PtoInsercion(y) - .StartPoint(y)) * (.EndPoint(y) - .StartPoint(y)) / .Length + _
                         (PtoInsercion(z) - .StartPoint(z)) * (.EndPoint(z) - .StartPoint(z)) / .Length
                InterseccPoint(x) = .StartPoint(x) + cosAng * (.EndPoint(x) - .StartPoint(x)) / .Length
                InterseccPoint(y) = .StartPoint(y) + cosAng * (.EndPoint(y) - .StartPoint(y)) / .Length
                InterseccPoint(z) = .StartPoint(z) + cosAng * (.EndPoint(z) - .StartPoint(z)) / .Length
            End With 'Línea
            Texto.Move PtoInsercion, InterseccPoint
        End If
   Next Texto

End Sub ' AlinearTextoaLinea

1 respuesta

CaNaRy_r00lz #7 Jul '17 Inocente

#6 Como se ejecuta? y como puedo hacer para que ponga siempre el texto a la misma distancia de la línea, pk si te fijas en #2 ya tengo eso, pero me falta la distancia del texto a la línea

1 respuesta

kotapab #8 Jul '17

#7 Cómo se ejecuta: apretás "alt"+"F11" y se abre el editor de VBA. Pegás el texto, ponés el cursor dentro del texto de la macro, y apretás "play"/F5 para ejecutar la macro (también podés asignar la macro a un botón).

Es posible que tu Autocad necesite habilitar las macros VBA. Las instrucciones para hacer eso dependen de la versión de Autocad.

Distancia a la línea
El texto se va a mover sobre la línea, así que debés tener una línea allí. Con un simple offset, podés hacer una copia de la línea a la distancia deseada, y luego borrar la línea nueva.

Ojo: debe ser un objeto de tipo línea, no una polilínea.

1 respuesta

CaNaRy_r00lz #9 Jul '17 Inocente

#8 A ver, pero es que no quiero estar haciendo offset a mano, por eso quiero una rutina lisp, pk cuando me toca tengo que hacer eso como 300 veces, y para eso ya tengo al rutina que he puesto en #3, que me alinea el texto en la misma dirección que la línea, pero lo que quiero es hacerlo todo en una, alinar el texto, hacer match a las propiedades de la línea para ponerselas al texto y además meterle un offset de la línea

1 respuesta

kotapab #10 Jul '17

#9 ¿Y cómo sabés cuál es la distancia exacta? ¿Siempre es un número entero, o fácil de escribir, como 2 ó 3 metros, o en realidad tenés que medirla sobre el plano, y puede ser 10,3452567?

¿Y cuáles propiedades son las que copiás de la línea al texto? Layer, color... hay miles de propiedades (todas las que muestra la ventana propiedades).
Una respuesta sencilla sería todas las propiedades que copia el botón de "match properties"

1 respuesta

CaNaRy_r00lz #11 Jul '17 Inocente

#10 La distancia del texto a la línea es la que tú quieras darle, realmente es la escala a la que va a ser impreso multiplicado por 0.2mm que es la apreciacion del ojo humano, pero vamos que con darle una distancia "x" me vale, no necesito más

1 respuesta

kotapab #12 Jul '17

#11 Ah, había malinterpretado lo que querés hacer. La macro que te di antes mueve muchos textos hacia una línea, "alineándolos".

Lo que vos querés hacer es rotar el texto para que quede paralelo a la línea.

No sé si por "propiedades" querés decir lo que significa "propiedad" en Autocad: nombre del layer, color, tipo de línea, etc.

kotapab #13 Jul '17

No es muy complicado hacer una macro que haga eso, pero quizás lo más sencillo sea usar una dimensión en lugar de un texto. Podés crear un estilo de dimensión en donde no se impriman las líneas, y en donde configures la distancia.

Eso te serviría si vos escribís los textos a mano. Si en cambio ya recibis los textos, o ya los tenés en el plano, entonces sí, una macro sería mejor solución.

1 respuesta

CaNaRy_r00lz #14 Jul '17 Inocente

#13 Si, el comando es MATCHPROP o algo así, la cosa es que ya tengo líneas y texto, entonces tengo que igualar propiedades con las propiedades referencia, así todas las líneas de GAS , son iguales a la de referencia, y tb lo haces con el texto, pero claro el texto cuando lo exportas todo a autocad no viene siguiendo la línea, y si tienes 400 líneas con 1000 textos es un puto coñazo, por eso busco algo que coja el texto le de las propiedades de la línea referencia (capa, color, grosor) y luego lo alinee y lo deje a una distancia digamos de 3mm de la línea, y claro si tienes algo que sólo tienes que escribir RT por ejemplo y hacerlo ahorras muchíisimo tiempo

kotapab #15 Jul '17

Esta macro pide que el usuario marque puntos en la pantalla, escribe los textos en esos puntos, y te copia las coordenadas a Notepad

spoiler

Option Explicit

Sub NumerarPuntosYEscribirEnExcel()

Const x = 0
Const y = 1
Const z = 2

Const SeparadorCSV = ";"

Dim Punto As Variant
Dim N°Puntos As Long: N°Puntos = -1
Dim ListaDePuntos() As String

Dim AlturaNuevoTexto As Integer
On Error Resume Next
    AlturaNuevoTexto = ThisDrawing.Utility.GetInteger("Introduzca la altura del texto:")
    If AlturaNuevoTexto <= 0 Then Exit Sub
On Error GoTo 0

Do
    Set Punto = Nothing
    On Error Resume Next
    
        Punto = ThisDrawing.Utility.GetPoint(, "Seleccione un punto:")
        If Err Then
            Punto = Nothing
            Err.Clear
        Else
            N°Puntos = N°Puntos + 1
            ReDim Preserve ListaDePuntos(N°Puntos)
            ListaDePuntos(N°Puntos) = "Punto n° " & N°Puntos + 1 & SeparadorCSV & CStr(Punto(x)) & SeparadorCSV & CStr(Punto(y)) & SeparadorCSV & CStr(Punto(z))
            
            Dim NuevoTexto As AcadEntity
            NuevoTexto = ThisDrawing.ModelSpace.AddText("Punto n° " & N°Puntos + 1, Punto, AlturaNuevoTexto)
        End If 'err
        
    On Error GoTo 0
Loop While IsArray(Punto)

'Copiar al clipboard
CopyText Join(ListaDePuntos, vbCrLf)

'Ejecutar Notepad y pegar texto
Shell "notepad.exe", vbNormalFocus
SendKeys "^v"

End Sub 'NumerarPuntosYEscribirEnExcel

Sub CopyText(Text As String)
'VBA Macro using late binding to copy text to clipboard.
'By Justin Kay, 8/15/2014
Dim MSForms_DataObject As Object
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub

Rutina Lisp en Autocad

Usuarios habituales

Tags