[DonJad]

Уважаемые Гуру, помогите пожалуйста!

Задача такая нарисовалась:

Есть блок с Атрибутами Num и NumN, нужно заполнить второй атрибут во вхождениях блоков значениями по формуле

NumN=Num-2.5

если Num<>''


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

[VVA]

Код:

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

(defun C:NumN ( / ss lst ret cnt)
  (vl-load-com)
  (setq cnt 0)
  (if (and
        (setq ss (ssget "_:L" '((0 . "INSERT")(66 . 1))))
        (setq lst (mapcar (function vlax-ename->vla-object)
	            (vl-remove-if (function listp)
		      (mapcar (function cadr) (ssnamex ss)))))
        )
        (progn
          (foreach item lst
             (if (setq ret (cdr(assoc "NUM" (get-all-atts item))))
               (progn
                 (mip-block-setattr-bylist item (list(cons "NUMN" (rtos (- (atof ret) 2.5) 2 2))))
                 (setq cnt (1+ cnt))
                 )
               )
            )
          )
        )
(princ "\nОбработано: ")
(princ cnt)
(princ " блоков")
(princ)    
)
(defun get-all-atts (obj)
  (if (and obj
           (vlax-property-available-p obj 'Hasattributes)
	   (eq :vlax-true (vla-get-HasAttributes obj))
	   
	   
      )
    (vl-catch-all-apply
      (function
	(lambda	()
	  (mapcar (function (lambda (x)
			      (cons (vla-get-TagString x)
				    (vla-get-TextString x)
			      )
			    )
		  )
		  (append (vlax-invoke obj 'Getattributes)
			  (vlax-invoke obj 'Getconstantattributes)
		  )
	  )
	)
      )
    )
  )
)

(defun mip-block-setattr-bylist (obj att_list / txt lst)
;; obj - Ename or Vla object of block
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;;                 Tag_Name - string
;;                    Value - string
  
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list))
  (if (and obj
           (not(vlax-erased-p obj))
           (= (vla-get-ObjectName obj) "AcDbBlockReference")
	   (eq :vlax-true (vla-get-HasAttributes obj))
	   (vlax-property-available-p obj 'Hasattributes)
	   (vlax-write-enabled-p obj)
      )
    (vl-catch-all-apply
      (function
	(lambda	()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list))
              (vla-put-TextString at (cdr lst))
            )
            )
          )
        )
      )
    )
  )
(defun mip-conv-to-str (dat) 
  (cond ((= (type dat) 'INT)(setq dat (itoa dat))) 
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12))) 
        ((null dat)(setq dat "")) 
        (t (setq dat (vl-princ-to-string dat)))))

[DonJad]

Спасибо огромное!!!


Просто пол дня жизни спасли!


Только по началу ругалась програмка маленько, на недоступность функции:
;mip-conv-to-str

Но поиск штук полезный, нашел и добавил:

Код:

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

(defun C:NumN ( / ss lst ret cnt)
  (vl-load-com)
  (setq cnt 0)
  (if (and
        (setq ss (ssget "_:L" '((0 . "INSERT")(66 . 1))))
        (setq lst (mapcar (function vlax-ename->vla-object)
	            (vl-remove-if (function listp)
		      (mapcar (function cadr) (ssnamex ss)))))
        )
        (progn
          (foreach item lst
             (if (setq ret (cdr(assoc "NUM" (get-all-atts item))))
               (progn
                 (mip-block-setattr-bylist item (list(cons "NUMN" (rtos (- (atof ret) 2.5) 2 2))))
                 (setq cnt (1+ cnt))
                 )
               )
            )
          )
        )
(princ "\nОбработано: ")
(princ cnt)
(princ " блоков")
(princ)    
)
(defun get-all-atts (obj)
  (if (and obj
           (vlax-property-available-p obj 'Hasattributes)
	   (eq :vlax-true (vla-get-HasAttributes obj))
	   
	   
      )
    (vl-catch-all-apply
      (function
	(lambda	()
	  (mapcar (function (lambda (x)
			      (cons (vla-get-TagString x)
				    (vla-get-TextString x)
			      )
			    )
		  )
		  (append (vlax-invoke obj 'Getattributes)
			  (vlax-invoke obj 'Getconstantattributes)
		  )
	  )
	)
      )
    )
  )
)

(defun mip-block-setattr-bylist (obj att_list / txt lst)
;; obj - Ename or Vla object of block
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;;                 Tag_Name - string
;;                    Value - string
  
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list))
  (if (and obj
           (not(vlax-erased-p obj))
           (= (vla-get-ObjectName obj) "AcDbBlockReference")
	   (eq :vlax-true (vla-get-HasAttributes obj))
	   (vlax-property-available-p obj 'Hasattributes)
	   (vlax-write-enabled-p obj)
      )
    (vl-catch-all-apply
      (function
	(lambda	()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list))
              (vla-put-TextString at (cdr lst))
            )
            )
          )
        )
      )
    )
  )
  
  (defun mip-conv-to-str (dat) 
  (cond ((= (type dat) 'INT)(setq dat (itoa dat))) 
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12))) 
        ((null dat)(setq dat "")) 
        (t (setq dat (vl-princ-to-string dat)))))

[VVA]

Как всегда, забываю библиотечные функции