Массовое изменение свойств атрибутов блоков

(defun c:AttrProptis ()
;;* ==================================================================================================================================
;;* С помощью данной проги можно:  
;;* 1. Изменять координаты точки вставки видимых атрибутов блоков, задавая относительные смещения по вертикали и горизонтали
;;*    с помощью ползунков или числом.
;;* 2. Изменять высоту текста атрибута
;;* 3. Изменять высоту угол наклона текста атрибута  
;;* 4. Изменять угол поворота текста атрибута
;;* 5. Помещать атрибуты на отдельный слой чертежа из предлагаемых в выпадающем списке.
;;*    Последнее позволяет скрыть атрибуты, если слой сделать невидимым.
;;* 6. Изменять цвета атрибутов.
;;* 7. При наличии нескольких видимых атрибутов свойства каждого можно изменять индивидуально.  
;;* Блоки с видимыми атрибутами можно выбрать заранее (неважно, если в выбор попадут другие объекты чертежа - сработает фильтр).
;;* Затем в окне диалога меняем свойства (например, задаем смещения вверх-вниз, влево-вправо точки вставки атрибута.
;;* После закрытия окна диалога выбор не сбрасывается, текущие значения запоминаются, можно продолжать от достигнутого.
;;* ==================================================================================================================================  
(vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

  (vla-startundomark adoc)
  (princ "\nВыберите блоки (с видимыми атрибутами) (Enter - завершить) ")
  (if (not
    (setq objSet (ssget "_I" '((0 . "INSERT") (66 . 1))))
      )                    ;(ssget "_I" '((0 . "INSERT")))))
    (progn (princ "\nВыберите блоки (с видимыми атрибутами) (Enter - завершить) ")
       (setq objSet (ssget '((0 . "INSERT") (66 . 1))))
    )
  )                    ; end if
  (setq Tag_Attr_list nil)
    (setq item (ssname objSet 0))
    (foreach sub_item
         (vlax-safearray->list
           (vlax-variant-value
         (vla-getattributes (vlax-ename->vla-object item))
           ) ;_ end of vlax-variant-value
         ) ;_ end of vlax-safearray->list
      (if (= (vla-get-Invisible sub_item) :vlax-false)
    (progn
        (setq Tag_Attr_list (append Tag_Attr_list (list (vla-get-tagstring sub_item))))
    ) ;_ end of progn
      ) ;_ end if
    ) ;_ end of foreach
  (setq Layers_list nil)
  (vlax-for Item (vla-get-layers adoc)
    (setq Layers_list (append Layers_list (list (vla-get-name Item))))
  )
  (setq Layers_list (cons "" Layers_list))
  (setq Attr_List (AttrInsert))
  (setq Tag_Attr_Name (nth 0 Attr_List)) ; имя изменяемого видимого атрибута
  (setq Height (nth 1 Attr_List)) ; высота текста атрибута 
  (setq TextAngle (nth 2 Attr_List)) ; угол наклона текста атрибута
  (setq TextRotation (nth 3 Attr_List)) ; угол вращения текста атрибута
  (setq TextColor (nth 4 Attr_List)) ; цвет текста атрибута
  (setq Layer_Name (nth 5 Attr_List)) ; слой
  (setq shift_All (cddr (cddddr Attr_List))) ; смещения координат точки вставки атрибута
  
  (while (and objSet
          (> (sslength objSet) 0)
     ) ;_ end of and
    (setq item (ssname objSet 0))
    (ssdel item objSet)
    (foreach sub_item
         (vlax-safearray->list
           (vlax-variant-value
         (vla-getattributes (vlax-ename->vla-object item))
           ) ;_ end of vlax-variant-value
         ) ;_ end of vlax-safearray->list
      (if (= (vla-get-tagstring sub_item) Tag_Attr_Name) ; имя видимого атрибута совпадает с выбранным?
    (progn
      (setq    insertionpoint (vlax-safearray->list
               (vlax-variant-value
             (vla-get-insertionpoint sub_item)
               )
             )
      )
      (setq oldAlign (vla-get-Alignment sub_item))    ; запомнить выравнивания текста
      (setq    oldAlignTextPoint
         (vlax-safearray->list
           (vlax-variant-value
             (vla-get-TextalignmentPoint sub_item)
           )
         )
      )
      (vla-put-insertionpoint
        sub_item
        (vlax-3d-point (mapcar '+ shift_All insertionpoint))
      )
      (if (/= oldAlign acAlignmentLeft)    ; восстанавливать вторую точку выравнивания текста, если выравнивание - не влево
        (vla-put-TextalignmentPoint
          sub_item
          (vlax-3d-point
        (mapcar '+ shift_All oldAlignTextPoint)
          )
        )
      )
      (if (/= TextAngle nil) 
        (vla-put-ObliqueAngle sub_item (angtof TextAngle 0))
      )
      (if (/= TextRotation nil) 
        (vla-put-rotation sub_item (angtof TextRotation 0))
      )
      (if (> Height 0)
              (vla-put-height sub_item Height)
      )
      (if (/= TextColor nil) 
              (vla-put-color sub_item TextColor)
      )
      (if (/= Layer_Name nil) 
              (vla-put-Layer sub_item Layer_Name)
      )
    ) ;_ end of progn
      ) ;_ end if
    ) ;_ end of foreach
  ) ;_ end of while
  (vla-endundomark adoc)
)
(defun TagAttributes ( / )
  ; получение списка видимых атрибутов блока
  (setq Tag_list nil)
    (setq item (ssname objSet 0))
    (foreach sub_item
         (vlax-safearray->list
           (vlax-variant-value
         (vla-getattributes (vlax-ename->vla-object item))
           ) ;_ end of vlax-variant-value
         ) ;_ end of vlax-safearray->list
      (if (= (vla-get-Invisible sub_item) :vlax-false)
    (progn
        (append (list (vla-get-tagstring sub_item)))
    ) ;_ end of progn
      ) ;_ end if
    ) ;_ end of foreach
)  
(defun AttrInsert( / )
;;;>> Восстановление начальных значений переменных 
  (setq Height 0)
  
  (if (not veb_sl_Left)(setq veb_sl_Left "0"))
  (if (not veb_sl_Right)(setq veb_sl_Right "0"))
  (if (not veb_sl_Up)(setq veb_sl_Up "0"))
  (if (not veb_sl_Down)(setq veb_sl_Down "0"))
  
;;;--- Загрузать файл DCL и поместить его имя в dcl_id
(setq dcl_id (load_dialog "AttrDialog.dcl"))
;;;--- Если этот файл еще не загружен,
;;;--- то открыть его, иначе - выйти  
(if (not (new_dialog "AttrInsert" dcl_id)
    ); конец not
    (exit);если не обнаружен диалог - выход
); конец if
;;;>> Восстановление сохраненных значений переменных   

(set_tile "eb_sl_Left" veb_sl_Left)
(set_tile "eb_sl_Right" veb_sl_Right)
(set_tile "eb_sl_Up" veb_sl_Up)
(set_tile "eb_sl_Down" veb_sl_Down)

(setq middle_sliders (/ (atoi (get_attr "sl_Horizontal" "max_value")) 2))
(setq text_middle_sliders (itoa middle_sliders))

(if (not vsl_Left)(setq vsl_Left text_middle_sliders))
(set_tile "sl_Horizontal" vsl_Left)  

(if (not vsl_Right)(setq vsl_Right text_middle_sliders))
(set_tile "sl_Horizontal" vsl_Right)
  
(if (not vsl_Up)(setq vsl_Up text_middle_sliders))
(set_tile "sl_Vertical" vsl_Up)
  
(if (not vsl_Down)(setq vsl_Down text_middle_sliders))
(set_tile "sl_Vertical" vsl_Down)

(setq TextColor nil)

(setq Tag_Attr_index "0")
(setq Tag_Attr_Name (nth 0 Tag_Attr_list))
(setq Layers_index "0")
(setq Layer_Name nil)
;;; Заполнение выпадающего списка именами видимых атрибутов блока
(start_list "Tag_Attr_list")
   (mapcar 'add_list Tag_Attr_list)
(end_list)
(set_tile "Tag_Attr_list" Tag_Attr_index)
;;; Заполнение выпадающего списка именами слоев чертежа
(start_list "Layers_list")
   (mapcar 'add_list Layers_list)
(end_list)
(set_tile "Layers_list" Layers_index)
  
;;;--- Если нажата кнопка "cancel"
;;;--- выполнить функцию (done_dialog), установить флаг act = nil
(action_tile "cancel" "(setq act nil)(done_dialog)"
);конец actio_tile 'сancel'
  
;;;--- Если нажата кнопка "accept"
;;;--- выполнить функцию (done_dialog), установить флаг act =T (true)
(action_tile "accept"  
    "(setq act T)(done_dialog))"
); конец action_tile 'accept'
(start_dialog)            ;Показать Диалоговое окно
(unload_dialog dcl_id)    ;Закрыть Диалоговое окно
  
;;;--- Если выбрана кнопка "cancel"
;;;--- показать сообщение об отмене
(if (= act nil)
      (exit)
); конец if
;;;--- Если выбрана кнопка "accept"
;;;--- показать сообщение об успешном выполнении
(if (= act T)
      (rem_shift)
 ))    ; конец if 
 
;;; (princ)); "Тихий" выход и конец программы D1301

;;;>> Подпрограмма формирования списка с данными о высоте текста, наклоне, вращении и заданных смещениях атрибута
(defun rem_shift()
    (setq shift_Horizontal (- (atof veb_sl_Right) (atof veb_sl_Left)))
    (setq shift_Vertical (- (atof veb_sl_Up) (atof veb_sl_Down)))
    (list Tag_Attr_Name Height TextAngle TextRotation TextColor Layer_Name shift_Horizontal shift_Vertical 0)
);end rem_Data

;;;>> Подпрограммы связи горизонтального ползунка с текстовыми окнами "Левее" и "Правее"
  (defun sl_Horizontal_action ();если сдвинут ползунок
    (setq vsl_Left (get_tile "sl_Horizontal")) ;присвоить переменой значение value ползунка
    (setq vsl_Right (get_tile "sl_Horizontal")) ;присвоить переменой значение value ползунка
    (if (<= (atof vsl_Left) middle_sliders)
          (progn 
            (set_tile "eb_sl_Left" (rtos (- 5.0 (/ (atof vsl_Left) 10.0))) );модифицировать и передать это значение в текстовое окно "eb_sl_Left"
          (set_tile "eb_sl_Right" "0")
    )
    )
    (if (>= (atof vsl_Right) middle_sliders)
          (progn 
            (set_tile "eb_sl_Right" (rtos (- (/ (atof vsl_Right) 10.0) 5.0 )) );модифицировать и передать это значение в текстовое окно "eb_sl_Right"
          (set_tile "eb_sl_Left" "0")
    )
    )
    (setq veb_sl_Left (get_tile "eb_sl_Left")) ;присвоить значение value ползунка
    (setq veb_sl_Right (get_tile "eb_sl_Right")) ;присвоить значение value ползунка
  );end defun

  (defun eb_sl_Left_action ();если изменен текст в окне "eb_sl_Left"
    (setq veb_sl_Left (get_tile "eb_sl_Left"));присвоить переменной значение value текстового окна
        (if (or (/= veb_sl_Left "0") (= (get_tile "eb_sl_Right") "0"))
      (progn
        (set_tile "sl_Horizontal" (rtos (* (- 5 (atof veb_sl_Left)) 10)));передать это значение в тайл ползунка
        (setq vsl_Left (get_tile "sl_Horizontal")) ;присвоить переменой vsl_Left значение value ползунка
        (set_tile "eb_sl_Right" "0")
      )
        )
  );end defun

  (defun eb_sl_Right_action ();если изменен текст в окне "eb_sl_Right"
    (setq veb_sl_Right (get_tile "eb_sl_Right"));присвоить переменной значение value текстового окна
        (if (or (/= veb_sl_Right "0") (= (get_tile "eb_sl_Left") "0"))
      (progn
        (set_tile "sl_Horizontal" (rtos (* (+ (atof veb_sl_Right) 5) 10)));передать это значение в тайл ползунка
        (setq vsl_Right (get_tile "sl_Horizontal")) ;присвоить переменой vsl_Right значение value ползунка
        (set_tile "eb_sl_Left" "0")
      )
    )
  );end defun

;;;>> Подпрограммы связи вертикального ползунка с текстовыми окнами "Выше" и "Ниже"
  (defun sl_Vertical_action ();если сдвинут ползунок
    (setq vsl_Up (get_tile "sl_Vertical")) ;присвоить переменой значение value ползунка
    (setq vsl_Down (get_tile "sl_Vertical")) ;присвоить переменой значение value ползунка
    (if (>= (atof vsl_Up) middle_sliders)
          (progn 
            (set_tile "eb_sl_Up" (rtos (- (/ (atof vsl_Up) 10.0) 5.0 )) );модифицировать и передать это значение в текстовое окно "eb_sl"
          (set_tile "eb_sl_Down" "0")
    )
    )
    (if (<= (atof vsl_Down) middle_sliders)
          (progn
            (set_tile "eb_sl_Down" (rtos (- 5.0 (/ (atof vsl_Down) 10.0))) );модифицировать и передать это значение в текстовое окно "eb_sl"
          (set_tile "eb_sl_Up" "0")
    )
    )
    (setq veb_sl_Up (get_tile "eb_sl_Up")) ;присвоить переменой vsl_Up значение value ползунка
    (setq veb_sl_Down (get_tile "eb_sl_Down")) ;присвоить переменой vsl_Down значение value ползунка
  );end defun

  (defun eb_sl_Up_action ();если изменен текст в окне "eb_sl_Up"
    (setq veb_sl_Up (get_tile "eb_sl_Up"));присвоить переменной значение value текстового окна
    (if (or (/= veb_sl_Up "0") (= (get_tile "eb_sl_Down") "0"))
    (progn
        (set_tile "sl_Vertical" (rtos (* (+ (atof veb_sl_Up) 5) 10)));передать это значение в тайл ползунка
        (setq vsl_Up (get_tile "sl_Vertical")) ;присвоить переменой vsl_Up значение value ползунка
        (set_tile "eb_sl_Down" "0")
    )
    )
  );end defun

  (defun eb_sl_Down_action ();если изменен текст в окне "eb_sl_Down"
    (setq veb_sl_Down (get_tile "eb_sl_Down"));присвоить переменной значение value текстового окна
    (if (or (/= veb_sl_Down "0") (= (get_tile "eb_sl_Up") "0"))
    (progn
        (set_tile "sl_Vertical" (rtos (* (- 5 (atof veb_sl_Down)) 10)));передать это значение в тайл ползунка
        (setq vsl_Down (get_tile "sl_Vertical")) ;присвоить переменой vsl_Down значение value ползунка
        (set_tile "eb_sl_Up" "0")
     )
    )
  );end defun

  (defun TextHeight_action ();если изменен текст в окне "Высота текста"
    (setq TextHeight (get_tile "TextHeight"));присвоить переменной значение value текстового окна
    (if (/= TextHeight nil) 
    (setq Height (atof TextHeight))
        (setq Height 0)
    )
  );end defun

  (defun TextAngle_action ();если изменен текст в окне "Наклон"
    (setq TextAngle (get_tile "TextAngle"));присвоить переменной значение value текстового окна
  );end defun

  (defun TextRotation_action ();если изменен текст в окне "Поворот"
    (setq TextRotation (get_tile "TextRotation"));присвоить переменной значение value текстового окна
  );end defun

  (defun TextColor_action ();если нажата кнопка "Палитра"
    (setq TextColor (acad_colordlg 0));присвоить переменной номер цвета из 256-цветной палитры
  );end defun

  (defun Layers_list_action ();если произведен выбор из списка слоев
    (setq Layers_index (get_tile "Layers_list"));присвоить номер индекса в списке
    (setq Layer_Name (nth (atoi Layers_index) Layers_list))
  );end defun

  (defun Tag_Attr_list_action ();если произведен выбор из списка слоев
    (setq Tag_Attr_index (get_tile "Tag_Attr_list"));присвоить номер индекса в списке
    (setq Tag_Attr_Name (nth (atoi Tag_Attr_index) Tag_Attr_list))
  );end defun

 AttrIns ert : dialog {
  label = "Свойства атрибутов блоков" ;
:boxed_row{label = "Видимые атрибуты";
:popup_list{fixed_width=true;
      key="Tag_Attr_list";
      label="";
      width=10;
      height=8;
      edit_width=22;
      value = "5";
      alignment=centered;
      action="(Tag_Attr_list_action)";
}//end Attr_list                  }
}
:row{alignment=centered;
    height=10;fixed_width=true;width=36;label = "Смещения:" ;
    :column{label = "Вертикальное" ;
         :edit_box{key="eb_sl_Up";// Текстовое окно положение движка
              label="Выше";
              alignment=right;
              value="0";
              edit_width=3;
              fixed_width_font=true;
              fixed_width=true;
              action="(eb_sl_Up_action)";
         }//end eb_sl_Up
         :edit_box{key="eb_sl_Down";// Текстовое окно положение движка
              label="Ниже";
              alignment=right;
              value="0";
              edit_width=3;
              fixed_width_font=true;
              fixed_width=true;
              action="(eb_sl_Down_action)";
         }//end eb_sl_Down
    }//end column
    :column{
         :slider{key="sl_Vertical";    // Ползунок для задания вертикального смещения
               layout=vertical;
               fixed_width=true;
               width=2;
               height=10;
              max_value=100; // Значение при крайнем правом положении
              min_value=0;   // Значение при крайнем левом положении
              value="0";    // Начальная установка
              small_increment=1;
              big_increment=1;
              fixed_height=true;
              action="(sl_Vertical_action)";
         }//end sl_Vertical
    }//end column
    :column{
         :row{label = "Высота";
             :edit_box{key="TextHeight";// Текстовое окно высоты текста
                  label="      ";
                  value="";
                  edit_width=3;
                  fixed_width_font=true;
                  fixed_width=true;
                  action="(TextHeight_action)";
             }//end eb_sl_Up
         }
         :row{label = "Наклон";
             :edit_box{key="TextAngle";// Текстовое окно угла наклона текста
                  label="      ";
                  value="";
                  edit_width=3;
                  fixed_width_font=true;
                  fixed_width=true;
                  action="(TextAngle_action)";
             }//end eb_sl_Down
         }
         :row{label = "Поворот";
             :edit_box{key="TextRotation";// Текстовое окно угла поворота текста
                  label="      ";
                  value="";
                  edit_width=3;
                  fixed_width_font=true;
                  fixed_width=true;
                  action="(TextRotation_action)";
             }//end eb_sl_Down
         }
    }//end column
}//end row
    :row{alignment=centered;label = "Горизонтальное" ;
         fixed_width=true; width=36;
         :edit_box{key="eb_sl_Left";// Текстовое окно положение движка
              label="Левее";
              value="0";
              edit_width=3;
              fixed_width_font=true;
              action="(eb_sl_Left_action)";
         }//end eb_sl_Left
         :row{fixed_width=true; width=3;}
         :edit_box{key="eb_sl_Right";// Текстовое окно положение движка
              label="Правее";
              value="0";
              edit_width=3;
              fixed_width_font=true;
              action="(eb_sl_Right_action)";
         }//end eb_sl_Right
    }
    :row{fixed_width=true; width=30;
         alignment=centered;
         :slider{key="sl_Horizontal";    // Ползунок для задания горизонтального смещения
               fixed_width=true; 
               width=30;
              max_value=100; // Значение при крайнем правом положении
              min_value=0;   // Значение при крайнем левом положении
              value="0";    // Начальная установка
              small_increment=1;
              big_increment=1;
              action="(sl_Horizontal_action)";
         }//end sl_Horizontal
    }
         :boxed_row{label = "Слой и цвет";
        :popup_list{fixed_width=true;
              key="Layers_list";
              label="";
              width=10;
              height=8;
              edit_width=22;
              value = "5";
              alignment=centered;
              action="(Layers_list_action)";
        }//end popup_list                  }
             :button{key="TextColor";// Текстовое окно цвета текста
                  label="Палитра";
                  action="(TextColor_action)";
             }//end eb_sl_Down
         }
    :row{
        fixed_width=true;  //Минимальная ширина по объектам внутри
        alignment = centered; //Выровнен по правому краю
     ok_cancel;// Кнопка
     }    //end Row
   }    //конец диалога