11.12.2017 09:09

85794    

Merhaba Sayin Cizim Okulu üyeleri,

ekde gönderecegim eskiden kalma bir lisp programini ilave etmem gerekiyor.
Bu lisp Programi sectiginiz rakamlari yukari ve asagiya saymanizi sagliyor.
Ancak örnegin 185 rakamini -200 asagiya saydirirsam -15 ve -100 de 85 elde ediyorum.
Ama bana gereken -200 de -185 ve -100 de 085 yazmasi. Bunu nasil saglayabilirim? :dozingoff

---

; Increments the first postive number in a TEXT string by the given increment
;;; ================================================== ========================
;;; Program: INC.LSP ver 1.22
;;;
;;; Purpose: Increments the first postive number in a TEXT string by the given increment
;;;
;;; Syntax: INC
;;;
;;; Resolutions
;;; P.O. Box 1265
;;; Sumner WA 98390-0250
;;; 206-845-2200
;;;
;;; Date: 5/10/95
;;;
;;; Revisions: ver 1.1 8/7/95 Added support for REALs
;;;
;;; Revisions: ver 1.2 12/12/95 Added support for Stations
;;;
;;; Revisions: ver 1.21 12/14/95 Fixed problem with decimal places
;;;
;;; Revisions: ver 1.22 1/16/96 Fixed problem with decimal places when
;;; number is preceeded by alpha characters.
;;; ================================================== ========================
(defun C:INC (/ ; Functions & Variables
; Functions
val put r_fill getdp at
; Variables
ss inc i l e j k ascii_nr string newstring nr count dp1 dp
OldStation dp_pos end_pos
)
;=============================
; Entity assoc list utilities
;-----------------------------
(defun val (nr e) (cdr (assoc nr e)))
(defun put (x nr e)(subst (cons nr x) (assoc nr e) e))
;;; ================================================== ========================
;;; Function: AT
;;; Purpose : Returns the position of the first occurance of a string
;;; or NIL if not found
;;; Params : string String to search
;;; char String to locate
;;;
;;; Uses :
;;; --------------------------------------------------------------------------
(defun at (string char / i len clen)
(if string
(progn
(setq i 1 len (strlen string) clen (strlen char))
(while (and (<= i len) (/= (substr string i clen) char))
(setq i (1+ i))
)
(if (> i len)
(setq i nil)
)
(eval i)
)
)
)
;;; ================================================== ========================
;;; Function: R_FILL <string> <len>
;;; Purpose : Returns a string filled with spaces on the right
;;;
;;; Params : string String to fill
;;; len String length
;;;
;;; --------------------------------------------------------------------------
(defun r_fill (s len / space i)
(setq space "" i (- len (strlen s)))
(if (> i 0)
(substr (strcat s (repeat i (setq space (strcat space " ")))) 1 len)
s
)
)
;; Return number of decimal places of a REAL
(defun getdp (nr / n)
(setq n 0 nr (abs nr))
(while (null (equal (fix (+ nr 0.5)) nr 0.000001))
(setq n (1+ n))
(setq nr (* nr 10))
)
n
)
;;; ================================================== ========================
;-- Start C:TEXTINC
(setvar "CMDECHO" 0)
(princ "\nSelect TEXT containing NUMBERS to increment.")
(if (and
(setq ss (ssget '((0 . "*TEXT"))))
(setq inc (getreal "\nIncrement: "))
(/= inc 0)
)
(progn
(setq i 0 l (sslength ss) count 0)
(while (< i l)
(setq e (entget (ssname ss i)))
(setq string (val 1 e))
;; --- Check for an number ---
(if (and
(wcmatch string "*[0-9]*") ; Find an INT
; (wcmatch string "~*#.#*") ; No REALs
(wcmatch string "~*%%d*") ; No BEARINGS
)
(progn
(setq count (1+ count))
(setq j 1 k (strlen string))
(if (wcmatch string "*#+##*") ; Check for Station
(setq
OldStation string
j (at string "+")
string (strcat
(substr string 1 (1- j))
(substr string (1+ j))
)
j 1
k (strlen string)
)
)
;; --- Step though the string looking
;; --- for the first int ---
(while (<= j k)
(setq ascii_nr (ascii (substr string j 1)))
(if (and (>= ascii_nr 48)(<= ascii_nr 57))
(progn
(setq end_pos j)
(while (or (= ascii_nr 46)(and (>= ascii_nr 48)(<= ascii_nr 57)))
(setq
end_pos (1+ end_pos)
ascii_nr (ascii (substr string end_pos 1))
)
)
(setq
dp_pos (at (substr string j) ".")
nr (atof (substr string j))
dp1 (if dp_pos (- end_pos dp_pos j) 0)
dp (max dp1 (getdp inc))
nr (+ nr inc)
newstring (strcat
(substr string 1 (1- j))
(rtos nr 2 dp)
(substr string end_pos)
)
j k ;; Now exit
)
)
)
(setq j (1+ j))
)
;; If station then insert the "+"
(if OldStation
(progn
(setq string Oldstation)
(if (setq j (at newstring "."))
(setq j (- j 3))
(setq j (- (strlen newstring) 2))
)
(setq newstring
(strcat (substr newstring 1 j) "+"
(substr newstring (1+ j))
)
)
)
)
;; --- Echo changes to screen ---
(princ (strcat "\n" (r_fill string 12) "--> " newstring))
;; --- Update the TEXT entity ---
(entmod (put newstring 1 e))
)
(princ (strcat "\nNo Numeric value: " string))
)
(setq i (1+ i))
)
(princ (strcat "\n" (itoa count) " TEXT number\(s\) incremented."))
)
(princ "\nTEXTINC cancelled.")
)
(princ)
)
;(princ "\nTEXTINC.LSP v1.22")
(princ)