Schöck
Показать сообщение отдельно
 
Непрочитано 28.02.2012, 14:35
#273
Positron


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


Цитата:
Сообщение от Михаил055 Посмотреть сообщение
Раньше при простановке размеров они сами создавались на слое "Dim". Но размеры написал сам. Теперь некоторые использую штатные. Линейные и угловые. Чтобы они тоже были на слое "Dim" сделал пунккт меню, с помощью которого запускаю функцию пересылающую все размеры на этот слой. Делаю это периодически или в конце работы.

Функция вот такая:

(defun CHGL_dim ()
(setvar "cmdecho" 0)
(setq Ss1 (ssget "X"'((0 . "DIMENSION"))))

(setq $lay (getvar "CLAYER"))

(command "_layer" "_m" "dim" "")
(command "_change" Ss1 "" "_prop" "_layer" "dim" "")

(command "_layer" "_set" $lay "")
(princ)
);end CHGL_dim
1. Возникла такая трудность, есть много "старых чертежей" и новых, при копии из "старых чертежей" возникает наложение (смешение) стилей из "старых чертежей" и новых.
2. Каждый стиль имеет свой слой соответственно добавляются ненужные "старые слоя".
Вобщем каша...
Помогите плиз, чтоб старые стили заменялись новыми и слоя тоже.
Замена
Стиль - "01_1 X 1" на "01_1X1"
и Слой "02 DIM (1x5)" на "02 DIM (1x4-5)"



;; Перенесение заданных примитивов (размеры, штриховка, текст) на заданный слой
Код:
[Выделить все]
 (if (not activedocument)
  (setq activedocument (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of if

(if *vlr-cmd*
  (progn (setq *vlr-cmd* nil) (vlr-remove-all :vlr-command-reactor)) ;_ end of progn
  ) ;_ end of if
(if (not *vlr-cmd*)
  (setq *vlr-cmd*
         (vlr-command-reactor "cmd"
                              '(
                                (:vlr-commandwillstart . cmd-start)
                                (:vlr-commandended . cmd-end)
                                (:vlr-commandcancelled . cmd-cancel)
                                (:vlr-commandfailed . cmd-fail)
                                )
                              ) ;_ end of VLR-Command-Reactor
        ) ;_ end of setq
  ) ;_ end of if
;; Функция подгрузки типа линии - на http://www.autocad.ru/cgi-bin/f1/board.cgi?t=22730iW

;|=============================================================================
*    Создание слоя с указанными параметрами.
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*   layer-list   список параметров слоя вида:
   '(("name" . "TestLayer")   ; имя слоя. Не может быть пропущено
   ("color" . 3)         ; номер цвета. nil -> 7
   ("lw" . 50)         ; вес линии слоя. nil -> 25
   ("lt" . "hidden")      ; тип линии слоя. nil -> Continuous
               ; Если описания типа линии в acadiso.lin
               ; нет, обязательно указывать следующий
               ; параметр
   ("ltfile" . "c:\\cad\\ltypes\\lt.lin")   ; полный путь к файлу с описанием
               ; типа линии. Если файл находится в путях
               ; поддержки, путь можно не указывать
   ("plot" . "y")         ; Печатать ("y") или нет ("n") слой.
               ; nil -> "y"
   )
*    Слой размораживается, разблокируется и включается. Не активируется.
|;
(defun _kpblc-layer-create (layer-list / vla_layer)
  (setq vla_layer (vla-add (vla-get-layers activedocument)
                           (cdr (assoc "name" layer-list))
                           ) ;_ end of vla-add
        ) ;_ end of setq
  (vla-put-color vla_layer
                 (if (cdr (assoc "color" layer-list))
                   (cdr (assoc "color" layer-list))
                   7
                   ) ;_ end of if
                 ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if (cdr (assoc "lw" layer-list))
      (cdr (assoc "lw" layer-list))
      aclnwt025
      ) ;_ end of if
    ) ;_ end of vla-put-lineweight
  (if (and (cdr (assoc "lt" layer-list))
           (_kpblc-linetype-load
             (cdr (assoc "lt" layer-list))
             (cdr (assoc "ltfile" layer-list))
             ) ;_ end of _kpblc-linetype-load
           ) ;_ end of and
    (vla-put-linetype vla_layer (cdr (assoc "lt" layer-list)))
    (vla-put-linetype vla_layer "Continuous")
    ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if (= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
      ) ;_ end of if
    ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer activedocument)
                  vla_layer
                  ) ;_ end of equal
           ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
    ) ;_ end of if
  vla_layer
  ) ;_ end of defun

(defun cmd-start (react cmd / selset cmd_name ent svr res tag text index _attreq_ _attdia_)
  (setq cmd_name (strcase (car cmd) t))
  (setq *dim_style* (strcase (getvar "dimstyle")))
  (cond
    ((vl-string-search "dim" cmd_name)
     (setq *vlr-settings* (list (cons "layer" (vla-get-activelayer activedocument)) ;_ end of cons
                                (cons "color" (getvar "cecolor"))
                                (cons "lw" (getvar "celweight"))
                                (cons "lt" (getvar "celtype"))
                                ) ;_ end of list
           ) ;_ end of setq
     (cond
       ((= *dim_style* "00_5X1")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (05X1)"))))
        )
       ((= *dim_style* "01_1X1")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1x1)"))))
        )
       ((= *dim_style* "02_1X2")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1x2)"))))
        )
       ((= *dim_style* "03_1X4")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1x4-5)"))))
        )
       ((= *dim_style* "04_1X5")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1x4-5)"))))
        )
       ((= *dim_style* "05_1X8")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1х08-10)"))))
        )
       ((= *dim_style* "06_1X10")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1х08-10)"))))
        )
       ((= *dim_style* "07_1X16")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1х16-20)"))))
        )
       ((= *dim_style* "08_1X20")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1х16-20)"))))
        )
       ((= *dim_style* "09_1X30")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1х30-40)"))))
        )
       ((= *dim_style* "10_1X40")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1х30-40)"))))
        )
       ((= *dim_style* "11_1X75")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1х75-100)"))))
        )
       ((= *dim_style* "12_1X100")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM (1х75-100)"))))
        )
       ((= *dim_style* "Annotative")
        (vla-put-activelayer activedocument (_kpblc-layer-create '(("name" . "02 DIM"))))
        )
       ) ;_ end of cond
     ;;cond
     (mapcar 'setvar '("cecolor" "celweight" "celtype") '("bylayer" -1 "bylayer")) ;_ end of mapcar
     )
    ((vl-string-search "hatch" cmd_name)
     (setq *vlr-settings*
            (list (cons "layer" (vla-get-activelayer activedocument)) ;_ end of cons
                  (cons "color" (getvar "cecolor"))
                  (cons "lw" (getvar "celweight"))
                  (cons "lt" (getvar "celtype"))
                  ) ;_ end of list
           ) ;_ end of setq
     (vla-put-activelayer activedocument
                          (_kpblc-layer-create '(("name" . "03 HATCH") ("color" . 253) ("lw" . 0))) ;_ end of _kpblc-layer-create
                          ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar '("cecolor" "celweight" "celtype") '("bylayer" -1 "bylayer")) ;_ end of mapcar
     )
    ((vl-string-search "text" cmd_name)
     (setq *vlr-settings* (list (cons "layer" (vla-get-activelayer activedocument)) ;_ end of cons
                                (cons "color" (getvar "cecolor"))
                                (cons "lw" (getvar "celweight"))
                                (cons "lt" (getvar "celtype"))
                                ) ;_ end of list
           ) ;_ end of setq
     (vla-put-activelayer activedocument
                          (_kpblc-layer-create '(("name" . "10 Text"))) ;_ end of _kpblc-layer-create
                          ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar '("cecolor" "celweight" "celtype") '("bylayer" -1 "bylayer")) ;_ end of mapcar
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-end (react cmd / list_obj selset item counter leader_item cmd_name leader_item_list up_string low_string)
  (setq cmd_name (strcase (car cmd) t)
        counter  0
        ) ;_ end of setq
  (cond
    ((or (vl-string-search "dim" cmd_name)
         (vl-string-search "text" cmd_name)
         (vl-string-search "hatch" cmd_name)
         ) ;_ end of or
     (if *vlr-settings*
       (progn
         (vla-put-activelayer
           activedocument
           (cdr (assoc "layer" *vlr-settings*))
           ) ;_ end of vla-put-ActiveLayer
         (mapcar 'setvar
                 '("cecolor" "celweight" "celtype")
                 (list (cdr (assoc "color" *vlr-settings*))
                       (cdr (assoc "lw" *vlr-settings*))
                       (cdr (assoc "lt" *vlr-settings*))
                       ) ;_ end of list
                 ) ;_ end of mapcar
         (setq *vlr-settings* nil)
         ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-cancel (react cmd / cmd_name)
  (setq cmd_name (strcase (car cmd) t))
  (cond
    ((or (vl-string-search "dim" cmd_name)
         (vl-string-search "text" cmd_name)
         (vl-string-search "hatch" cmd_name)
         ) ;_ end of or
     (if *vlr-settings*
       (progn
         (vla-put-activelayer
           activedocument
           (cdr (assoc "layer" *vlr-settings*))
           ) ;_ end of vla-put-ActiveLayer
         (mapcar 'setvar
                 '("cecolor" "celweight" "celtype")
                 (list (cdr (assoc "color" *vlr-settings*))
                       (cdr (assoc "lw" *vlr-settings*))
                       (cdr (assoc "lt" *vlr-settings*))
                       ) ;_ end of list
                 ) ;_ end of mapcar
         (setq *vlr-settings* nil)
         ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

;|=============================================================================
*    Функция подгрузки типа линии в текущий файл. Учитывает возможную
* локализацию системы.
*    Параметры вызова:
*  ltype-name  имя типа линии для английской версии
*  ltype-file  имя файла описания типа линии. nil -> "acadiso.lin"ю
*      Если файл с описанием типа линии не лежит по путям
*      поддержки када, надо указывать полный путь к нему.
*    Примеры вызова:
(_kpblc-linetype-load "center" nil)  ; для русской версии подгружает Осевая и возвращает
                                     ; t при успехе
***  Соответствие наименований линий обеспечивается огромным списком ltype_list
*** который можно и нужно дополнять :) Только надо либо все делать мелкими
*** буквами, либо жестко соблюдать регистр в моменты вызовов.
***  Тип линии "Continuous" обработке не подвергается — он есть во всех версиях
=============================================================================|;
(defun _kpblc-linetype-load
                            (ltype-name ltype-file / ltype_normal ltype_list result)
  (vl-load-com)
  (setq ltype_list '(("center" . "осевая")
                     ("center2" . "осевая2")
                     ("hidden" . "скрытая")
                     ("hidden2" . "скрытая2")
                     )
        ltype-name (strcase ltype-name t)
        ) ;_ end of setq
  (if (not ltype-file)
    (setq ltype-file "acadiso.lin")
    ) ;_ end of if
  (if (vl-string-search "419" (vlax-product-key))
    ;; Русская версия, меняем имя типа линии
    (setq ltype_normal (cdr (assoc ltype-name ltype_list)))
    (setq ltype_normal ltype-name)
    ) ;_ end of if
  (if (not (tblsearch "ltype" ltype_normal))
    ;; тип линии не найден, надо его загрузить. Тип линии должен быть
    ;; описан в файле
    (setq result (not (vl-catch-all-error-p
                        (vl-catch-all-apply
                          'vla-load
                          (list
                            (vlax-get-property
                              (vla-get-activedocument (vlax-get-acad-object))
                              'linetypes
                              ) ;_ end of vlax-get-property
                            ltype_normal
                            ltype-file
                            ) ;_ end of list
                          ) ;_ end of vl-catch-all-apply
                        ) ;_ end of vl-catch-all-error-p
                      ) ;_ end of not
          ) ;_ end of setq
    ) ;_ end of if
  result
  ) ;_ end of defun

Последний раз редактировалось Кулик Алексей aka kpblc, 16.11.2012 в 13:48.
Positron вне форума  
 
Размещение рекламы