Проникающая гидроизоляция бетона
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Сквозная нумерация динамических блоков

Сквозная нумерация динамических блоков

Ответ
Поиск в этой теме
Непрочитано 18.09.2007, 17:45
Сквозная нумерация динамических блоков
zenon
 
Остекляем!!! Алюминим!!!
 
Москва
Регистрация: 21.02.2005
Сообщений: 3,397

Назрело!
В связи с введением динамических блоков начиная с AutoCAD2006, по роду моей деятельности появилась возможность рисовать монтажную схему стоек с указание ее длины в аттрибуте, с автоматическим изменением аттрибута в зависимости от удлинения стойки.
Поэтому назрел вопрос о сквозной нумерации, то бищь присвоении 2му аттрибуту номера стойки в зависимости от ее длины.
см. чертеж
[ATTACH]1190123036.dwg[/ATTACH]
Можно ли расстановку позиций реализовать программно?
ps предварительно расставив стойки.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
Просмотров: 60330
 
Непрочитано 06.04.2012, 11:44
#201
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,799
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Замени
Код:
[Выделить все]
 (setq bname ( GETSTRING T "\nИмя блока:" ))
На
Код:
[Выделить все]
(setq bname
       ((lambda( / obj name)
          (while (not name)
            (initget "Имя")
            (setq obj (entsel "\nВыберите блок [Имя]: "))
            (cond ((and obj (eq obj "Имя"))(setq name(getstring T "\nИмя блока: " )))
                  ((and obj (eq (cdr(assoc 0 (entget(setq obj(car obj))))) "INSERT"))
                   (if (vlax-property-available-p (setq obj(vlax-ename->vla-object obj)) 'EffectiveName)
                     (setq name(vla-get-EffectiveName obj))
                     (setq name(vla-get-Name obj))
                     )
                   )
                  (t (princ " ** Неверно ** "))
                  )
            )
          name
          )
         )
      )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 06.04.2012, 15:39
#202
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Не то.
Выберите блок [Имя]: - выбирается только один блок, ручной ввод теперь не воспринимается.
Я имел ввиду это:
Выберите блок [Имя]: -
а) здесь выбираем ЛК один или несколько блоков и затем блоки с этими именами будут попадать в набор.
б) если не был сделан выбор ЛК, а был ввод с клавиатуры имени (маска имен), то программа продолжает работать как раньше.
Alex_80 вне форума  
 
Непрочитано 06.04.2012, 16:37
#203
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,799
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Alex_80, Что такое опции знаешь?
Цитата:
Сообщение от Alex_80 Посмотреть сообщение
Выберите блок [Имя]
Имя - это опция, на запрос щелкни ПКМ, будет как раньше
Судя по запросу
Код:
[Выделить все]
(setq bname ( GETSTRING T "\nИмя блока:" ))
запрашивалось только одно имя блока. Этим и руководствовался.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 07.04.2012, 07:15
#204
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Цитата:
Сообщение от VVA Посмотреть сообщение
Имя - это опция, на запрос щелкни ПКМ, будет как раньше
Спасибо разобрался, сам бы и не догадался. Добавил в макрос кнопки «И;» и все заработало. Сделай пожалуйста, если не трудно, для набора ЛК несколько разных блоков.
Alex_80 вне форума  
 
Непрочитано 08.04.2012, 11:35
#205
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,799
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Alex_80, мне нужно видеть весь код (опубликуй или дай ссылку на пост), т.к.
Цитата:
Сообщение от VVA Посмотреть сообщение
Судя по запросу
Код:
[Выделить все]
(setq bname ( GETSTRING T "\nИмя блока:" ))
запрашивалось только одно имя блока.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 09.04.2012, 11:54
#206
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Вот он код:
Код:
[Выделить все]
 ;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #163
;;; Натройки программы проихводятся парой строчек ниже СМ
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq attTo "POS") ;_Имя аттрибута куда вбивать

(defun c:NDB (/       adoc    ss      name    bname   lst     lstLen
              poz     attTo   *error* dynProp1        dynProp2
              dp1     dp2     i dimz
             )
;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #163
  
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
  (princ "\nNDB - Маркировка динамических блоков. сборка от 2011-12-08")
  (vl-load-com)
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq bname ( GETSTRING T "\nИмя блока:" ))===Сделай пожалуйста, если не трудно, для набора ЛК несколько разных блоков===
  (setq bname
       ((lambda( / obj name)
          (while (not name)
            (initget "Имя")
            (setq obj (entsel "\nВыберите блок [Имя]: "))
            (cond ((and obj (eq obj "Имя"))(setq name(getstring T "\nИмя блока: " )))
                  ((and obj (eq (cdr(assoc 0 (entget(setq obj(car obj))))) "INSERT"))
                   (if (vlax-property-available-p (setq obj(vlax-ename->vla-object obj)) 'EffectiveName)
                     (setq name(vla-get-EffectiveName obj))
                     (setq name(vla-get-Name obj))
                     )
                   )
                  (t (princ " ** Неверно ** "))
                  )
            )
          name
          )
         )
      )
  (setq dynProp1 ( GETSTRING T "\nИмя динамического свойства 1:"))
  (setq dynProp2 ( GETSTRING T "\nИмя динамического свойства 2:"))
  (setq attTo "POS") ;_Имя аттрибута куда вбивать
  (or (numberp *STARTPOZ*)(setq *STARTPOZ* 1)) ;;; Стартовая нумерация
  
;;; ===================== LOCAL FUNCTION ==========================================
(defun *error* (msg) (princ msg)(setvar "DIMZIN" dimz)(vla-endundomark adoc))
(defun RemoveDuplicateStrings (stringlist / newlist)
  (foreach var stringlist 
    (if (not (vl-position var newlist))
      (setq newlist (cons var newlist))
    )
  )
  (reverse newlist)
)
  (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)))
  ) ;_ end of cond
) ;_ end of defun
(defun GetDynamicBlockPropertyList (obj)
 (mapcar
    (function
      (lambda ( prop )
        (list (vla-get-propertyname prop) (vlax-get prop 'Value) prop)
      )
    )
    (vlax-invoke obj 'GetDynamicBlockProperties)
  )
)
(defun GetDynamicBlockPropertyNameValue ( obj PropertyName / Plist)
  (and
  (setq PropertyName (strcase PropertyName))
  (setq Plist (GetDynamicBlockPropertyList obj))
  (setq Plist (car(vl-remove-if-not '(lambda (x)
                                   (= (strcase (car x)) PropertyName))
                Plist
                ))
        )
  )
   (cadr Plist)
  )
(defun mip-block-setattr-bylist (obj att_list / txt lst)
  (if (= (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of if
  (setq att_list (mapcar '(lambda (x)
                            (cons (strcase (mip-conv-to-str (car x)))
                                  (mip-conv-to-str (cdr x))
                            ) ;_ end of cons
                          ) ;_ end of lambda
                         att_list
                 ) ;_ end of mapcar
  ) ;_ end of setq
  (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)
      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq
                  lst (assoc (strcase (vla-get-tagstring at)) att_list)
                ) ;_ end of setq
              (vla-put-textstring at (cdr lst))
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun
(defun round (value to)
;;; Doug Broad
;;; additional credits Joe Burke, Peter Toby
  (setq to (abs to))
  (* to
     (fix (/ ((if (minusp value)
                -
                +
              ) ;_ end of if
               value
               (* to 0.5)
             )
             to
          ) ;_ end of /
     ) ;_ end of fix
  ) ;_ end of *
) ;_ end of defun  
(defun get-all-atts (obj)
  (if (and obj
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)

      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (mapcar (function (lambda (x)
                              (cons (vla-get-tagstring x)
                                    (vla-get-textstring x)
                              ) ;_ end of cons
                            ) ;_ end of lambda
                  ) ;_ end of function
                  (append (vlax-invoke obj 'Getattributes)
                          (vlax-invoke obj 'Getconstantattributes)
                  ) ;_ end of append
          ) ;_ end of mapcar
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun  
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  ;;;http://www.theswamp.org/index.php?topic=16564.msg207439;topicseen#msg207439
  ;;; http://www.theswamp.org/index.php?topic=6474.0
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)
  ;;; ===================== LOCAL FUNCTION ==========================================

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-startundomark adoc)
  (setq dimz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")
  (princ *PREF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *PREF* poz))
  (if (= poz " ")(setq *PREF* ""))
  (princ "\nВведите суффикс или Пробел - нет <")
  (princ *SUFF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *SUFF* poz))
  (if (= *SUFF* " ")(setq *SUFF* ""))
  (princ "\nКратность (5 - кратно 5; 0.5 - кратно 0.5) или 0 - нет <")
  (if (numberp *ROUND*)(princ *ROUND*)(princ "НЕТ"))
  (princ ">: ")(initget 4)
  (if (null (setq poz (getdist)))
    (setq poz (if (numberp *ROUND*) *ROUND*  0))
  ) ;_ end of if
  (if (zerop poz)(setq *ROUND* nil)(setq *ROUND* poz)) ;_ end of if
  (princ "\nНачальный номер <")(princ *STARTPOZ*)(princ ">: ")
  (if (null(setq i (getint)))(setq i *STARTPOZ*)(setq *STARTPOZ* i))
  (if (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
           (princ "\nЭтап 1. Построение списка блоков.")
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      ) ;_ end of and
    (progn
      (princ "\nЭтап 2. Анализ блоков.")
      (setq i      0
            lstLen (mapcar 'vlax-ename->vla-object lstlen)
      ) ;_ end of setq
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
          ) ;_ end of and
           (progn
             (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                       )
             ) ;_ end of if
             (setq lst
                    (cons (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9)) lst)
             ) ;_ end of setq
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (princ "... Обработано ")(princ i)(princ " блоков")
      (princ "\nЭтап 3. Построение списка из уникальных значений.")
      (setq lst (SORTSTRINGWITHNUMBERASNUMBER (RemoveDuplicateStrings lst) nil))
      (princ "\nЭтап 4. Обновление атрибутов блоков.")
      (setq i 0)
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
               (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                 ) ;_ end of setq
                 t
               ) ;_ end of if
               (setq poz (vl-position
                           (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9))
                           lst
                         ) ;_ end of vl-position
               ) ;_ end of setq
          ) ;_ end of and
           (progn
             (mip-block-setattr-bylist
               blk
               (list (cons (strcase attTo)
                           (strcat *PREF* (itoa (+ *STARTPOZ* poz)) *SUFF*)
                     ) ;_ end of cons
               ) ;_ end of list
             ) ;_ end of mip-block-setattr-bylist
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (setq *STARTPOZ* (+ *STARTPOZ* (length lst)))
      (princ "... Обновлено ")(princ i)(princ " атрибутов в блоках \n")
      (vla-regen adoc acactiveviewport)
    ) ;_ end of progn 
  ) ;_ end of if
  (setvar "DIMZIN" dimz)
  (vla-endundomark adoc)(princ)
) ;_ end of defun

Alex_80 вне форума  
 
Непрочитано 16.04.2012, 11:08
2 | #207
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,799
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Пробуй
Код:
[Выделить все]
;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #207, #163
;;; Натройки программы проихводятся парой строчек ниже СМ
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq attTo "POS") ;_Имя аттрибута куда вбивать

(defun c:NDB (/       adoc    ss      name    bname   lst     lstLen
              poz     attTo   *error* dynProp1        dynProp2
              dp1     dp2     i dimz
             )
;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #163
  
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
  (princ "\nNDB - Маркировка динамических блоков. сборка от 2011-12-08")
  (vl-load-com)
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq bname ( GETSTRING T "\nИмя блока:" ))===Сделай пожалуйста, если не трудно, для набора ЛК несколько разных блоков===
  (setq bname
       ((lambda( / obj name flg str)
          (while (not flg)
            (initget "Имя Удалить")
            (if name
              (setq str (VL-PRINC-TO-STRING name))
              ;;;(setq str (strcat (car name)(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(cdr name)))))
              (setq str "")
              )
            (setq obj (entsel(strcat "\n" str " Выберите блок [Имя/Удалить]<готово>: ")))
            (cond ((and obj (eq obj "Имя"))(setq name (cons (getstring T "\nИмя блока: " ) name)))
                  ((and obj (eq obj "Удалить"))(if (null name)(princ " ** Все удалено **")(setq name (cdr name))))
                  ((and obj (eq (cdr(assoc 0 (entget(setq obj(car obj))))) "INSERT"))
                   (if (not(member(vla-get-EffectiveName(setq obj(vlax-ename->vla-object obj))) name))
                     (setq name (cons (vla-get-EffectiveName obj) name))
                     )
                   )
                  ((and (null obj)(= (getvar "ERRNO") 52))(setq flg t))
                  (t (princ " ** Неверно ** "))
                  )
            )
         (apply 'strcat(mapcar '(lambda(x)(strcat x ",")) name))
          )
         )
      )
  (setq dynProp1 ( GETSTRING T "\nИмя динамического свойства 1:"))
  (setq dynProp2 ( GETSTRING T "\nИмя динамического свойства 2:"))
  (setq attTo "POS") ;_Имя аттрибута куда вбивать
  (or (numberp *STARTPOZ*)(setq *STARTPOZ* 1)) ;;; Стартовая нумерация
  
;;; ===================== LOCAL FUNCTION ==========================================
(defun *error* (msg) (princ msg)(setvar "DIMZIN" dimz)(vla-endundomark adoc))
(defun RemoveDuplicateStrings (stringlist / newlist)
  (foreach var stringlist 
    (if (not (vl-position var newlist))
      (setq newlist (cons var newlist))
    )
  )
  (reverse newlist)
)
  (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)))
  ) ;_ end of cond
) ;_ end of defun
(defun GetDynamicBlockPropertyList (obj)
 (mapcar
    (function
      (lambda ( prop )
        (list (vla-get-propertyname prop) (vlax-get prop 'Value) prop)
      )
    )
    (vlax-invoke obj 'GetDynamicBlockProperties)
  )
)
(defun GetDynamicBlockPropertyNameValue ( obj PropertyName / Plist)
  (and
  (setq PropertyName (strcase PropertyName))
  (setq Plist (GetDynamicBlockPropertyList obj))
  (setq Plist (car(vl-remove-if-not '(lambda (x)
                                   (= (strcase (car x)) PropertyName))
                Plist
                ))
        )
  )
   (cadr Plist)
  )
(defun mip-block-setattr-bylist (obj att_list / txt lst)
  (if (= (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of if
  (setq att_list (mapcar '(lambda (x)
                            (cons (strcase (mip-conv-to-str (car x)))
                                  (mip-conv-to-str (cdr x))
                            ) ;_ end of cons
                          ) ;_ end of lambda
                         att_list
                 ) ;_ end of mapcar
  ) ;_ end of setq
  (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)
      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq
                  lst (assoc (strcase (vla-get-tagstring at)) att_list)
                ) ;_ end of setq
              (vla-put-textstring at (cdr lst))
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun
(defun round (value to)
;;; Doug Broad
;;; additional credits Joe Burke, Peter Toby
  (setq to (abs to))
  (* to
     (fix (/ ((if (minusp value)
                -
                +
              ) ;_ end of if
               value
               (* to 0.5)
             )
             to
          ) ;_ end of /
     ) ;_ end of fix
  ) ;_ end of *
) ;_ end of defun  
(defun get-all-atts (obj)
  (if (and obj
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)

      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (mapcar (function (lambda (x)
                              (cons (vla-get-tagstring x)
                                    (vla-get-textstring x)
                              ) ;_ end of cons
                            ) ;_ end of lambda
                  ) ;_ end of function
                  (append (vlax-invoke obj 'Getattributes)
                          (vlax-invoke obj 'Getconstantattributes)
                  ) ;_ end of append
          ) ;_ end of mapcar
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun  
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  ;;;http://www.theswamp.org/index.php?topic=16564.msg207439;topicseen#msg207439
  ;;; http://www.theswamp.org/index.php?topic=6474.0
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)
  ;;; ===================== LOCAL FUNCTION ==========================================

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-startundomark adoc)
  (setq dimz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")
  (princ *PREF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *PREF* poz))
  (if (= poz " ")(setq *PREF* ""))
  (princ "\nВведите суффикс или Пробел - нет <")
  (princ *SUFF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *SUFF* poz))
  (if (= *SUFF* " ")(setq *SUFF* ""))
  (princ "\nКратность (5 - кратно 5; 0.5 - кратно 0.5) или 0 - нет <")
  (if (numberp *ROUND*)(princ *ROUND*)(princ "НЕТ"))
  (princ ">: ")(initget 4)
  (if (null (setq poz (getdist)))
    (setq poz (if (numberp *ROUND*) *ROUND*  0))
  ) ;_ end of if
  (if (zerop poz)(setq *ROUND* nil)(setq *ROUND* poz)) ;_ end of if
  (princ "\nНачальный номер <")(princ *STARTPOZ*)(princ ">: ")
  (if (null(setq i (getint)))(setq i *STARTPOZ*)(setq *STARTPOZ* i))
  (if (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
           (princ "\nЭтап 1. Построение списка блоков.")
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      ) ;_ end of and
    (progn
      (princ "\nЭтап 2. Анализ блоков.")
      (setq i      0
            lstLen (mapcar 'vlax-ename->vla-object lstlen)
      ) ;_ end of setq
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
          ) ;_ end of and
           (progn
             (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                       )
             ) ;_ end of if
             (setq lst
                    (cons (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9)) lst)
             ) ;_ end of setq
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (princ "... Обработано ")(princ i)(princ " блоков")
      (princ "\nЭтап 3. Построение списка из уникальных значений.")
      (setq lst (SORTSTRINGWITHNUMBERASNUMBER (RemoveDuplicateStrings lst) nil))
      (princ "\nЭтап 4. Обновление атрибутов блоков.")
      (setq i 0)
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
               (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                 ) ;_ end of setq
                 t
               ) ;_ end of if
               (setq poz (vl-position
                           (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9))
                           lst
                         ) ;_ end of vl-position
               ) ;_ end of setq
          ) ;_ end of and
           (progn
             (mip-block-setattr-bylist
               blk
               (list (cons (strcase attTo)
                           (strcat *PREF* (itoa (+ *STARTPOZ* poz)) *SUFF*)
                     ) ;_ end of cons
               ) ;_ end of list
             ) ;_ end of mip-block-setattr-bylist
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (setq *STARTPOZ* (+ *STARTPOZ* (length lst)))
      (princ "... Обновлено ")(princ i)(princ " атрибутов в блоках \n")
      (vla-regen adoc acactiveviewport)
    ) ;_ end of progn 
  ) ;_ end of if
  (setvar "DIMZIN" dimz)
  (vla-endundomark adoc)(princ)
) ;_ end of defun
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 17.04.2012, 06:25
#208
Alex_80

ПГС
 
Регистрация: 24.11.2011
Сообщений: 31


Цитата:
Сообщение от VVA Посмотреть сообщение
Пробуй
Спасибо работает. Вот такие макросы на команды получились:
1) ^C^C_NDB;И;VP1;;ТИП;ДЛИНА;КП-; ;;1;_all;; - это для блока VP1, свойства: ТИП, ДЛИНА. Срабатывает одним нажатием.
2)^C^C_NDB;\\\;ТИП;ДЛИНА;КП-; ;;1;_all;; - это для пользовательского выбора блоков, свойства: ТИП, ДЛИНА. Выбор задал "\\\", т.е. до трех блоков. Нужно выбрать два - выбираем два блока и третий выбор любой другой объект. Как сделать красивее еще не додумался.
Еще раз спасибо, тестирую дальше.
31.07.12
Самый удобный макрос для команды. Делаем для каждого блока свой макрос:
^C^C_NDB;И;VP1;;ТИП;ДЛИНА;КП-; ;;1;\;;

Последний раз редактировалось Alex_80, 31.07.2012 в 14:20.
Alex_80 вне форума  
 
Непрочитано 02.08.2012, 15:54
#209
Alex1740


 
Регистрация: 02.08.2012
Сообщений: 1


Огромное спасибо все работает!!! Использую пример кассета.rar из 122 поста и такой макрос (^C^C_NDB;И;Кассета_v.1.6.;;Высота(H) кассеты;Ширина(B) кассеты;К; ;;1;_all ; ) . Для полного счастья нехватает только одного, чтобы уже пронумированые касеты вставить в эксель как спецификацию используя длину кассеты, ширину и маркировку, читал тему по подсчету динамических блоков, там есть похожие примеры, но со своими познаниями я немогу их привезать к данному примеру.
Alex1740 вне форума  
 
Непрочитано 27.08.2012, 11:15
#210
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,799
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Alex1740, Здесь программирование не нужно. Есть стандартная команда _dataextraction
Где можно применить "Извлечение данных"(_.dataextraction)?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 01.09.2015, 07:55 Марки блоков
#211
bear54862


 
Регистрация: 18.09.2014
Сообщений: 2


Доброго времени суток всем! I need help!! не смог до конца разобраться с маркировкой блоков ,возможно с атрибутами напутал что-то , необходима ваша помощь, поощрение гарантирую $
Вложения
Тип файла: dwg
DWG 2010
Марки блоков.dwg (1.97 Мб, 531 просмотров)
Тип файла: lsp NDB.lsp (11.7 Кб, 21 просмотров)
bear54862 вне форума  
 
Непрочитано 01.09.2015, 22:45
#212
art_rrc


 
Регистрация: 28.01.2013
Минск
Сообщений: 378


Цитата:
Сообщение от bear54862 Посмотреть сообщение
Доброго времени суток всем! I need help!! не смог до конца разобраться с маркировкой блоков ,возможно с атрибутами напутал что-то , необходима ваша помощь, поощрение гарантирую $
Так а что нужно сделать? Какой результат необходим?
art_rrc вне форума  
 
Непрочитано 02.09.2015, 05:29
#213
bear54862


 
Регистрация: 18.09.2014
Сообщений: 2


сквозную нумерацию блоков уже помогли сделать!

----- добавлено через ~2 мин. -----
спасибо VVA
bear54862 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Сквозная нумерация динамических блоков

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск