Copyright © 2004-2022 SQL: 1.175 saniye - Sorgu: 43 - Ortalama: 0.02731 saniye
cadmanager |
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)
|