LISP na cislovanie

[arch Profil]

Zdravim
zisiel by sa prikaz, ktory by vkladal text, ale po kliknuti by bol vzdy o jedno (pripadne inu hodnotu) vacsi, napriklad:
- ked cislujem konstrukcnu os, dajme tomu od 1 - do 18, napisme jednotku, skopirujem a stale musim prepisovat cisla, a predstava je taka, ze by som vybral prikaz, zadal premennu o ktoru sa to ma zvcasovat a uz len klikal na umiestnenie cisla

[JanP]

Dobrý deň,

Urobil som taký jednoduchý LISP
...nemá ošetrené chybové stavy ...a dá sa donekonečna vylepšovať - ale funguje.

Po načítaní buď budete používať príkazy, alebo najlepšie bude ak si urobíte ikonky.

funkcia NastavCislo: zadáte počiatočné číslo
funkcia NastavPrírastok: zadáte prírastok (môže byť aj záporný)
funkcia NastavPredponu: zadajte text ktorý bude pred číslom
funkcia NastavPríponu: zadajte text ktorý bude za číslom
funkcia Ciselnytext: vypise text (aktuálnym text.štýlom aktuálnou výškou a do aktuálnej hladiny) v tvare: PredponaCisloPripona
a následne upraví číslo do tvaru cislo=cislo+prirastok - tj. po opätovnom spustení funkcie už bude text obsahovať nové číslo

Pozn:
Pri prvom spustení funkcie Ciselnytext kedy este nie je zadane cislo, prirastok, predpona a pripona - budete vyzvani na ich zadanie
Cislo, Prirastok, Predpona a Pripona - ako samostatne funkcie su len na dodatočnú zmenu uvedených parametrov

A tu je LISP:

Kód: Vybrat vše

(defun c:NastavCislo ()
  (setq tsACislo (getreal "\nZadajte aktuálne číslo: "))
  (princ)
)
(defun c:NastavPrirastok ()
  (setq tsPrirastok (getreal "\nZadajte prírastok: "))
  (princ)
)
(defun c:NastavPredponu ()
  (setq tsPredpona (getstring T "\nZadajte predponu: "))
  (princ)
)
(defun c:NastavPriponu ()
  (setq tsPripona (getstring T "\nZadajte príponu: "))
  (princ)
)

(defun c:Ciselnytext (/ p1 tsText)
 (if (not tsPredpona) (setq tsPredpona (getstring T "\nZadajte predponu: ")))
 (if (not tsPripona) (setq tsPripona (getstring T "\nZadajte príponu: ")))
 (if (not tsACislo)  (setq tsACislo (getreal "\nZadajte aktuálne číslo: ")))
 (if (not tsPrirastok)  (setq tsPrirastok (getreal "\nZadajte prírastok: ")))

 (while (not (setq p1 (getpoint "\nZadajte bod umiestnenia textu: ")))
    (prompt "\nChyba: Skúste zadat znovu."))

 (setq tsText (strcat tsPredpona (rtos tsACislo 2) tsPripona))
 (setq ent (entmakex
                  (list '(0 . "TEXT")
                        (cons 10 p1)
         (cons 40 (getvar "TEXTSIZE"))
                        (cons 8 (getvar "CLAYER"))
                        (cons 7 (getvar "TEXTSTYLE"))
                        (cons 1 tsText)
                  )
                )
      )
  (setq tsACislo (+ tsACislo tsPrirastok))
)