[编程交流] 文本问题

;Setup the variables - variable names and comments in portuguese, sorry
(setq raio 2.0)
(setq altura 1.5)
(setq dx 1.0)
(setq dy 3.0)
(setq angulo 0.0)
(setq prefixo "PV")
(setq proximopv 1)

(defun c:criaPVs(/ pts e pt pvmax); 
(vl-load-com); Garante que o ActiveX esteja ligado
(setq e (car (entsel "\nClique na polyline")))
; cria uma lista com os pontos
; os pontos são os elementos da polilinha sob o índice 10
(setq pts (mapcar 'cdr; elimina os primeiros elementos - os índices - de cada ponto da lista a ser criada
        ; cria uma lista com as propriedades da polilinha, removendo tudo o que não for ponto
        (vl-remove-if-not
                (function (lambda (pt) (= (car pt) 10)))
                (entget e)
        )
        );esse parêntese é do mapcar
)
(setq pvmax (+ (length pts) (- proximopv 1)))
(foreach pt pts
        (setq txt (settexto proximopv pvmax)); define o texto a colocar no PV
        (despv pt raio altura dx dy angulo txt);cria o PV
)
)

(defun despv(ponto raio altura dx dy angulo texto); desenha o pv, com círculo e texto
(if (> raio 0)
        (command "circle" ponto raio)
)
(command "text" (mapcar '+ ponto (list dx dy)) altura angulo texto)
(setq proximopv (+ proximopv 1));atualiza o contador
)

(defun addzeros(nz / tx);cria um texto com tantos zeros quanto entrados em nz
(setq tx "")
(while (> nz 0)
        (setq tx (strcat tx "0"))
        (setq nz (- nz 1))
)
tx
)

(defun countdigits(n / nd); conta quantos dígitos tem um número
(if (< n 10)
        (setq nd 1)
        (setq nd (+ 1 (countdigits (/ n 10))))
)
nd
)

(defun settexto(cont vlrmax / txt); define o texto a ser escrito no pv
;concatena o prefixo, os zeros que compõem o número e o número
(setq txt (strcat prefixo (addzeros(- (countdigits vlrmax) (countdigits cont))) (itoa cont)))
txt
)

; pline co-ords example
; By Alan H
(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)
(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq len (length co-ords))
(setq numb (/ len 2)) ; even and odd check required
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
; odd (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here
(defun c:labelpoly ( / ent x y co-ordsxy pt )
(while (setq ent (car (entsel "\nPlease pick pline <Cr> to exit")))
(setq co-ords (getcoords ent))
(co-ords2xy) ; list of 2d points making pline
(setq co-ordsxy (reverse co-ordsxy))
(setq x (Getint "Enter start number"))
(setq y 0)
(repeat (length co-ordsxy)
(setq pt (list (nth 0 (nth y co-ordsxy))(nth 1 (nth y co-ordsxy))))
(if (< x 10) 
(setq newstr2 (strcat "0" (rtos x 2 0)))
(setq newstr2 (rtos x 2 0))
)
(command "-text" pt 2.5 90 newstr2)
(command "circle" pt 5)
(setq y (+ y 1))
(setq x (+ x 1))
)
)
)