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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Ответ
Поиск в этой теме
Непрочитано 20.07.2008, 20:12
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,980

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (Visual foxpro) программку типа суммирования столбцов списал у соседа (это уже в университете).
Не смотря на эте намерен научится писать программы для Автокада на лиспе, скачал книгу Хювенена, несколько примеров создания программ, но после получасового “смотрения” таких книг мое мышление явно притормаживает.
Решил пойти другим путем.
Нашел самый короткий лисп из моей коллекции, и прошу программистов с этого форума пошагово объяснить какой символ что означает. Надеюсь на вашу помощь.


Код:
[Выделить все]
(defun c:make-blocks-explodeable (/ adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (equal (vla-get-isxref blk_def) :vlax-false)
             (equal (vla-get-islayout blk_def) :vlax-false)
             ) ;_ end of and
      (vl-catch-all-apply '(lambda () (vla-put-explodable blk_def :vlax-true)))
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
_____________________________________________________________________________________________________________

Прошло много лет и топик теперь представляет из себя площадку для обучения азов программирования для многих начинающих.
Так что начинающие лиспогрызы приветствуются .
__________________
Блог

Последний раз редактировалось Red Nova, 12.07.2017 в 05:43.
Просмотров: 1965781
 
Непрочитано 13.11.2010, 19:44
#1141
Li6-D


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


В свое время обдумывал где и как хранить информацию о "контактных" точках блоков.
То есть точек блока, которые могут соединяться меж собой в схеме или графике каком...
В моем случае было достаточно 4 групп "контактных" точек по квадрантам - верх, низ, лево, право.
В итоге решил хранить в самих блоках, добавляя в них с помощью простейшего лиспа отрезки, которые:
1 имеют строго определенную длину, которая на несколько порядков меньше размеров блока;
2 содержат группу невидимости (60 . 1).
Другой лиспик извлекает список "контактных" точек при указании на вставленный в чертеж блок.
Примитивно, но это работает
Li6-D вне форума  
 
Непрочитано 14.11.2010, 00:40
#1142
Кулик Алексей aka kpblc
Moderator

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


puma, а можно полный код напомнить? Я просто подобных ошибок не ловил...
P.S. Проверить смогу только завтра вечером
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.11.2010, 00:51
#1143
puma


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


Полный код той версии реактора, что использую, (без изменений) со всеми доп.функциями. Если где затесались мои комментарии - сорри, пока разбирался - комментировал что где делается. Ошибка появляется при таком порядке:
Требуется создать объект на слое со штрихпунктирным типом линий (подгружаю из стороннего файла, не acadiso; наименование типа линий на русском - добавлял в список, и он находился). После создания первого - создаем второй объект. Слой при этом меняет тип линий на обычный.
Возможно я не то исправил, но, кажется, если тип линий загружен и снова происходит обращение к функции подгрузки типов линий - она выдает nil, что приводит к загрузке стандартной линии. Исправление по русскому/английскому наименованию делал почти наугад, так как после того как функцию подгрузки линии исправил, чтобы выдавала T - начала вылетать функция создания слоя с ошибкой. Хотя скорее всего у меня просто кривые руки. Спасибо за чудесный реактор, и заранее за ответ
Код:
[Выделить все]
(vl-load-com)
(if (not *kpblc-activedoc*)
  (setq *kpblc-activedoc* (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

;|=============================================================================
*    Создание слоя с указанными параметрами.
*    Параметры вызова:
*   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"
   )
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*    Слой размораживается, разблокируется и включается. Не активируется.
|;
(defun _kpblc-layer-create (layer-list / vla_layer)
  (setq    vla_layer
     (vla-add
       (vla-get-layers *kpblc-activedoc*)
       (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 *kpblc-activedoc*)
          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))
  (cond
    ((vl-string-search "dim" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Размеры")
       ("color" . 5)
       ("lw" . 13)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "qleader" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Позиции")
       ("color" . 114)
       ("lw" . 13)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "leader" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Позиции")
       ("color" . 114)
       ("lw" . 13)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "xline" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "ProjectionLines")
       ("color" . 100)
       ("lw" . 13)
               ("plot" . "n")
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "table" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Спецификация")
       ("color" . 7)
       ("lw" . 20)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "vports" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "VPORTS")
       ("color" . 40)
       ("lw" . 13)
       ("plot" . "n")
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (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 *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Штриховки")
       ("color" . 6)
       ("lw" . 13)
       )
     ) ;_ 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 *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Тексты")
       ("color" . 194)
       ("lw" . 13)
       )
     ) ;_ 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 "qleader" cmd_name)
             (vl-string-search "leader" cmd_name)
     (vl-string-search "xline" cmd_name)
             (vl-string-search "table" cmd_name)
             (vl-string-search "vports" cmd_name)
     (vl-string-search "text" cmd_name)
     (vl-string-search "hatch" cmd_name)
     ) ;_ end of or
     (if *vlr-settings*
       (progn
     (vla-put-activelayer
       *kpblc-activedoc*
       (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 "qleader" cmd_name)
             (vl-string-search "leader" cmd_name)
             (vl-string-search "xline" cmd_name)
             (vl-string-search "table" cmd_name)
             (vl-string-search "vports" cmd_name)
     (vl-string-search "text" cmd_name)
     (vl-string-search "hatch" cmd_name)
     ) ;_ end of or
     (if *vlr-settings*
       (progn
     (vla-put-activelayer
       *kpblc-activedoc*
       (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

Последний раз редактировалось puma, 14.11.2010 в 18:11.
puma вне форума  
 
Непрочитано 14.11.2010, 17:08
#1144
Frigate

КИП, АСУ ТП, слаботочка
 
Регистрация: 02.09.2010
Москва-Тюмень
Сообщений: 422


Li6-D,

не очень понятно, как эти отрезке в блоке помогают тебе и главное - когда именно? МОжно, ксати, ставить объект-точку.

Я бы хранил возможные точки подключения в расширенных данных. Или в словаре примитива - или это одно и то же? )))

Но вот как эти данные получать для записи? Откуда?
Frigate вне форума  
 
Непрочитано 14.11.2010, 19:37
#1145
Li6-D


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


Frigate,
во вложенном чертеже приведен фрагмент графика Ганта, блоки которого содержат "контактные" точки, служащие для соединения блоков между собой.
Просмотреть список точек можно так: (label_block (car (entsel))), где label_block:
Код:
[Выделить все]
;;;Функция проверяет является ли примитив b блоком с "контактными" точками и
;;;возвращает список координат его "контактных" точек относительно точки вставки.
;;;Иначе возвращается nil.
(defun label_block (b / dl tol L LqN)
  (setq dl 1E-3        ;длина отрезка-метки
        tol 0.1        ;предельное относительное отклонение длины
        tol (* tol dl)
        b (entget b)
  )
  (if (= (cdr (assoc 0 b)) "INSERT")
    (progn
      (setq b (cdr (assoc -2 (tblsearch "BLOCK" (cdr (assoc 2 b))))))
      (while b
        (if (and
              (= (cdr (assoc 0 (setq b (entget b)))) "LINE")
              (= (cdr (assoc 60 b)) 1)
              (progn (setq L (list (cdr (assoc 10 b)) (cdr (assoc 11 b))))
                     (<= (abs (- (apply 'distance L) dl)) tol)
            ) )
          (setq LqN (cons (cons (rem (fix (+ (/ (apply 'angle L) pi 0.5) 0.5)) 4) (car L)) LqN))
        )
        (setq b (entnext (cdar b)))
  ) ) )
  LqN
)
Почему отрезки, а не точки? - чтобы добавить еще один код перед координатами точки (от 0 до 3).
Точки с кодом 0 соединяются только с 2, а 1 с 3.
При необходимости можно еще и тип линии загружать.
Вложения
Тип файла: dwg
DWG R14
Фрагмент графика Ганта.dwg (63.6 Кб, 3560 просмотров)

Последний раз редактировалось Li6-D, 14.11.2010 в 20:04.
Li6-D вне форума  
 
Непрочитано 14.11.2010, 21:12
#1146
Frigate

КИП, АСУ ТП, слаботочка
 
Регистрация: 02.09.2010
Москва-Тюмень
Сообщений: 422


Li6-D,

интересный вариант, спасибо.

А как у тебя так получилось, что отрезочки эти миниатюрные видны в редакторе, а в самом чертеже их не видно?
Frigate вне форума  
 
Непрочитано 14.11.2010, 21:50
#1147
Li6-D


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


Frigate,
как я уже говорил, в dxf-коде отрезков содержится группа (60 . 1), делающая примитивы невидимыми. Добавь эту группу в любой примитив с помощью (entmod (cons '(60 . 1) (entget (car (entsel))))) и он станет невидимым, не будет захватываться рамкой. Но этот примитив никуда из чертежа не делся, его можно даже захватить опциями "_Last", "_All". Посмотреть dxf-список всех примитивов чертежа, включая невидимые объекты, можно так:
Код:
[Выделить все]
;;; Печать DXF-списков всех примитивов чертежа
(defun C:Print-Dwg-All ( / ss i)
  (repeat (if (setq ss (ssget "_X")) (setq i (sslength ss)) (progn (alert "Ничего нет") 0))
    (print (entget (ssname ss (setq i (1- i))))) (print))
  (textscr)
  (princ)
)
Li6-D вне форума  
 
Непрочитано 15.11.2010, 01:05
#1148
Кулик Алексей aka kpblc
Moderator

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


puma, я сейчас проверил код - ни команда создания отрезков, ни команда создания полилиний в реакторе не отслеживаются. Создание текста в слое с типом линии "не-Continuous" корректно вернуло все настройки обратно. Может, еще есть какие-то дополнительные приложения?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.11.2010, 01:41
#1149
puma


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


Насчет полилиний и отрезков - извините, ввел вас в заблуждение, но при тексте также повторяется ошибка при том коде, что я выложил. Все дополнительные приложения временно были удалены. Autocad 2011. Скорее всего просто у вас в коде уже это исправлено. Извините за беспокойство как исправить более менее разобрался, тем более нашел на форуме ваш архив, который вы пересылали ShaggyDoc. Как я понял там как раз это уже исправлено (смысл исправлений, что и у меня, но гораздо элегантней - мне еще лет 10 учиться надо), но жутко завязано на базе данных. Жаль, что наиболее распространена на форуме старая версия. Еще раз спасибо за великолепные функции.

Последний раз редактировалось puma, 15.11.2010 в 01:54.
puma вне форума  
 
Непрочитано 15.11.2010, 09:39
#1150
Frigate

КИП, АСУ ТП, слаботочка
 
Регистрация: 02.09.2010
Москва-Тюмень
Сообщений: 422


Li6-D,

а ты DXF-код отрезков где менял? Программно, когда запущен редактор блоков? Или уже в чертеже?


Прошу знающих помочь со следующими 2 вопросами:

1. Как для блока задать цвет? Через TrueColor? А дальше как? Если можно - дайте пример.

2. Создание Группы ( в семействе блоков).
Имеется - список (list) VLA-указателей на блоки: obj_list. Всего в списке 17 блоков (указателей на блоки).
Надо сгруппировать эти блоки в единую группу, чтобы можно было их разом всех вместе выделять и перетаскивать.

ВОт так пытался сделать:

Код:
[Выделить все]
(setq safe_ar (vlax-make-safearray vlax-vbObject '(0 . 16)))
(vlax-safearray-fill safe_ar obj_list)
(vlax-safearray->list safe_ar)
(setq var_list (vlax-make-variant safe_ar (logior vlax-vbarray vlax-vbObject)))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq blocks_col (vla-get-blocks adoc))
(setq a (vlax-3d-point '(0.0 0.0 0.0)))
(vla-add blocks_col a "LabelsGroup1")
(vla-appenditems var_list)
В ответ получил вот что:

Цитата:
Команда: (vla-appenditems var_list)
; ошибка: неверный тип аргумента: VLA-OBJECT #<variant 8201 ...>
В чем именно я ошибся при создании варианта из массива объектов?
Frigate вне форума  
 
Непрочитано 15.11.2010, 11:00
#1151
TararykovDG

Программист-энтузиаст
 
Регистрация: 17.07.2009
Воронеж
Сообщений: 571


Frigate, а не проще ли запихнуть нужные блоки в набор
Код:
[Выделить все]
(setq nbr_blocks (ssadd)) ; создали пустой набор
(foreach item obj_list (setq nbr_blocks (ssadd (vlax-vla-object->ename item) nbr_blocks))) ; запихнули в него блоки
...
(sssetfirst nil nbr_blocks) ; на экране подсветились объекты набора nbr_blocks (хошь копирую, хошь перетаскивай, хошь удаляй все разом)
__________________
cadtools
TararykovDG вне форума  
 
Непрочитано 15.11.2010, 11:16
#1152
Frigate

КИП, АСУ ТП, слаботочка
 
Регистрация: 02.09.2010
Москва-Тюмень
Сообщений: 422


TararykovDG,

но этот набор сразу же исчезнет после любой операции, так ведь?
Тогда это не совсем то. Хотелось бы, чтоб пользователь мог легко перетащить весь набор в любой момент времени, да и скопировать, если что - не выбирая каждый блок.

Что посоветуешь - в чем моя ошибка в коде?

Последний раз редактировалось Frigate, 15.11.2010 в 11:39.
Frigate вне форума  
 
Непрочитано 15.11.2010, 11:32
#1153
Лиспер


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


Цитата:
Сообщение от Frigate Посмотреть сообщение
Как для блока задать цвет?
Для описания блока или для вхождения блока? В любом случае есть vla-put-color, который понимает индексированные цвета.
Цитата:
Сообщение от Frigate Посмотреть сообщение
Создание Группы ( в семействе блоков).
Тут вообще ничего не понял. О создании групп объектов см., например, http://www.cadtutor.net/forum/showth...-about-groups&
__________________
(/= RegDate StartReadDate)
Лиспер вне форума  
 
Непрочитано 15.11.2010, 11:39
#1154
TararykovDG

Программист-энтузиаст
 
Регистрация: 17.07.2009
Воронеж
Сообщений: 571


Frigate, а зачем Тебе объединять объекты в блок, только для того чтобы потом работать с ними всему сразу при копировании и др. операциях. В моем варианте я запихнул все нужные объекты в набор nbr_blocks и теперь (если конечно этот набор не переопределить) я могу в любой момент сделать (sssetfirst nil nbr_blocks). Подсветяться ручки наших объектов и делай с ними что надо.
Если хочешь посмотри еще такой вариант Повтор предыдущего выбора элементов
__________________
cadtools
TararykovDG вне форума  
 
Непрочитано 15.11.2010, 11:53
#1155
Frigate

КИП, АСУ ТП, слаботочка
 
Регистрация: 02.09.2010
Москва-Тюмень
Сообщений: 422


Лиспер,

вот уж спасибо

а все-таки, ради интересе - что неверного в моем коде? Вроде все по описанию объектной модели делал...

TararykovDG

а после закрытия чертежа ведь этот набор исчезнет, так?
Или его можно как-то сохранить?
Frigate вне форума  
 
Непрочитано 15.11.2010, 12:03
#1156
Лиспер


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


Ты создаешь блок, а не группу. Для создания группы можно использовать нечто типа
Код:
[Выделить все]
(vla-add (vla-get-groups adoc) name)
И в результат уже выполнять vla-appenditems
__________________
(/= RegDate StartReadDate)
Лиспер вне форума  
 
Непрочитано 15.11.2010, 12:45
#1157
TararykovDG

Программист-энтузиаст
 
Регистрация: 17.07.2009
Воронеж
Сообщений: 571


Цитата:
Сообщение от Frigate Посмотреть сообщение
TararykovDG

а после закрытия чертежа ведь этот набор исчезнет, так?
Или его можно как-то сохранить?
Ну можно сделать чтобы сохранялся и после закрытия чертежа. Способов сохранения информации много, но в данноч случая ИМХО лучше всего создать словарь и в него записать набор. Во-первых никаких доп. файлов, никаких заморечей с реестром и для каждого чертежа будет свой словарь в котором своя инфа именно с этого чертежа + при копировании /переносе/переименовании чертежа даже на разные компы вся инфа сохраняется вместе с самим чертежом
__________________
cadtools
TararykovDG вне форума  
 
Непрочитано 15.11.2010, 13:13
#1158
Лиспер


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


Решение тоже не ахти: в словарях придется хранить хендлы, которые могут повторяться при вставке этого чертежа как внешней ссылки. Я такое всего один раз встречал, но сам факт напрягает.
__________________
(/= RegDate StartReadDate)
Лиспер вне форума  
 
Непрочитано 15.11.2010, 13:32
#1159
Frigate

КИП, АСУ ТП, слаботочка
 
Регистрация: 02.09.2010
Москва-Тюмень
Сообщений: 422


Лиспер,
ну внешней сылкой я его вставлять не буду - это точно.

А просто группа будет перетаскиваться вся целиком если ее мышкой ухватить?

TararykovDG,

со словарями уже немного знаком - набил руку. Хорошо, наверное такой способ мне подойдет.

Последний раз редактировалось Frigate, 15.11.2010 в 13:40.
Frigate вне форума  
 
Непрочитано 15.11.2010, 16:15
#1160
E-degtyarev

Помогаю, кому делать нечего.
 
Регистрация: 27.03.2009
Русская деревня
Сообщений: 394


Подскажите, пожалуйста, как получить Lisp-ом координаты центра тяжести REGION -а? Сильно замучился я с этим делом.
E-degtyarev вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 272 06.06.2021 23:12
Сейсмозащита и сейсмоизоляция существующих, построенных зд. IANationalInformAgentstvo Прочее. Архитектура и строительство 216 20.01.2015 16:51
Мониторы LCD CRT Разное 94 17.06.2008 10:51
ЮМОР 2006 =) Perezz!! Разное 1122 04.01.2007 00:46