Schöck
Показать сообщение отдельно
 
Автор темы   Непрочитано 25.02.2009, 18:38
#19
VVA

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


SkyLine, Вариант CPSSL с показом назначенных форматов и ориентаций
Буква P означает Portrait, L - Landscape
Если по каким-либо причинам не удалось получить формат листа (отключен сетевой принтер или удален, а pc3 остался), то вместо формата будет отображаться ?
Код:
[Выделить все]
(defun c:CPSSL (/     adoc
  page_setups    dcl_id
  userclick    selection
  plotcfg     loc:get_page_setup
  loc:getSelectedItems
  loc:dwgru-get-user-dcl
        )
;;;
;;;posted whdjr
;;;http://www.theswamp.org/index.php?topic=12439.msg153420#msg153420
;;;Modifyed VVA 21.01.2008 http://dwg.ru/f/showthread.php?t=16792
;;Change Page Setups on Select Layout (CPSSL)
;;;  
  (defun loc:get_page_setup (doc func / lst)
    (vlax-map-collection
      (vla-get-plotconfigurations doc)
      '(lambda (x) (setq lst (cons ((eval func) x) lst)))
    ) ;_ end of vlax-map-collection
    (reverse lst)
  ) ;_ end of defun
;;;
  (defun loc:getSelectedItems (tilename AllItemsList / indexes)
    (if (setq indexes (get_tile tilename))
      (setq indexes (read (strcat "(" indexes ")"))
     indexes (mapcar '(lambda (n) (nth n AllItemsList))
       indexes
      ) ;_ end of mapcar
      ) ;_ end of setq
    ) ;_ end of if
    indexes
  ) ;_ end of defun
;;;
;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2008  DWGru Programmers Group
;;; *
;;; * loc:dwgru-get-user-dcl (Кандидат)
;;; *
;;; * Запрос значения у пользователя через диалоговое окно
;;; *
;;; *
;;; * 21/01/2008 Версия 0001. Редакция Владимир Азарко (VVA)
;;; ************************************************************************

  (defun loc:dwgru-get-user-dcl
  (zagl info-list multi / fl ret dcl_id msg layouts)
  ;|
* Запрос значения у пользователя через диалоговое окно
* Диалог формируется "налету"
* Параметры вызова:
    zagl - заголовок окна [String]
    info-list - список строковых значений[List of String]
    multi - t - разрешен множественный выбор, nil- нет
    
* Возвращает:
 Список выбранных строк или nil - отмена
* Пример
 (loc:dwgru-get-user-dcl "Укажите вариант" '("Первый" "Второй" "Третий") nil) ->("Первый") 
 (loc:dwgru-get-user-dcl "Укажите вариант" '("Первый" "Второй" "Третий") t) ->("Первый" "Второй") 
|;
    (if (null zagl)
      (setq zagl "Выбор")
    ) ;_ end if
    (setq fl (vl-filename-mktemp "dwgru" nil ".dcl"))
    (setq ret (open fl "w"))
    (mapcar
      '(lambda (x) (write-line x ret))
      (list "dwgru_msg : dialog { "
     (strcat "label=\"" zagl "\";")
     " :list_box {"
     "alignment=top ;"
     (if multi
       "multiple_select = true ;"
       "multiple_select = false ;"
     ) ;_ end of if
     "width=31 ;"
     (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 (null (minusp (setq dcl_id (load_dialog fl))))
      (new_dialog "dwgru_msg" dcl_id)
 ) ;_ end and
      (progn
 (start_list "info")
 (mapcar 'add_list info-list)
 (end_list)
 (set_tile "info" "0")
 (setq ret "0")
 (action_tile "info" "(setq ret $value)")
 (action_tile "cancel" "(done_dialog 0)")
 (action_tile "accept" " (done_dialog 1)")
 (if (zerop (start_dialog))
   (setq ret nil)
   (setq
     ret (mapcar (function (lambda (num) (nth num info-list)))
   (read (strcat "(" ret ")"))
  ) ;_ end mapcar
   ) ;_ end setq
 ) ;_ end if
 (unload_dialog dcl_id)
      ) ;_ end of progn
    ) ;_ end of if
    (vl-file-delete fl)
    ret
  ) ;_ end of defun
(defun loc:catch ( func  / ret)
  (if (VL-CATCH-ALL-ERROR-P (setq ret (vl-catch-all-apply
         '(lambda()(eval func)))))
    "?"
    ret
  )
  )
;;;
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq page_setups
  (loc:get_page_setup
    adoc
    '(lambda (x)
       (if (eq (vla-get-modeltype x) :vlax-false)
  (strcat
    (vla-get-name x)
    (if (= (loc:catch '(vla-get-CanonicalMediaName x)) "")
      " [Нет]"
      (strcat " [ "
       (loc:catch '(vla-GetLocaleMediaName x (vla-get-CanonicalMediaName x)))
        (if (zerop(vla-get-PlotRotation x)) " P" " L")
       " ]"
        )
      )
  )
  nil
       ) ;_ end of if
     ) ;_ end of lambda
  ) ;_ end of loc:get_page_setup
  ) ;_ end of setq
;;;_Change VVA
  (setq page_setups (vl-remove-if 'null page_setups))
;;;_Add VVA
  (if (and page_setups
    (setq selection (loc:dwgru-get-user-dcl
        "Select Page Setups"
        page_setups
        nil
      ) ;_ end of loc:dwgru-get-user-dcl
    ) ;_ end of setq
    (setq selection
    (mapcar '(lambda(x / l)(setq l (strlen x))
        (while (/= (substr x l 1) "[")
          (setq l (1- l)))
        (substr x 1 (- l 2)))
     selection
     )
   )
    (setq
      layouts (loc:dwgru-get-user-dcl
         "Select Layouts with Shift or Ctrl"
         (acad_strlsort
    (mapcar
      '(lambda (y / x)
         (setq x (vla-item (vla-get-Layouts adoc) y))
         (strcat
    y
    (if (= (loc:catch '(vla-get-CanonicalMediaName x)) "")
      " [Нет]"
      (strcat " [ "
       (loc:catch '(vla-GetLocaleMediaName x (vla-get-CanonicalMediaName x)))
       (if (zerop(vla-get-PlotRotation x)) " P" " L")
         " ]"
      )
    )
    
         )
       )
      (LAYOUTLIST)
    )
         )
         t
       ) ;_ end of loc:dwgru-get-user-dcl
    ) ;_ end of setq
    (setq layouts
    (mapcar '(lambda(x / l)(setq l (strlen x))
        (while (/= (substr x l 1) "[")
          (setq l (1- l)))
        (substr x 1 (- l 2)))
     layouts
     )
   )
    (setq plotcfg (vla-item (vla-get-plotconfigurations adoc)
       (car selection)
    ) ;_ end of vla-item
    ) ;_ end of setq
      ) ;_ end of and
    (vlax-map-collection
      (vla-get-layouts adoc)
      '(lambda (x)
  (if (and (eq (vla-get-modeltype x) :vlax-false)
    (member (vla-get-name x) layouts)
      ) ;_ end of and
    (vla-copyfrom x plotcfg)
  ) ;_ end of if
       ) ;_ end of lambda
    ) ;_ end of vlax-map-collection
  ) ;_ end of if
  (vl-cmdf "_.REGENALL")
  (princ)
) ;_ end of defun
(princ "\nType CPSSL in command line")
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 02.03.2009 в 11:20. Причина: Обработка отсутсвующих притеров (пост #27)
VVA вне форума  
 
Размещение рекламы