(defun c:test ( / alt-texto lent nent vrts cont objt angAnt angSig angulo angmen angmay angmed rotar ptoAtt)
(setq alt-texto 2.5)
;definir un bloque sencillo. Se puede cambiar por un nombre fijo de uno que ya existe
(if (null (tblsearch "BLOCK" "Auto-PI-Vertice"))
(mapcar 'entmake
'( ((0 . "BLOCK")(100 . "AcDbEntity")(100 . "AcDbBlockBegin")(70 . 0)(2 . "Auto-PI-Vertice")(10 0 0 0))
((0 . "LINE")(8 . "Auto-PI-Vertice")(62 . 0)(10 0.5 0. 0.)(11 5. 0. 0.))
((0 . "CIRCLE")(8 . "Auto-PI-Vertice")(62 . 0)(10 0. 0. 0.)(40 . 0.5))
((0 . "ENDBLK")(100 . "AcDbEntity")(100 . "AcDbBlockEnd"))
)
)
)
(if (= "LWPOLYLINE" (cdr (assoc 0 ;Verificación de que la entidad sea una lwply
;Seleccionar una polilínea liviana
(setq nent (car (entsel "Seleccione una polilínea:"))
lent (entget nent)
))))
(progn
;extraer vértices
(setq vrts (mapcar 'cdr (vl-remove-if '(lambda(A)(/= (car A) 10))lent))
;Contador de vértice
cont 0
;Objeto activX para obtener angulos
objt (vlax-ename->vla-object nent)
)
;iterar por cada vértice
(while (setq vert (car vrts))
(setq vrts (cdr vrts) ;Ir reduciendo vértices por analizar
;Calcular el ángulo de inserción del bloque (y rotación del texto)
;Esto lo complicamos usando vlax-curve-getFirstDeriv en vez de solo (angle pt1 pt2) para que si la poli tiene curvas
;los ángulos sean perpendiculares a las tangencias (de la poli, no neceariamente de ejes viales)
angAnt (if (> cont 0)
(rem (+ (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv objt (- cont 0.01))) pi) (* 2 pi)) ;angulo del tramo anterior
)
angSig (if vrts
(angle '(0. 0. 0.) (vlax-curve-getFirstDeriv objt (+ cont 0.01))) ;angulo del tramo siguiente
)
angulo (cond ;aangulo medio para el bloque
( (null angAnt) ;si es el primer tramo
(rem (+ angSig (/ pi 2)) (* 2 pi)) ;irá perpendicular a este por la izquierda
)
( (null angSig) ;si es el ultimo tramo
(rem (+ angAnt (* pi 1.5)) (* 2 pi)) ;irá perpendicular al mismo por la izq
)
; Si es intermedio calcular la mediatriz del lado más abierto
( (setq angmen (min angAnt angSig)
angmay (max angAnt angSig)
angmed (/ (- angmay angmen) 2)
)
(rem
(if (< angmed (/ pi 2))
(+ angmay pi (- angmed))
(+ angmen angmed)
)
(* 2 pi)
)
)
)
;si se debe rotar el atributo para que no quede de cabeza
rotar (< (/ pi 2) angulo (* pi 1.5))
;Punto de insercion del atributo
ptoAtt (polar vert angulo (* alt-texto 1.2))
;avanzar el contador de vértices (se pone aquí porque el parámetro para vlax-curve-getFirstDeriv
;inicia en 0 pero la numeración de atributos inicia en 1)
cont (1+ cont)
)
;Insertar el bloque
(entmake (list '(0 . "INSERT")
'(2 . "Auto-PI-Vertice")
(cons 10 vert) ;posición
(cons 50 angulo) ;rotación
(cons 41 alt-texto) ;escala en función
(cons 42 alt-texto) ;de la altura del
(cons 43 alt-texto) ;texto indicada
'(66 . 1) ;Incluye atributos
)
)
;Crear el atributo
(entmake (list
'(0 . "ATTRIB")
'(410 . "Model")
(cons 10 ptoAtt)
(cons 1 (strcat "PI: " (itoa cont)))
'(7 . "STANDARD")
(cons 72 (if rotar 2 0))
(cons 11 ptoAtt)
'(2 . "P.I.")
(cons 40 alt-texto)
'(70 . 0)
(cons 50 (+ angulo (if rotar pi 0)))
'(74 . 1)
'(280 . 1)
)
)
;finalizan antributos
(entmake '((0 . "SEQEND")(100 . "AcDbEntity")))
)
)
(alert "No seleccionó una polilínea válida")
)
(princ)
)
, les dejo una pequeña rutina pero precedida de algunas anotaciones al respecto de este tema
) permite copiar atributos según entiendo