[Red Nova]

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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

_____________________________________________________________________________________________________________

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

[gomer]

Сообщение от Li6-D вот еще вариант:

В принципе тоже, что и мое, но меня вот посетила мысль, что mapcar более удобна для длинных списков и простых функций, foreach более удобна для "коротких" списков и "глубоких" функций...

[puma]

Не подскажете, каким самым простым способом через lisp можно изменить масштаб динамического блока относительно базовой точки, не трогая (так чтобы не менялись) определенные динамические характеристики? заранее спасибо

[Кулик Алексей aka kpblc]

Michael!, я ж алгоритм показал. ShaggyDoc предоставил пример функции по созданию полилинии.
Все просто: формируется список координат, а потом уже строится новый объект.

Сообщение от Michael! Или ручками все передвигать как раньше и незаморачиваться с программой.

Или изменить мой вариант кода, заменив запрос step на вычисляемое выражение.

Сообщение от gomer но меня вот посетила мысль, что mapcar более удобна для длинных списков и простых функций, foreach более удобна для "коротких" списков и "глубоких" функций...

ИМХО неверно. mapcar возвращает список, foreach - nil. Разница однако.

Сообщение от puma изменить масштаб динамического блока относительно базовой точки, не трогая (так чтобы не менялись) определенные динамические характеристики

Если через ActiveX, то vla-put-scale. А "определенные динамические характеристики" - это какие?

[puma]

например, есть динамический блок разреза, после увеличения он сбивается, что не очень хорошо, чтобы вернуть все назад надо полярному параметру вернуть все обратно. Единственное, что приходит в голову - чтение сначала необходимых значений и после увеличения - снова их установить, просто может есть более простой путь? про vla-put-scale - спасибо, никак не могу в activeX влезть, слишком много там всяких команд

[wetr]

Сообщение от puma например, есть динамический блок разреза, после увеличения он сбивается

актуальная проблема

[Лиспер]

Лично мне лениво пытаться создать блок, его масштабировать, чего-то там еще делать. Может, puma, будет проще приложить 2 файла - один "что получается", второй - "что должно получиться"?

[puma]

мой косяк, что сразу не выложил.

[Лиспер]

По идее должно было сработать, но не срабатывает до конца: атрибуты "пляшут".

Код:

[Выделить все]

(vl-load-com)

(defun c:scale-dyn-blocks (/ conv-vla-to-list doc selset scale pt lst)

  (defun conv-vla-to-list (value / res)
    (cond
      ((listp value)
       (mapcar 'conv-vla-to-list value)
       )
      ((= (type value) 'variant)
       (conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun


  (vla-startundomark
    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function
                                (lambda ()
                                  (ssget "_:L" '((0 . "INSERT")))
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (= (type (setq pt
                      (vl-catch-all-apply
                        (function
                          (lambda () (getpoint "\nБазовая точка <Отмена> : "))
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
      (= (type
           (setq
             scale (vl-catch-all-apply
                     (function
                       (lambda () (getdist pt "\nМасштаб <Отмена> : "))
                       ) ;_ end of function
                     ) ;_ end of vl-catch-all-apply
             ) ;_ end of setq
           ) ;_ end of type
         'real
         ) ;_ end of =
      ) ;_ end of and
     (progn
       (foreach ent
                (mapcar
                  (function vlax-ename->vla-object)
                  ((lambda (/ tab item)
                     (repeat (setq tab  nil
                                   item (sslength selset)
                                   ) ;_ end setq
                       (setq
                         tab (cons (ssname selset (setq item (1- item)))
                                   tab
                                   ) ;_ end of cons
                         ) ;_ end of setq
                       ) ;_ end of repeat
                     ) ;_ end of lambda
                   )
                  ) ;_ end of mapcar
         (setq
           lst (mapcar
                 (function
                   (lambda (x)
                     (cons (vla-get-propertyname x) (vla-get-value x))
                     ) ;_ end of LAMBDA
                   ) ;_ end of function
                 (conv-vla-to-list
                   (vla-getdynamicblockproperties ent)
                   ) ;_ end of conv-vla-to-list
                 ) ;_ end of mapcar
           ) ;_ end of setq
         (vla-scaleentity ent (vlax-3d-point pt) scale)
         (foreach prop (conv-vla-to-list
                         (vla-getdynamicblockproperties ent)
                         ) ;_ end of conv-vla-to-list
           (vl-catch-all-apply
             (function
               (lambda ()
                 (vla-put-value
                   prop
                   (cdr (assoc (vla-get-propertyname prop) lst))
                   ) ;_ end of vla-put-value
                 ) ;_ end of lambda
               ) ;_ end of function
             ) ;_ end of vl-catch-all-apply
           ) ;_ end of foreach
         ) ;_ end of foreach
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark doc)
  (princ)
  ) ;_ end of defun

[Frigate]

Подскажите, пожалуйста - может у кого была похожая проблема:

в блоке есть атрибут. После вставки программно меняю этому атрибуту выравнивание с "По ширине" на "по центру", и степень растяжения соответственно тоже меняю. И дома и на работе стоит русифицированный АКАД 2009. Если такой модифицированный блок копирую, то при вставке у аргумента выравнивание восстанавливается ("по ширине"), т.е. текст и местоположение атриблута сползают. В АКАДе дома такого не происходит. В чем может быть причина?

[Кулик Алексей aka kpblc]

Во-первых, меня пугает слово "русифицированный". Во-вторых, читалось ли http://autolisp.ru/2010/04/06/text-and-attrib-entities/ ? В-третьих, как выполняется копирование?

[superkot007]

Нужна помощь...
Есть чертеж, в котором куча блоков. Блоки выполнены в "неправильных" слоях (при вставке такого блока он не будет изменяться, даже если вставлен в другой слой с другим цветом). Это очень затрудняет проверку чертежа на регламентируемые слои... А если чертежей не один и не два, то вообще труба...

Так вот, как перевести выбранные на чертеже блоки в слой "0" со всеми настройками "по слою"???

[Кулик Алексей aka kpblc]

http://forum.dwg.ru/showthread.php?t=21492

[superkot007]

Сообщение от Кулик Алексей aka kpblc http://forum.dwg.ru/showthread.php?t=21492

Почти то, что нужно... А можно попросить "подправить" код, чтобы был выбор корректируемых блоков (лучше всего - мышкой)? Просто не все блоки в чертеже требуют такого радикального подхода...

Еще просьба... Есть lisp для вставки блоков

Код:

[Выделить все]

(defun block-insert (/ p p1 p4 p5 x1 x2 x3 y3 y4)
  ;ВСТАВКА БЛОКА ДЛИНОЙ 5мм
  (setq p2 (getpoint "\n \n \nВведите центр блока:"))
  (setq p1 (osnap p2 "_nea"))  
  (initget 1 "1 2")
  (setq w (getkword "\n \n \nНаправление отрезка 1 <ГОРИЗ>, 2 <ВЕРТ>:"))
  (if (= w "2")
   (progn
      (setq y3 (- (cadr p1) 2.5))
      (setq p4 (list (car p1) y3))
      (setq y4 (+ (cadr p1) 2.5))
      (setq p5 (list (car p1) y4))
      (command "_break" p4 p5)
      (command "_insert" b p1 "" "" "90")))
  (if (= w "1")
   (progn
      (setq x2 (+ (car p1) 2.5))
      (setq p4 (list x2 (cadr p1)))
      (setq x3 (- (car p1) 2.5))
      (setq p5 (list x3 (cadr p1)))
      (command "_break" p4 p5)
      (command "_insert" b p1 "" "" "")))
)

Как сделать его "проще" по алгоритму:
1. Выбор примитива (так понимаю - функция entsel?)
2. Если примитив является отрезком - точка выбора становится точкой вставки блока (по привязке). Если нет - сообщение о неправильном выборе
3. Если отрезок горизонтальный (координаты Y одинаковые) - вставка без поворота, если вертикальный (координаты X одинаковые) - поворот на 90 градусов.

[Кулик Алексей aka kpblc]

Код:

[Выделить все]

(vl-load-com)

(defun insert-block-by-point (block-name / adoc ent pt)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (tblobjname "block" block-name)
           (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (entsel "\nУкажите отрезок <Отмена> : ")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           (setq pt (vlax-curve-getclosestpointto (vlax-ename->vla-object (car ent)) (cadr ent)))
           (= (cdr (assoc 0 (entget (setq ent (car ent))))) "LINE")
           ) ;_ end of and
    (vla-insertblock (vla-objectidtoobject adoc (vla-get-ownerid (vlax-ename->vla-object ent)))
                     (vlax-3d-point pt)
                     block-name
                     1
                     1
                     1
                     (cond
                       ((equal (cadr (assoc 10 (entget ent)))
                               (cadr (assoc 11 (entget ent)))
                               1e-6
                               ) ;_ end of equal
                        (/ pi 2.)
                        )
                       ((equal (caddr (assoc 10 (entget ent)))
                               (caddr (assoc 11 (entget ent)))
                               1e-6
                               ) ;_ end of equal
                        0.
                        )
                       (t (angle (cdr (assoc 10 (entget ent))) (cdr (assoc 11 (entget ent)))))
                       ) ;_ end of cond
                     ) ;_ end of vla-InsertBlock
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[Frigate]

Кулик Алексей aka kpblc,

1. просто русский Автокад 2009.
2. да, Алексей, это я читал. Именно вычислением я и менял координты точки вставки.
3. КОпирование при помощи обычных Ctrl+C Ctrl+V. На домашнем компе при копировании блоков с измененным выравниванием атрибута все копируется как надо. Т.е. вырвнивание копированной вставки блока не становится изначальным для блока (по ширине). На рабочем компе выравнивание меняется на "по ширине". Но если копировать при помощи команды "кп", то все копируется нормально, без изменений.
Завтра еще раз поэкспериментирую на своем рабочем омпе и на других компах.

[Кулик Алексей aka kpblc]

Offtop: Frigate, ну ты хоть указывай примерную область поиска вопроса
Update на 2009 установлен? Если да, то на оба компа или как?

[Frigate]

Кулик Алексей aka kpblc,

кажется нет особого глюка. Такой глюк проявился только в одном файле, в других не проявляется - никаким путем не смог этого добиться в других файлах. Завтра скину сам файл, может ты, Алексей, и сможешь выяснить, что там не так.

[Кулик Алексей aka kpblc]

В таком случае я начинаю подозревать, что либо в блоке есть атрибуты с одинаковыми тэгами, либо определения блоков разнятся. Либо автоматом после вставки выполняется команда _.attsync (или ее аналог)

[superkot007]

Большая просьба - подправить lisp из архива:
- вместо слайдов - файлы dwg
- вставить в чертеж выбираемый элемент...

Да, и что-то я не понял, как его вообще запустить в AutoCAD...

[Кулик Алексей aka kpblc]

А чем не устраивает DesignCenter / _.insert / _.xref ?