помогите по макросу автоматическое прибавление целого числа всем выбранным числам

timofeev_08 · 03.08.2012, 12:32

привет всем, столкнулся с проблемой , сам не особо в лиспе понимаю ... работаю проектировщиком в связи, потребовалось настроить макрос для автоматического прибавление числа всем выбранным числам, такой нашелся , но хотелось чтобы ещё можно было прибавлять не только целое число , но ещё и вещественное к выбранным числа... сделать не могу. вот код макроса

Код:

[Выделить все]

 
(defun c:nj () sel num qsel ent aa tt t1 n nn t2 t3  

;pick an object

(setq sel (ssget '((0 . "text"))))    ;picks text objects
(if (/= sel nil)
 (progn
 (setq num (getint "enter the number of increase or decrease : "))       ; gets number from user
 (setq qsel (sslength sel))            ;counts the number of text objects 
 (setq qsel (- qsel 1))                ;
  (repeat (+ qsel 1)                   ;starts loop of objects
  (setq ent (ssname sel qsel))         ;gets name of first object   
  (setq aa (entget ent))               ;gets info on the object


  (setq tt (assoc 1 aa))                ;gets text info
     (setq t1 (cdr tt))                 ;gets clear text
     (setq n (atoi t1))                 ;translates text into an integer
     
   
 
      (setq nn (+ n num))             ;sets nn as the new number
      (setq t3 (itoa nn))             ;translates number into text
      
      
      
      
      

  ;makes the switch

  (setq aa                              ;switches the original text (t1) with modified (t3) 
    (subst (cons 1 t3)
     (assoc 1 aa)    
      aa
      )
  )
  (entmod aa)                           ;updates entity
  (entupd ent)
 (setq qsel (- qsel 1))                ;countdown to the next entity
  )


(princ)
)
)
)

что нужно добавить в этот код? подскажите люди добрые

5hev · 03.08.2012, 12:41

Код:

[Выделить все]

  
(defun c:nj () sel num qsel ent aa tt t1 n nn t2 t3  

;pick an object

(setq sel (ssget '((0 . "text"))))    ;picks text objects
(if (/= sel nil)
 (progn
 (setq num (getreal "enter the number of increase or decrease : "))       ; gets number from user
 (setq qsel (sslength sel))            ;counts the number of text objects 
 (setq qsel (- qsel 1))                ;
  (repeat (+ qsel 1)                   ;starts loop of objects
  (setq ent (ssname sel qsel))         ;gets name of first object   
  (setq aa (entget ent))               ;gets info on the object


  (setq tt (assoc 1 aa))                ;gets text info
     (setq t1 (cdr tt))                 ;gets clear text
     (setq n  (* 1.0 (atof t1)))                 ;translates text into an integer
     
   
 
      (setq nn (+ n num))             ;sets nn as the new number
      (setq t3 (rtos nn 2 2))             ;translates number into text
      
      
      
      
      

  ;makes the switch

  (setq aa                              ;switches the original text (t1) with modified (t3) 
    (subst (cons 1 t3)
     (assoc 1 aa)    
      aa
      )
  )
  (entmod aa)                           ;updates entity
  (entupd ent)
 (setq qsel (- qsel 1))                ;countdown to the next entity
  )


(princ)
)
)
)

Кулик Алексей aka kpblc · 03.08.2012, 12:46

5hev[ru], форматирование цветом снимай. Или снимай тэг lisp.

timofeev_08 · 03.08.2012, 12:50

спасибо за ответ... только у меня после этого следующая проблема возникла, к выбранному вещественному числу прибавляет , только результат неправильный , я так понимаю что выбранное вещественное число округляется до целого и поэтому не правильный ответ.. где тут надо и на что поменять объявление типов выбранных объектов?

Кулик Алексей aka kpblc · 03.08.2012, 13:02

Попробуй (я не проверял - некогда):

Код:

[Выделить все]

 (vl-load-com)

(defun c:nj1 (/ adoc ss value ent err)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (= (type (setq ss (vl-catch-all-apply
                               (function
                                 (lambda ()
                                   (ssget "_:L" '((0 . "TEXT")))
                                   ) ;_ end of LAMBDA
                                 ) ;_ end of function
                               ) ;_ end of VL-CATCH-ALL-APPLY
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           (= (type (setq value (vl-catch-all-apply
                                  (function
                                    (lambda ()
                                      (getreal "\nEnter value to descrease or increase <Cancel> : ")
                                      ) ;_ end of LAMBDA
                                    ) ;_ end of function
                                  ) ;_ end of VL-CATCH-ALL-APPLY
                          ) ;_ end of setq
                    ) ;_ end of type
              'real
              ) ;_ end of =
           ) ;_ end of and
    (foreach ent (vl-remove-if-not
                   (function
                     (lambda (x)
                       (= (rtos (atof (cdr (assoc 1 (entget x)))) 2)
                          (cdr (assoc 1 (entget x)))
                          ) ;_ end of =
                       ) ;_ end of lambda
                     ) ;_ end of function
                   ((lambda (/ tab item)
                      (repeat (setq tab  nil
                                    item (sslength ss)
                                    ) ;_ end setq
                        (setq tab (cons (ssname ss (setq item (1- item))) tab))
                        ) ;_ end of repeat
                      ) ;_ end of lambda
                    )
                   ) ;_ end of vl-remove-if-not
      (if (vl-catch-all-error-p
            (setq err (vl-catch-all-apply
                        (function
                          (lambda ()
                            (entmod (subst (cons 1 (+ (atof (cdr (assoc 1 (entget ent)))) value))
                                           (assoc 1 (entget ent))
                                           (entget ent)
                                           ) ;_ end of subst
                                    ) ;_ end of entmod
                            (entupd ent)
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
            ) ;_ end of vl-catch-all-error-p
        (princ (strcat "\n** error proceed entity with text \""
                       (cdr (assoc 1 (entget ent)))
                       "\" : "
                       (vl-catch-all-error-message err)
                       ) ;_ end of strcat
               ) ;_ end of princ
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

timofeev_08 · 03.08.2012, 13:06

ругается... выдается следующую ошибку "bad argument type: lselsetp nil"

Кулик Алексей aka kpblc · 03.08.2012, 13:37

Подправил. На дальнейшие изменения меня точно не хватит

Времени нет

timofeev_08 · 03.08.2012, 13:43

к сожалению не работает все равно ... и на этом спасибо, что ответил на тему

Лиспер · 03.08.2012, 13:58

А еслс так:

Код:

[Выделить все]

(vl-load-com)

(defun c:nj1 (/ adoc ss value ent err)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (= (type (setq ss (vl-catch-all-apply
                               (function
                                 (lambda ()
                                   (ssget "_:L" '((0 . "TEXT")))
                                   ) ;_ end of LAMBDA
                                 ) ;_ end of function
                               ) ;_ end of VL-CATCH-ALL-APPLY
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           (= (type (setq value (vl-catch-all-apply
                                  (function
                                    (lambda ()
                                      (getreal "\nEnter value to descrease or increase <Cancel> : ")
                                      ) ;_ end of LAMBDA
                                    ) ;_ end of function
                                  ) ;_ end of VL-CATCH-ALL-APPLY
                          ) ;_ end of setq
                    ) ;_ end of type
              'real
              ) ;_ end of =
           ) ;_ end of and
    (foreach ent (vl-remove-if-not
                   (function
                     (lambda (x)
                       (= (rtos (atof (cdr (assoc 1 (entget x)))) 2)
                          (cdr (assoc 1 (entget x)))
                          ) ;_ end of =
                       ) ;_ end of lambda
                     ) ;_ end of function
                   ((lambda (/ tab item)
                      (repeat (setq tab  nil
                                    item (sslength ss)
                                    ) ;_ end setq
                        (setq tab (cons (ssname ss (setq item (1- item))) tab))
                        ) ;_ end of repeat
                      ) ;_ end of lambda
                    )
                   ) ;_ end of vl-remove-if-not
      (if (vl-catch-all-error-p
            (setq err (vl-catch-all-apply
                        (function
                          (lambda ()
                            (entmod (subst (cons 1 (rtos (+ (atof (cdr (assoc 1 (entget ent)))) value) 2))
                                           (assoc 1 (entget ent))
                                           (entget ent)
                                           ) ;_ end of subst
                                    ) ;_ end of entmod
                            (entupd ent)
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
            ) ;_ end of vl-catch-all-error-p
        (princ (strcat "\n** error proceed entity with text \""
                       (cdr (assoc 1 (entget ent)))
                       "\" : "
                       (vl-catch-all-error-message err)
                       ) ;_ end of strcat
               ) ;_ end of princ
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Проверять лениво.

timofeev_08 · 03.08.2012, 14:04

к целым добавляет, а к вещественным нет , и ни какое сообщение не выдает , макрос просто прекращается... да и почему то когда к целому прибавляю вещественное число, записывает с точкой , а не с запятой, как в прошлом макросе

5hev · 03.08.2012, 14:27

Короче

Код:

[Выделить все]

 (vl-load-com)
(defun c:nj  (/ num sel en)
  (if (/= (setq sel (ssget '((0 . "text")))) nil)
    (progn
      (setq num (getreal "enter the number of increase or decrease : "))
      (while sel
	(vla-put-textstring
	  (vlax-ename->vla-object (setq en (ssname sel 0)))
	  (rtos
	    (+ num (* 1.0 (atof (vl-string-subst "." "," (cdr (assoc 1 (entget (ssname sel 0))))))))
	    2 2)
	  )
	(ssdel en sel))
      (princ)
      )
    )
  )

timofeev_08 · 03.08.2012, 14:39

как все просто оказывается

... все работает , спасибо огромное 5hev[ru] ... и все кто помогал решить данную проблему