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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Дополнительные команды для Аннотативных масштабов. Удаление лишних масштабов, копирование масштабов между объектами и т.п.

Дополнительные команды для Аннотативных масштабов. Удаление лишних масштабов, копирование масштабов между объектами и т.п.

Ответ
Поиск в этой теме
Непрочитано 01.02.2008, 22:12 1 |
Дополнительные команды для Аннотативных масштабов. Удаление лишних масштабов, копирование масштабов между объектами и т.п.
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,980

В первом сообщении выкладываю всю главную информацию. Прикрепляю последнюю версию кода и иконки для команд.

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



RN_MatchAnntScale - Копируем аннотативный масштаб (масштабы) с одного объекта на другой (другие).
По сути это Match Properties, но только для аннотативных масштабов.



RN_SetAnntScaleFromObj - Выбираем примитив и его аннотативный масштаб назначается текущим масштабом рабочего пространства.
(Предполагается что мы держим только один аннотативный масштаб у примитива. Если масштабов несколько берется за основу первый из списка)


____________________________________________________________________________________________________________________
Еще очень давно, когда только появились аннотативные масштабы, я не перешел на них из за ограниченного на мой взгляд функционала. В некотором роде схожие масштабы имелись в СПДС. Естественно было и много отличий, но основная суть была одинакова.
Мне казалось очень нелогичным что в акаде не было предусмотрено функции для быстрого изменения аннотативного масштаба. Если нужно было поменять масштаб у всех элементов в одном узле, то предполагалось залезать к ним в свойства, открыть таблицу с масштабами, добавить новый и удалить старый. Еще ничего если скажем нужно было поменять масштаб только для размеров, их можно выбрать все вместе и залезть к ним в общую таблицу масштабов через свойства. Но если аннотативных объектов есть несколько видов, то нужно было выбирать каждую дисциплину отдельно, и залезать по очереди к ним в свойства.... Короче очень и очень непродуманно. Данную идею реализовал и выложил на этой ветке Krieger. Так уж вышло что я только спустя годы начал пользоваться аннотативными масштабами (когда остался без СПДС). Сейчас я считаю что аннотативные мастабы даже удобнее чем масштабы СПДС. Ведь аннотативности поддается куда больше объектов (штриховки, блоки и т.п.). Со временем и с помощью более продвинутых форумчан я добавил и новые команды (RN_MatchAnntScale и RN_SetAnntScaleFromObj).
____________________________________________________________________________________________________________________
Исходный текст сообщения.
Уважаемые коллеги. Немного в качестве предисловия. Сам я пользуюсь СПДС, глюки некоторые конечно нервируют, но в основном заметно облегчает работу конструктора. Кто хоть раз видел, знает, как удобно устроены в СПДС выноски, разрезы, сварные швы и т.п. Но все это в принципе и в самом Автокаде можно сделать при помощи динамических блоков или типов линий. Что до недавнего времени было лично для меня главным преимуществом СПДС – это способность без проблем изменять масштабы символов, что очень помогает, когда чертишь все 1:1 (как я и делаю). “До недавнего времени”, поскольку установив 2008-й Автокад и увидев аннотативность, я было подумал что вот наконец и Autodesk додумался. Но рано радовался. Уж больно перемудрили, на мой взгляд, с аннотативностью. Чтобы поменять, к примеру, масштаб размера, приходится зайти к нему в свойства, добавить нужный масштаб (если не хочешь чтоб лишние масштабы глаза мозолили, то старый надо стирать) потом выделить обьект, поменять масштаб. Долго и нудно. В СПДС все гораздо быстрее. Выделил объект поменял масштаб. Все.
Неужели я прав и нельзя облегчить переход из одного масштаба в другой используя аннотативность.

Разделю мешающие мне факторы по пунктам.
1.Лишняя информация на экране. Когда у объекта в свойствах много масштабов это действует на нервы. Выделяешь объект и все возможные размеры видны. По-моему это лишнее.
2.Надо лезть в свойства. Возьмем к примеру размеры. В параметрах стиля нельзя задать нужные масштабы. Для этого нужно отдельно выбирать объект и править свойства. Есть вариант add current scale, но тоже не самый удобный вариант.
В идеале я представляю изменение масштаба так. Выделил объект, поменял его масштаб и все.
Возможно ли подчинить такому методу работы аннотативность? Может есть какой то вариант настройки или макрос позволяющий подправить настройки. Работать макрос мог бы так. Выбираешь объект, меняешь масштаб, при этом предыдущий масштабный коэффициент стирается из памяти объекта, и добавляется текущий. Таким образом можно было избежать ненужной возни.

Изображения
 

Вложения
Тип файла: rar Annotative tools icons.rar (16.7 Кб, 199 просмотров)
Тип файла: lsp Annotative Tools.lsp (6.9 Кб, 309 просмотров)


Последний раз редактировалось Кулик Алексей aka kpblc, 28.11.2016 в 09:02.
Просмотров: 42854
 
Автор темы   Непрочитано 17.09.2016, 19:02
1 | #41
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


На основании кода от Krieger-а, и функции из "заначек" VVA сделал две новые команды для работы с аннотативными масштабами. Обновленные коды, вместе с кодом от Krieger-а и иконки для всех команд выложу в шапку темы. Темы слегка переименую.

RN_MatchAnntScale - Копируем аннотативный масштаб (масштабы) с одного объекта на другой (другие).
По сути это Match Properties, но только для аннотативных масштабов.

RN_SetAnntScaleFromObj - Выбираем примитив и его аннотативный масштаб назначается текущим масштабом рабочего пространства.
(Предполагается что мы держим только один аннотативный масштаб у примитива. Если масштабов несколько берется за основу первый из списка)

Код:
[Выделить все]
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:RN_SetAnntScaleFromObj ( / sourceann adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    );_ end of vla-startundomark
  (if (setq sourceann (car(GetAnnoScales (car(entsel)))))
      (setvar "CANNOSCALE" sourceann)
    );if
  (vla-endundomark adoc) ;;; undomark bottom mark
  (princ)
);defun


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun C:RN_MatchAnntScale ( / sourceannlist destinationobj pr gr cmd adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  
  (if (setq sourceannlist (GetAnnoScales (car(entsel)))
	    destinationobj (ssget))
    (progn
      (setq cmd (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (vl-cmdf "-objectscale" destinationobj "" "_Add" (car sourceannlist) "")
      (command)
	  (foreach pr (dictsearch (namedobjdict) "acad_scalelist")
	    (if (and (= (car pr) 350)
	             (not (eq (car sourceannlist) (cdr (assoc 300 (entget (cdr pr))))))
		     )
	      (vl-cmdf "-objectscale" destinationobj "" "_Delete" (cdr (assoc 300 (entget (cdr pr)))))
	    );if
	    (command)
	    (princ)
	    );foreach
      
      (if (setq cdrsourceannlist (cdr sourceannlist))
	  (foreach gr cdrsourceannlist
	  (vl-cmdf "-objectscale" destinationobj "" "_Add" gr "")
	    (princ)
	    );foreach	
	
       );if
      
      (setvar "CMDECHO" cmd)
      );progn
    );if
  (vla-endundomark adoc) ;;; undomark bottom mark
  (princ)
);defun




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (defun GetAnnoScales (e / dict lst rewind res)
;;; Argument: the ename of an annotative object.
;;; Returns the annotative scales associated with the 
;;; ename as a list of strings.
;;; Example: ("1:1" "1:16" "1:20" "1:30")
;;; Returns nil if the ename is not annotative. 
;;; Can be used to test whether ename is annotative or not.
;;; Works with annotative objects: text, mtext, leader, mleader, 
;;; dimension, block reference, tolerance and attribute.
;;; Based on code by Ian Bryant.


;;;Joe Burk
;;;http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-do-i-make-hatch-annotative-via-vlisp-almost-there/m-p/2080831    
;; Argument: an ename or vla-object.
;; Return T if object is annotative, otherwise nil.
;;;(defun IsAnnotative (e)
;;;(if (not (eq (type e) 'ENAME))
;;;(setq e (vlax-vla-object->ename e))
;;;)
;;;(if (assoc -3 (entget e '("AcadAnnotative"))) T)
;;;)

;;;(defun IsAnnotative (e)
;;;(and e
;;;(setq e (cdr (assoc 360 (entget e))))
;;;(setq e (dictsearch e "AcDbContextDataManager"))
;;;(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
;;;(assoc 350 e)
;;;)
;;;)
    

    (if
      (and
        e
        (setq dict (cdr (assoc 360 (entget e))))
        (setq lst (dictsearch dict "AcDbContextDataManager"))
        (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
        ) ;_ end of setq
        (setq dict (cdr (assoc -1 lst)))
      ) ;_ end of and
       (progn
         (setq rewind t)
         (while (setq lst (dictnext dict rewind))
           (setq e      (cdr (assoc 340 lst))
                 res    (cons (cdr (assoc 300 (entget e))) res)
                 rewind nil
           ) ;_ end of setq
         ) ;_ end of while
       ) ;_ end of progn
    ) ;_ end of if
    (reverse res)
  )                                               ;end


  (defun CheckHandles (e / dict lst rewind nlst d42 d43 n p ptlst)
;;; Argument: the ename of annotative mtext object.
;;; Returns T if the object has only one scale or
;;; the handles for all scales are proportionally the
;;; same and all scales use the same insertion point.
    (if
      (and
        e
        (setq dict (cdr (assoc 360 (entget e))))
        (setq lst (dictsearch dict "AcDbContextDataManager"))
        (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
        ) ;_ end of setq
        (setq dict (cdr (assoc -1 lst)))
      ) ;_ end of and
       (progn
         (setq rewind t)
         (while (setq lst (dictnext dict rewind))
           (setq nlst   (cons lst nlst)
                 rewind nil
           ) ;_ end of setq
         ) ;_ end of while
         (cond
           ((= 1 (length nlst)))
           (t
            ;; lst is nil so reuse it.
            (foreach x nlst
                                                  ;Horizontal width. Can be zero, a null text string.
              (setq d42   (cdr (assoc 42 x))
                                                  ;Vertical height cannot be zero so a divide 
                                                  ;by zero error can't happen.
                    d43   (cdr (assoc 43 x))
                    n     (/ d42 d43)
                    lst   (cons n lst)
                                                  ;Insertion point
                    p     (cdr (assoc 11 x))
                    ptlst (cons p ptlst)
              ) ;_ end of setq
            ) ;_ end of foreach
            (and
              (vl-every '(lambda (x) (equal n x 1e-4)) lst)
              (vl-every '(lambda (x) (equal p x 1e-4)) ptlst)
            ) ;_ end of and
           )
         ) ;_ end of cond
       ) ;_ end of progn
    ) ;_ end of if
  );end

Последний раз редактировалось Red Nova, 19.09.2016 в 06:05.
Red Nova вне форума  
 
Непрочитано 17.09.2016, 22:51
#42
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Тоже делал себе функцию, аналог RN_SetAnntScaleFromObj. Но не со всеми примитивами работает корректно. Можно было допилить, но бросил из-за нехватки времени. Потестирую твои в понедельник.
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 20.09.2016, 11:54
#43
VVA

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


Внес небольшие изменения:
1. Добавил "_" перед командами, чтобы работало в локализованных версиях
2. Добавил в команды RN_SetAnntScaleFromObj и RN_MatchAnntScale диалог выбора аннотативного масштаба, если их несколько
Код:
[Выделить все]
 
;;; http://forum.dwg.ru/showthread.php?t=17194&page=3
;;; Дополнительные команды для Аннотативностых масштабов. Удаление лишних масштабов, копирование масштабов между объектами и т.п.

;;;Kr_DeleteAllObjectScale - удаляет все аннотативные масштабы примитивов
;;;и добавляет им текущий масштаб рабочего пространства.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:Kr_DeleteAllObjectScale ( / ss pr cmd adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark

  (if (setq ss (ssget))
    (progn
      (setq cmd (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (vl-cmdf "_-objectscale" ss "" "_Add" (getvar "CANNOSCALE") "")
      (command)
	  (foreach pr (dictsearch (namedobjdict) "acad_scalelist")
	    (if (and (= (car pr) 350)
	             (not (eq (getvar "CANNOSCALE") (cdr (assoc 300 (entget (cdr pr))))))
		     )
	      (vl-cmdf "_-objectscale" ss "" "_Delete" (cdr (assoc 300 (entget (cdr pr)))))
	    );if
	    (command)
	    (princ)
	    );foreach
      (setvar "CMDECHO" cmd)
      );progn
    );if
  (vla-endundomark adoc) ; undomark mark
  (princ)
);defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;_RN_SetAnntScaleFromObj - Выбираем примитив и его аннотативный масштаб
;_назначается текущим масштабом рабочего пространства.
;_Если масштабов несколько - предлагается выбрать
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:RN_SetAnntScaleFromObj ( / sourceann adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    );_ end of vla-startundomark
  (if (and
	(setq sourceann (car(entsel)))
	(IsAnnotative sourceann)
	(setq sourceann (GetAnnoScales sourceann))
	(setq sourceann (if (> (length sourceann) 1)(mydcldlg "Select annoscale" sourceann)(car sourceann)))
       )
      (setvar "CANNOSCALE" sourceann)
    );if
  (vla-endundomark adoc) ; undomark mark
  (princ)
);defun

;_RN_MatchAnntScale - Копируем аннотативный масштаб (масштабы)
;_с одного объекта на другой (другие). По сути это Match Properties,
;_но только для аннотативных масштабов. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:RN_MatchAnntScale ( / sourceannlist destinationobj pr gr cmd adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  
  (if
    (and
	(setq sourceann (car(entsel)))
	(IsAnnotative sourceann)
	(setq sourceann (GetAnnoScales sourceann))
	(setq sourceann (if (> (length sourceann) 1)(mydcldlg "Select annoscale" sourceann)(car sourceann)))
	(setq destinationobj (ssget))
       )
    (progn
      (setq cmd (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (vl-cmdf "_-objectscale" destinationobj "" "_Add" (car sourceannlist) "")
      (command)
	  (foreach pr (dictsearch (namedobjdict) "acad_scalelist")
	    (if (and (= (car pr) 350)
	             (not (eq (car sourceannlist) (cdr (assoc 300 (entget (cdr pr))))))
		     )
	      (vl-cmdf "_-objectscale" destinationobj "" "_Delete" (cdr (assoc 300 (entget (cdr pr)))))
	    );if
	    (command)
	    (princ)
	    );foreach
      
      (if (setq cdrsourceannlist (cdr sourceannlist))
	  (foreach gr cdrsourceannlist
	  (vl-cmdf "_-objectscale" destinationobj "" "_Add" gr "")
	    (princ)
	    );foreach	
	
       );if
      
      (setvar "CMDECHO" cmd)
      );progn
    );if
  (vla-endundomark adoc) ; undomark bottom mark
  (princ)
);defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun GetAnnoScales (e / dict lst rewind res)
;;; Argument: the ename of an annotative object.
;;; Returns the annotative scales associated with the 
;;; ename as a list of strings.
;;; Example: ("1:1" "1:16" "1:20" "1:30")
;;; Returns nil if the ename is not annotative. 
;;; Can be used to test whether ename is annotative or not.
;;; Works with annotative objects: text, mtext, leader, mleader, 
;;; dimension, block reference, tolerance and attribute.
;;; Based on code by Ian Bryant.


;;;Joe Burk
;;;http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-do-i-make-hatch-annotative-via-vlisp-almost-there/m-p/2080831    
;; Argument: an ename or vla-object.
;; Return T if object is annotative, otherwise nil.
;;;(defun IsAnnotative (e)
;;;(if (not (eq (type e) 'ENAME))
;;;(setq e (vlax-vla-object->ename e))
;;;)
;;;(if (assoc -3 (entget e '("AcadAnnotative"))) T)
;;;)

;;;(defun IsAnnotative (e)
;;;(and e
;;;(setq e (cdr (assoc 360 (entget e))))
;;;(setq e (dictsearch e "AcDbContextDataManager"))
;;;(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
;;;(assoc 350 e)
;;;)
;;;)
    (if
      (and
        e
        (setq dict (cdr (assoc 360 (entget e))))
        (setq lst (dictsearch dict "AcDbContextDataManager"))
        (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
        ) ;_ end of setq
        (setq dict (cdr (assoc -1 lst)))
      ) ;_ end of and
       (progn
         (setq rewind t)
         (while (setq lst (dictnext dict rewind))
           (setq e      (cdr (assoc 340 lst))
                 res    (cons (cdr (assoc 300 (entget e))) res)
                 rewind nil
           ) ;_ end of setq
         ) ;_ end of while
       ) ;_ end of progn
    ) ;_ end of if
    (reverse res)
  ) ;_end

  (defun CheckHandles (e / dict lst rewind nlst d42 d43 n p ptlst)
;;; Argument: the ename of annotative mtext object.
;;; Returns T if the object has only one scale or
;;; the handles for all scales are proportionally the
;;; same and all scales use the same insertion point.
    (if
      (and
        e
        (setq dict (cdr (assoc 360 (entget e))))
        (setq lst (dictsearch dict "AcDbContextDataManager"))
        (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
        ) ;_ end of setq
        (setq dict (cdr (assoc -1 lst)))
      ) ;_ end of and
       (progn
         (setq rewind t)
         (while (setq lst (dictnext dict rewind))
           (setq nlst   (cons lst nlst)
                 rewind nil
           ) ;_ end of setq
         ) ;_ end of while
         (cond
           ((= 1 (length nlst)))
           (t
            ;; lst is nil so reuse it.
            (foreach x nlst
                                                  ;Horizontal width. Can be zero, a null text string.
              (setq d42   (cdr (assoc 42 x))
                                                  ;Vertical height cannot be zero so a divide 
                                                  ;by zero error can't happen.
                    d43   (cdr (assoc 43 x))
                    n     (/ d42 d43)
                    lst   (cons n lst)
                                                  ;Insertion point
                    p     (cdr (assoc 11 x))
                    ptlst (cons p ptlst)
              ) ;_ end of setq
            ) ;_ end of foreach
            (and
              (vl-every '(lambda (x) (equal n x 1e-4)) lst)
              (vl-every '(lambda (x) (equal p x 1e-4)) ptlst)
            ) ;_ end of and
           )
         ) ;_ end of cond
       ) ;_ end of progn
    ) ;_ end of if
  );end
(defun mydcldlg (zagl info-list / fl ret dcl_id)
      ;;;Use
      ;;;(mydcldlg "Test" '("1" "2" "3" "4"))
      (vl-load-com)
      (if (null zagl)(setq zagl "Select")) ;_ end of if
      (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
      (setq ret (open fl "w"))
      (mapcar
        '(lambda (x) (write-line x ret))
        (list "mip_msg : dialog { "
              (strcat "label=\"" zagl "\";")
              " :list_box {"
              "alignment=top ;"
              "width=51 ;"
              "allow_accept = true;"
              "tabs = \"16 32\";"
              "tab_truncate = true;"
              (if (> (length info-list) 26)
                "height= 26 ;"
                (strcat "height= " (itoa (+ 3 (length info-list))) ";")
              ) ;_ end of if
              "is_tab_stop = false ;"
              "key = \"info\";}"
              "ok_cancel;}"
        ) ;_ end of list
      ) ;_ end of mapcar
      (setq ret (close ret))
      (if (and (not (minusp (setq dcl_id (load_dialog fl))))
               (new_dialog "mip_msg" dcl_id)
          ) ;_ end of and
        (progn
          (start_list "info")
          (mapcar 'add_list info-list)
          (end_list)
          (set_tile "info" "0")
          (setq ret (car info-list))
          (action_tile
            "info"
            "(setq ret (nth (atoi $value) info-list))"
          ) ;_ end of action_tile
          (action_tile
            "cancel"
            "(progn(setq ret nil)(done_dialog 0))"
          ) ;_ end of action_tile
          (action_tile "accept" "(done_dialog 1)")
          (start_dialog)
        ) ;_ end of progn
      ) ;_ end of if
      (unload_dialog dcl_id)
      (vl-file-delete fl)
      ret
    )
(defun IsAnnotative (e)
(and e
(setq e (cdr (assoc 360 (entget e))))
(setq e (dictsearch e "AcDbContextDataManager"))
(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
(assoc 350 e)
)
)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 20.09.2016, 14:10
#44
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Цитата:
Сообщение от VVA Посмотреть сообщение
Добавил в команды RN_SetAnntScaleFromObj и RN_MatchAnntScale диалог выбора аннотативного масштаба, если их несколько
Функции RN_MatchAnntScale не работает. Нет объявления переменной sourceannlist, которая используется далее по тексту.

----- добавлено через ~4 мин. -----
Как то так что ли...
Код:
[Выделить все]
;_RN_MatchAnntScale - Копируем аннотативный масштаб (масштабы)
;_с одного объекта на другой (другие). По сути это Match Properties,
;_но только для аннотативных масштабов. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:RN_MatchAnntScale ( / sourceannlist destinationobj pr gr cmd adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  
  (if
    (and
	(setq sourceann (car(entsel)))
	(IsAnnotative sourceann)
	(setq sourceannlist (GetAnnoScales sourceann))
	(setq sourceann (if (> (length sourceannlist) 1) (mydcldlg "Select annoscale" sourceannlist) (car sourceannlist)))
	(setq destinationobj (ssget))
       )
    (progn
      (setq cmd (getvar "CMDECHO"))
      ;(setvar "CMDECHO" 0)
      (vl-cmdf "_-objectscale" destinationobj "" "_Add" sourceann "")
      (command)
	  (foreach pr (dictsearch (namedobjdict) "acad_scalelist")
	    (if (and (= (car pr) 350)
	             (not (eq sourceann (cdr (assoc 300 (entget (cdr pr))))))
		     )
	      (vl-cmdf "_-objectscale" destinationobj "" "_Delete" (cdr (assoc 300 (entget (cdr pr)))))
	    );if
	    (command)
	    (princ)
	    );foreach
      
      (if (setq cdrsourceannlist (cdr sourceannlist))
	  (foreach gr cdrsourceannlist
	  (vl-cmdf "_-objectscale" destinationobj "" "_Add" gr "")
	    (princ)
	    );foreach	
	
       );if
      
      (setvar "CMDECHO" cmd)
      );progn
    );if
  (vla-endundomark adoc) ; undomark bottom mark
  (princ)
);defun
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 20.09.2016, 14:38
#45
VVA

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


Цитата:
Сообщение от Krieger Посмотреть сообщение
Функции RN_MatchAnntScale не работает. Нет объявления переменной sourceannlist
Мой косяк. Попробую тщательнее глянуть вечером
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 24.09.2016, 16:09
#46
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


VVA, Я пока не обновил лисп на первом посте. Когда подправишь - дай знать, поставлю твой вариант в шапку темы.
Red Nova вне форума  
 
Непрочитано 25.09.2016, 09:54
#47
VVA

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


Как вариант, только получается не match, а add
Код:
[Выделить все]
;_RN_MatchAnntScale - Копируем аннотативный масштаб (масштабы)
;_с одного объекта на другой (другие). По сути это Match Properties,
;_но только для аннотативных масштабов. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;_RN_MatchAnntScale - Копируем аннотативный масштаб (масштабы)
;_с одного объекта на другой (другие). По сути это Match Properties,
;_но только для аннотативных масштабов. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:RN_MatchAnntScale ( / sourceann sourceannlist destinationobj pr gr cmd adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (sssetfirst nil nil)
  (if
    (and
	(setq sourceann (car(entsel)))
	(IsAnnotative sourceann)
	(setq sourceannlist (GetAnnoScales sourceann))
	(setq sourceann (if (> (length sourceannlist) 1) (mydcldlg "Select annoscale" sourceannlist) (car sourceannlist)))
	(setq destinationobj (ssget))
       )
    (progn
      (setq cmd (getvar "CMDECHO"))
      (vl-cmdf "_-objectscale" destinationobj "" "_Add" sourceann "")
      (command)
      )
    )
      (vla-endundomark adoc) ; undomark bottom mark
  (princ)
);defun
Я пока не понял, какой смысл вкладывается в RN_MatchAnntScale
1. Добавить только выбранный (выбранные) масштабы
2. Установить масштабы destinationobj полностью идентичными sourceann?
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 21.10.2016 в 08:37.
VVA вне форума  
 
Автор темы   Непрочитано 25.09.2016, 15:36
#48
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Пока не понял твоей задумки так как:
Цитата:
Command: RN_MATCHANNTSCALE
Select object: ; error: no function definition: ISANNOTATIVE
А по поводу

Цитата:
Я пока не понял, какой смысл вкладывается в RN_MatchAnntScale
1. Добавить только выбранный (выбранные) масштабы
2. Установить масштабы destinationobj полностью идентичными sourceann
?
RN_MatchAnntScale я делал изначально под свои нужды, а так как я держу только один аннотативный масштаб на объекте и никогда больше, то для меня смысл RN_MatchAnntScale в том чтобы удалить у второго объекта все его прежние масштабы и назначить ему масштаб первого объекта. При написании кода возник вопрос. А что делать если у первого объекта есть несколько масштабов? Не мой конечно случай, но раз уж делаем код не только для себя то и это нужно учесть. Думал сперва подхватить тот его масштаб который виден в данный момент, но поскольку это сложно да и польза от этого сомнительна решил просто в таком случае передать второму объекту все масштабы первого. По поводу диалогового окна для RN_MatchAnntScale - не знаю будет ли это иметь смысл. Для RN_SetAnntScaleFromObj такое диалоговое окно более логично.

Последний раз редактировалось Red Nova, 25.09.2016 в 16:39.
Red Nova вне форума  
 
Непрочитано 25.09.2016, 16:37
#49
VVA

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


Цитата:
Сообщение от Red Nova Посмотреть сообщение
no function definition: ISANNOTATIVE
недостающие ф-ции в #44
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 20.10.2016, 19:01
#50
andreysmart


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


Коллеги, вот немного дополнил код, выложенный в шапке. Теперь смена масштаба с помощью Kr_DeleteAllObjectScale распространяется на примитивы AutoCAD, а так же элементы SPDS Extention.
Вложения
Тип файла: lsp Annotative Tools_v2.lsp (7.8 Кб, 39 просмотров)
andreysmart вне форума  
 
Непрочитано 24.10.2016, 19:16
#51
andreysmart


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


Еще добавил смену масштаба у штриховок. А так же для нормальной работы в заранее заданном масштабе написал реактор. Реактор реагирует на смену текущего масштаба аннотаций и устанавливает соответствующие масштабы типа линий и штриховок.
Вложения
Тип файла: lsp Annotative Tools_v2.1.lsp (8.0 Кб, 72 просмотров)
Тип файла: lsp AnScaleReactor.lsp (987 байт, 63 просмотров)
andreysmart вне форума  
 
Автор темы   Непрочитано 26.10.2016, 20:13
#52
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


andreysmart, пока не тестил, но велкам ту да клаб
Red Nova вне форума  
 
Непрочитано 23.11.2016, 15:11
#53
Vladimir_Sergeevich

рисую дороги, в перерывах курю Lisp
 
Регистрация: 20.04.2011
Пермь
Сообщений: 475
<phrase 1= Отправить сообщение для Vladimir_Sergeevich с помощью Skype™


У меня весьма предвзятое отношение к vl-cmdf, поэтому попытался избавиться от него. Все прекрасно, с одним большим НО!
(sad-addAnnoScale (car (entsel)) "1:2") добавляет масштаб
(sad-get-ann-lst (car (entsel))) возвращает список уже с новым масштабом, НО графически он не отображается...
redraw или entupd не помогают. Если сохранить чертеж, закрыть и потом открыть, то ТОГДА созданный масштаб становится видно!!
Не могу сообразить, чего для счастья мало.
Код:
[Выделить все]
 (defun sad-addAnnoScale (obj a_scale / dict_scale   ) ;|Добавление аннотативного масштаба
	Аргументы
	* Указатель на объект (см. _dwgru-conv-ent-to-ename)
	* строка - имя масштаба
	Результат
	* 
	|;
	(setq obj	(_dwgru-conv-ent-to-ename obj))
(if (and
	  (or  ;;INSERT, TEXT, MTEXT, MULTILEADER
		(= (cdr (assoc 0 (entget obj))) "INSERT")
		(= (cdr (assoc 0 (entget obj))) "TEXT")
		(= (cdr (assoc 0 (entget obj))) "MTEXT")
		(= (cdr (assoc 0 (entget obj))) "MULTILEADER")
	  )
	  (sad-search-annoScale a_scale)
	)
 (progn
    (setq dict_scales ;;collections of "ACDB_ANNOTATIONSCALES" 
		(cdr 
			(assoc -1
				(dictsearch
					(cdr 
						(assoc -1
							(dictsearch 
								(cdr (assoc 360 (entget obj))) ;;ename ExtensionDictionary 
							"AcDbContextDataManager"
							) 
						)
					)
				"ACDB_ANNOTATIONSCALES"
				)	
			)
		)
		fl t
		lst_scales '()
	)
	
	(cond 
		( (= (cdr (assoc 0 (entget obj))) "TEXT") 
			
			(dictadd 
				dict_scales ;;словарь (примитив)
				"*Z9"	;;имя (переименуется сам как надо)
				(entmakex 
					(list
						(cons 0 "ACDB_TEXTOBJECTCONTEXTDATA_CLASS")
						;;(cons 330 dict_scales)
						(cons 100 "AcDbObjectContextData")
						;;(cons 70 4)
						(cons 290 0)
						(cons 100 "AcDbAnnotScaleObjectContextData")
						(cons 340  (sad-search-annoScale a_scale)) ;;Указатель на нужный масштаб
						;;(cons 50  ) ;;Угол?
						(assoc 10 (entget obj)) ;;точка вставки текста для этого масштаба
						(list 11 0.0 0.0 0.0)
					) ;;объект
				) 
			)
			
		) ;;text

	)
)
)	
	obj ;;болтается для проверки
);;sad-addAnnoScale


(defun sad-search-annoScale (a_scale / dict_scales it_scale fl rez);|Получение ename аннотативного масштаба
	Аргументы:
	* строка - имя масштаба
	Результат:
	* ename - указатель на масштаб или nil, если не найден
	|;
(setq dict_scales (cdr (assoc -1 (dictsearch (namedobjdict) "ACAD_SCALELIST")))
	fl t
)
(while (setq it_scale (dictnext dict_scales fl))	
	(if (= (cdr (assoc 300  it_scale)) a_scale)
		(setq rez (cdr (assoc -1 it_scale)))
	) 
	(setq fl nil)
)
rez	
) ;;sad-search-annoScale

(defun sad-get-ann-lst ( obj / dict_scales it_scale fl lst_scales) ;|Получение списка аннотативных масштабов
	Аргументы 
	* любой указатель на объект (см. _dwgru-conv-ent-to-ename)
	Результат
	* список масштабов. для не аннотативного текста возвращает nil
	Проверено на BlkReference, Text, Mtext, MLeader 
	|;
(setq obj	(_dwgru-conv-ent-to-ename obj))
(if 
 (or  
	(= (cdr (assoc 0 (entget obj))) "INSERT")
	(= (cdr (assoc 0 (entget obj))) "TEXT")
	(= (cdr (assoc 0 (entget obj))) "MTEXT")
	(= (cdr (assoc 0 (entget obj))) "MULTILEADER")
 )	
 (progn
   (setq dict_scales ;;collections of "ACDB_ANNOTATIONSCALES" 
	(cdr 
		(assoc -1
			(dictsearch
				(cdr 
					(assoc -1
						(dictsearch 
							(cdr (assoc 360 (entget obj))) ;;ename ExtensionDictionary 
						"AcDbContextDataManager"
						) 
					)
				)
			"ACDB_ANNOTATIONSCALES"
			)	
		)
	)
	fl t
	lst_scales '()
)
   (while (setq it_scale (dictnext dict_scales fl))
	(setq lst_scales
		(cons
			(cdr (assoc 300 (entget (cdr (assoc -1 (entget (cdr (assoc 340  it_scale))))))))
			lst_scales
		)
		fl nil
	)
   ) 
   (reverse lst_scales)
 )
)
);;sad-get-ann-lst
словом,
__________________
Не труд сделал из обезьяны человека, а лень и жажда халявы...
Vladimir_Sergeevich вне форума  
 
Непрочитано 28.11.2016, 01:04
#54
skkkk


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


Offtop: Господа, а не место ли этой теме в "Программировании"?
skkkk вне форума  
 
Непрочитано 28.11.2016, 09:02
#55
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Перенесено
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.12.2016, 20:02
#56
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445


это тему можно добавить в "готовые программы"
Composter вне форума  
 
Непрочитано 26.08.2022, 22:22
#57
Publipor


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


Здравствуйте. Уважаемые программисты, не поскажете как именно можно изменить скрипт, таким образом, чтоб поля "Маштаб типа линий" та "Маштаб" не изменялся. А изменялась только строка "Анотативный маштаб". Зараниее спасибо.
Publipor вне форума  
 
Автор темы   Непрочитано 31.08.2022, 02:16
#58
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Publipor, Программы выложенные тут меняют только аннотативный масштаб.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 31.08.2022, 09:05
#59
Publipor


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


Цитата:
Сообщение от Red Nova Посмотреть сообщение
Publipor, Программы выложенные тут меняют только аннотативный масштаб.
К сожалению я не разобрался как сюда закинуть запись экрана, по этому выложил на облако. https://1drv.ms/v/s!Aq7U4PcGks1JiO9Q41oZC7Ac5Fd3Rw
Publipor вне форума  
 
Автор темы   Непрочитано 31.08.2022, 16:15
#60
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Publipor, Странно. У меня такого не происходит.
__________________
Блог
Red Nova вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Дополнительные команды для Аннотативных масштабов. Удаление лишних масштабов, копирование масштабов между объектами и т.п.

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как задать масштаб и чертить в сантиметрах? ACAD AutoCAD 60 24.12.2011 17:56
Юмор 2007 Огурец Разное 1172 29.12.2007 11:16
Как изменять горизонтальный масштаб, не трогая вертикальный? Grishanovich_din AutoCAD 13 23.07.2007 19:39
Как поменять кнопку по-умолчанию в DCL? Pilot Программирование 7 14.09.2003 04:18