01.12.2014 16:35    

espanolun
selamlar, alttaki lispte seçilen textlerdeki sayılar çarpılıyor. ancak benim şöyle bir şeye ihtiyacım var. tüm sayılar çarpılacak, en son çıkan değer 100'e bölünecek. bunu yapamadım. yardımcı olursanız sevinirim.
Kod:

(defun c:CCC (/ dpp odz tpLn L n txh pvt m o rsLt tpLm)
  (command "undo" "group") (setvar "cmdecho" 0)
  (defun *error* (er)
    (setvar "dimzin" odz) (setvar "Luprec" oLp) (command "_.undo" "e"))
  (if (not oLp) (setq oLp (getvar "luprec")))
(if (setq dpp (getint (strcat "\nOndalık Basamak Sayısı <" (itoa oLp) ">: ")))
    (setq oLp dpp) (setq dpp oLp)) (setq odz (getvar "dimzin"))
  (setvar "luprec" dpp) (setvar "dimzin" 0)
  (princ "\n  carpilacak sayıları seçiniz")
  (setq tpLn (ssget (list (cons 0 "*text")))
        L (sslength tpLn) n -1 rsLt nil
        txh (cdr (assoc 40 (entget (ssname tpLn 0)))))
  (while (< (setq n (1+ n)) L)
    (setq pvt (cdr (assoc 1 (entget (ssname tpLn n)))) m (strlen pvt) o 0)
    (while (<= (setq o (1+ o)) m)
      (if (= (substr pvt o 1) (chr 44))
        (setq pvt (strcat (substr pvt 1 (1- o)) (chr 46)
                          (substr pvt (1+ o) (- m o)))))
      (if (or (< (ascii (substr pvt o 1)) 44) (> (ascii (substr pvt o 1)) 57))
        (setq pvt (strcat (substr pvt 1 (1- o)) (substr pvt (1+ o) (- m o)))
              m (strlen pvt) o (1- o))))
    (if rsLt (setq rsLt (* rsLt (atof pvt))) (setq rsLt (atof pvt))))
  (princ "\n    yazılacak texti seçiniz")
  (while (/= 3 (car (setq sp (grread t 4 2)))))
  (setq sp (cadr sp) np (list (car sp) (cadr sp)) tpLm (ssget np))
  (if tpLm (progn (setq tpLm (entget (ssname tpLm 0)))
             (if (or (= (cdr (assoc 0 tpLm)) "TEXT")
                     (= (cdr (assoc 0 tpLm)) "MTEXT"))
            (progn (setq tpLm (subst (cons 1 (rtos rsLt)) (assoc 1 tpLm) tpLm))
                 (entmod tpLm) (entupd (cdr (assoc -1 tpLm))))))
    (entmake (list (cons 0 "text") (cons 10 sp) (cons 50 0) (cons 40 txh)
                   (cons 1 (rtos rsLt)))))
   (command "undo" "e") (setvar "dimzin" odz) (setvar "Luprec" oLp) (prin1)
)

admin (01.12.2014 18:51 GMT)

01.12.2014 16:40    

Travaci
(setq rsLt (atof pvt)) bu satırı (setq rsLt (/ (atof pvt) 100)) bununla değiştirin.

02.12.2014 08:04    

espanolun
Alıntı
Travaci :
(setq rsLt (atof pvt)) bu satırı (setq rsLt (/ (atof pvt) 100)) bununla değiştirin.



çok teşekkür ederim:)

> 1 <
Copyright © 2004-2022 SQL: 0.969 saniye - Sorgu: 47 - Ortalama: 0.02063 saniye