dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp. Расстановка блоков на пересечении линий.

Lisp. Расстановка блоков на пересечении линий.

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 22.05.2008, 02:49 #1
Lisp. Расстановка блоков на пересечении линий.
wetr
 
инженер
 
Владивосток
Регистрация: 09.08.2006
Сообщений: 1,553
Отправить сообщение для wetr с помощью ICQ Отправить сообщение для wetr с помощью Skype™

wetr вне форума Вставить имя

Доброго времени суток!
Задача появилась интересная. Необходимо расставить блоки на пересечении осей. Файл прилагается (2004). Такое ощущение, что уже где-то встречал подобный лисп, но поиском не нашел. Если было - ткните пожалуста. Если не было - буду благодарен за любую помощь.

Вложения
Тип файла: dwg
DWG 2004
dwg.dwg (39.0 Кб, 1950 просмотров)

__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
Просмотров: 6427
 
Непрочитано 22.05.2008, 17:46 Типа того
#2
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Цитата:
Сообщение от wetr Посмотреть сообщение
Доброго времени суток!
Задача появилась интересная. Необходимо расставить блоки на пересечении осей. Файл прилагается (2004). Такое ощущение, что уже где-то встречал подобный лисп, но поиском не нашел. Если было - ткните пожалуста. Если не было - буду благодарен за любую помощь.

Для симметричных блоков пригодится такой трюк:

В меню Modify->Objects->Block Description
выбрать из списка необходимый блок и в поле
описания через пробел записать ширину и высоту
блока например для блока "Кронштейн" у тебя
будет: 48.0 100.0
Чтобы не пролететь с размерами можно вставить
такой блок в масштабе 1:1 и замерить эти размеры
Вертикальные линии у тебя на самом деле являются
полилиниями - работать не будет
Либо взорви их, либо перерисуй на линии

Условия правильной работы программы:
-Пересекающиеся примитивы должны быть только линиями
-Расположение линий только ортогональное
-Блок должен быть симметричным относительно
точки его вставки

В цикле сначала указывается блок (не промахнись),
потом горизонтальная линия, потом вертикальная линия
и так повторяешь со следующим блоком и тд
Выход из цикла - Enter или правая клавиша мыши

Можешь изменить код для более общих случаев
самостоятельно (например добавить угол наклона осей и тд)
Я дальше пас...

Код:
[Выделить все]
(defun c:BBL  (/ adoc axss blk bname
	       dims ep ipt ln1 ln1-2
	       ln2 ln2-2 p1 p2 p3 p4
	       sp util xsize ysize xscale yscale
	       )
  (vl-load-com)
  (setq	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	       )
	)

  (setq util (vla-get-utility adoc))

  (while
    (not
    (vl-catch-all-error-p
    (vl-catch-all-apply '(lambda()
    (vla-getentity
      util
      'blk
      'pt
      "\nSelect block (press Enter to exit):")))))
    (setq bname (vla-get-name blk)
	  xscale (vlax-get blk 'XScaleFactor)
	  yscale (vlax-get blk 'YScaleFactor)
	  )
    (setq dims
		(read (strcat "("
			      (vla-get-comments
				(vla-item (vla-get-blocks adoc) bname))
			      ")"))
	  xsize	(/ (* (car dims) xscale) 2)
	  ysize	(/ (* (cadr dims) yscale) 2)
	  )

    (setq axss (vla-get-activeselectionset adoc))
    (vla-clear axss)
    (vla-selectOnScreen
      axss
      (vlax-safearray-fill
	(vlax-make-safearray vlax-vbinteger '(0 . 0))
	'(0))
      (vlax-safearray-fill
	(vlax-make-safearray vlax-vbvariant '(0 . 0))
	(list "LINE")))
    (if (/= 2 (vla-get-count axss))
        (princ "\nДолжны быть выбраны 2 линии!")
    (progn  
    (setq ln1 (vla-item axss 0)
	  ln2 (vla-item axss 1))
    (setq ipt (vlax-invoke ln1 'IntersectWith ln2 0))
    (setq p1 (polar ipt (/ pi 2) ysize)
	  p2 (polar ipt (* pi 1.5) ysize)
	  p3 (polar ipt 0 xsize)
	  p4 (polar ipt pi xsize)
	  )
    (if	(> (car (vlax-curve-getendpoint ln1))
	   (car (vlax-curve-getstartpoint ln1)))
      (setq sp (vlax-curve-getstartpoint ln1)
	    ep (vlax-curve-getendpoint ln1)
	    )
      (setq ep (vlax-curve-getstartpoint ln1)
	    sp (vlax-curve-getendpoint ln1)
	    )
      )
    (setq ln1-2 (vla-copy ln1))
    (setq ln2-2 (vla-copy ln2))
    (vlax-put ln1 'StartPoint sp)
    (vlax-put ln1 'EndPoint p4)
    (vlax-put ln1-2 'StartPoint ep)
    (vlax-put ln1-2 'EndPoint p3)
    (if	(> (cadr (vlax-curve-getendpoint ln2))
	   (cadr (vlax-curve-getstartpoint ln2)))
      (setq sp (vlax-curve-getstartpoint ln2)
	    ep (vlax-curve-getendpoint ln2)
	    )
      (setq ep (vlax-curve-getstartpoint ln2)
	    sp (vlax-curve-getendpoint ln2)
	    )
      )
    (vlax-put ln2 'StartPoint ep)
    (vlax-put ln2 'EndPoint p1)
    (vlax-put ln2-2 'StartPoint sp)
    (vlax-put ln2-2 'EndPoint p2)
    (vla-delete axss)
    )
      )
    )
    (mapcar '(lambda (x)(vl-catch-all-apply '(lambda()
				   (vlax-release-object x))))
	    (list blk ln1 ln2 ln1-1 ln2-2 axss util))
  (princ)
  )
;;;(C:bbl)

~'J'~
fixo вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 26.05.2008, 08:46
#3
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,553
Отправить сообщение для wetr с помощью ICQ Отправить сообщение для wetr с помощью Skype™


Что то ругается на меня. Вроде все условия выполил. Пробовал на АКАД 2006 и 2009.
Код:
[Выделить все]
Command: BBL

Select block (press Enter to exit):
Command: ; error: bad argument type: numberp: nil

Command:
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 28.05.2008, 02:42
#4
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,553
Отправить сообщение для wetr с помощью ICQ Отправить сообщение для wetr с помощью Skype™


to Fatty, теперь все получилось, но... получается что лисп не ускоряет работу, а замедляет.
Выходит, я должен выбрать блок, затем выбрать горизонтальную линию, затем вертикальную. А нельзя выбирать все линии горизонтальные, затем все вертикальные? Просто очень много работы связано с ручным расставлением данных блоков на пересечении линий. Кстати, линии в разных слоях.
P.S.У меня лисп вместо вставки блока разрезает линии под размер блока, но никакой вставки не происходит. Прикрепил картинку
Миниатюры
Нажмите на изображение для увеличения
Название: Drawing2.jpg
Просмотров: 214
Размер:	18.6 Кб
ID:	6868  
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.05.2008, 09:35
#5
Кулик Алексей aka kpblc
Moderator

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


Вариант нумер два:
Код:
[Выделить все]
(defun c:bbl2 (/                  adoc               *error*
               fun_ssget          fun_conv-vla-to-list
               _kpblc-conv-list-to-3dpoints          selset
               blk                intersect          ins
               )

  (defun _kpblc-conv-list-to-3dpoints (lst / res)
                                      ;|
*    Функция конвертации списка чисел в список 3-мерных точек.
*    Параметры вызова:
*	lst	список чисел
*    Примеры вызова:
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5 6)) ;-> ((1 2 3) (4 5 6))
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5))   ;-> ((1 2 3) (4 5 0.))
|;
    (cond
      ((not lst)
       nil
       )
      (t
       (setq res (cons (list (car lst)
                             (if (cadr lst)
                               (cadr lst)
                               0.
                               ) ;_ end of if
                             (if (caddr lst)
                               (caddr lst)
                               0.
                               ) ;_ end of if
                             ) ;_ end of list
                       (_kpblc-conv-list-to-3dpoints (cdddr lst))
                       ) ;_ end of cons
             ) ;_ end of setq
       )
      ) ;_ end of cond
    res
    ) ;_ end of defun

  (defun fun_conv-vla-to-list (value / res)
    (cond
      ((= (type value) 'variant)
       (fun_conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (> (vlax-safearray-get-u-bound value 1) 0)
         (vlax-safearray->list value)
         ) ;_ end of if
       )
      ((vlax-property-available-p value 'count)
       (vlax-for item value
         (setq res (cons item res))
         ) ;_ end of vlax-for
       )
      ) ;_ end of cond
    ) ;_ end of defun

  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun fun_ssget (filter msg / res _cmdecho)
    (setq _cmdecho (getvar "cmdecho"))
    (if (= (type (setq res (vl-catch-all-apply
                             '(lambda ()
                                (prompt msg)
                                (cond
                                  (filter (ssget filter))
                                  (t (ssget))
                                  ) ;_ end of cond
                                ) ;_ end of lambda
                             ) ;_ end of vl-catch-all-apply
                       ) ;_ end of setq
                 ) ;_ end of type
           'pickset
           ) ;_ end of =
      (setq res ((lambda (/ item lst)
                   (repeat (setq item (sslength res)) ;_ end setq
                     (setq lst (cons (ssname res (setq item (1- item))) lst))
                     ) ;_ end repeat
                   lst
                   ) ;_ end of lambda
                 )
            ) ;_ end of setq
      ) ;_ end of if
    (setvar "cmdecho" _cmdecho)
    res
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if
    (and
      (setq
        selset (fun_ssget nil
                          "\nВыберите объекты с самопересечениями <Отмена> : "
                          ) ;_ end of fun_ssget
        ) ;_ end of setq
      (= (type (setq
                 blk (vl-catch-all-apply
                       '(lambda ()
                          (car (entsel "\nУкажите блок для вставки <Отмена> : "))
                          ) ;_ end of lambda
                       ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
               ) ;_ end of type
         'ename
         ) ;_ end of =
      ) ;_ end of and
     (progn
       (setq blk (if (vlax-property-available-p
                       (setq blk (vlax-ename->vla-object blk))
                       'effectivename
                       ) ;_ end of vlax-property-available-p
                   (vla-get-effectivename blk)
                   (vla-get-name blk)
                   ) ;_ end of if
             ) ;_ end of setq
       (foreach ent (setq selset (mapcar 'vlax-ename->vla-object selset))
         (foreach sub (cdr (member ent selset))
           (if (setq ins (_kpblc-conv-list-to-3dpoints
                           (fun_conv-vla-to-list
                             (vla-intersectwith ent sub acextendnone)
                             ) ;_ end of fun_conv-vla-to-list
                           ) ;_ end of _kpblc-conv-list-to-3dpoints
                     ) ;_ end of setq
             (mapcar
               '(lambda (x)
                  (vla-insertblock
                    (vla-objectidtoobject adoc (vla-get-ownerid ent))
                    (vlax-3d-point x)
                    blk
                    1.
                    1.
                    1.
                    0.
                    ) ;_ end of vla-InsertBlock
                  ) ;_ end of lambda
               ins
               ) ;_ end of mapcar
             ) ;_ end of if
           ) ;_ end of foreach
         ) ;_ end of foreach
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.05.2008, 10:03
#6
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,129


Чой-то мне кажется, что я такое уже писал, но за давностью лет не помню. Для простоты не проверяю слой вставляемого блока.
Код:
[Выделить все]
;;IntrBlk.lsp ©2008 Alexey Sheinkman
;;Insert Existing Blocks at intersection points
;;
;
(defun *error* (msg)
  (if (= msg "Function cancelled") (princ msg)(princ));if
  (setvar "OSMODE" snm) (setvar "CMDECHO" cmd) (vla-update ln0) (setq c nil)  
);*error*
;
(defun selss (dir ss)
  (prompt (strcat "\nSelect " dir "Line(s): "))
  (vla-SelectOnScreen ss)
  (princ (strcat "\n" (itoa (vla-get-count ss)) " " dir " Lines Selected"))
);defun
;
(defun C:IntrBlk ( / cmd snm adoc util sss ass oss blk kw)
  (setq cmd (getvar "CMDECHO")
	snm (getvar "OSMODE")
	adoc (vla-get-activedocument (vlax-get-acad-object)));setq
  (mapcar '(lambda (x y) (set x (vlax-get-property adoc y))) '(util sss ass)
    '(Utility SelectionSets ActiveSelectionSet))
  (setq oss (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list sss "OSS")))
              (vla-add sss "OSS") (vla-item sss "OSS")))
  (mapcar '(lambda (x) (if (/= (vla-get-count x) 0) (vla-clear x))) (list oss ass))
  (setvar "CMDECHO" 0)
  (vla-endundomark adoc)
  (vla-startundomark adoc)
  (selss "Horizontal" oss)  
  (setq csp (vla-ObjectIDtoObject adoc (vla-get-ownerID (vla-item oss 0))))
  (terpri)
  (selss "Vertical" ass)
  (vla-getentity utl 'blk nil "\nSelect Sample Block: ")
  (vlax-for ln oss
     (vlax-for ln1 ass
       (vla-insertBlock csp (vla-IntersectWith ln ln1 acExtendNone) (vla-get-name blk) 
            (vla-get-XScaleFactor blk) (vla-get-YScaleFactor blk) (vla-get-ZScaleFactor blk) (vla-get-rotation blk))));vlax-for
  (setvar "OSMODE" snm) (setvar "CMDECHO" cmd)
  (vla-InitializeUserInput util 128 "Yes No")
  (setq kw (vla-getKeyWord util "Delete Sample Block [Yes/No]: ? <Yes>")) 
  (if (= kw "") (setq kw "Yes")) 
  (if (= kw "Yes") (vla-delete blk))
  (mapcar 'vlax-release-object (list oss ass))
  (vla-endundomark adoc)  
  (princ)
);end
Порядок работы:
1. Убедиться, что блок присутствует в чертеже. Если нет - вставить куда-нибудь.
2. Запустить программу.
3. Выбрать линии (можно по одной, можно секрамкой), как указано.
4. Выбрать блок-образец.
5. Стереть блок-образец, если нужно.
6. Поблагодарить меня, любимого, за то, что я есть.

Да, извини, что по бусурмански. Это все от лени.

Последний раз редактировалось Лентяй, 28.05.2008 в 10:16.
Лентяй вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 28.05.2008, 11:01
#7
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,553
Отправить сообщение для wetr с помощью ICQ Отправить сообщение для wetr с помощью Skype™


C-П-А-С-И-Б-О!!!!!!!!!!!!!!!!!!!!!
Кулик Алексей aka kpblc, ты БОХ!
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 13.10.2008, 07:18
#8
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,553
Отправить сообщение для wetr с помощью ICQ Отправить сообщение для wetr с помощью Skype™


Кулик Алексей aka kpblc, подскажи как заставить лисп вставлять блоки на определенный слой? Можно даже без создания слоя...
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 13.10.2008, 16:54
#9
Кулик Алексей aka kpblc
Moderator

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


Найди строки
Код:
[Выделить все]
(mapcar
               '(lambda (x)
                  (vla-insertblock
                    (vla-objectidtoobject adoc (vla-get-ownerid ent))
                    (vlax-3d-point x)
                    blk
                    1.
                    1.
                    1.
                    0.
                    ) ;_ end of vla-InsertBlock
                  ) ;_ end of lambda
               ins
               )
И замени их на
Код:
[Выделить все]
(mapcar
  '(lambda (x /)
     (vla-put-layer
       (vla-insertblock
         (vla-objectidtoobject adoc (vla-get-ownerid ent))
         (vlax-3d-point x)
         blk
         1.
         1.
         1.
         0.
         ) ;_ end of vla-InsertBlock
       LayerName
       ) ;_ end of vla-put-layer
     ) ;_ end of lambda
  ins
  ) ;_ end of mapcar
В качестве LayerName подставляй имя слоя. Слой уже должен существовать в файле.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 14.10.2008, 02:16
#10
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,553
Отправить сообщение для wetr с помощью ICQ Отправить сообщение для wetr с помощью Skype™


Что-то еррор какой-то
Код:
[Выделить все]
Select objects:

Укажите блок для вставки <Отмена> : ActiveX Server returned an error: Параметр 
является обязательным
Вставляется блок как и раньше в текущем слое
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)

Последний раз редактировалось wetr, 14.10.2008 в 02:22.
wetr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 14.10.2008, 08:20
#11
Кулик Алексей aka kpblc
Moderator

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


Только что специально прогнал на ACAD2006Eng. Все работает.
В файле создан слой 1234 и код (имею в виду измененный участок) принимает вид
Код:
[Выделить все]
(mapcar
	       '(lambda	(x)
		  (vla-put-layer
		    (vla-insertblock
		      (vla-objectidtoobject adoc (vla-get-ownerid ent))
		      (vlax-3d-point x)
		      blk
		      1.
		      1.
		      1.
		      0.
		      ) ;_ end of vla-InsertBlock
		    "1234"
		    ) ;_ end of vla-put-layer
		  ) ;_ end of lambda
	       ins
	       ) ;_ end of mapcar
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 14.10.2008, 08:45
#12
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,553
Отправить сообщение для wetr с помощью ICQ Отправить сообщение для wetr с помощью Skype™


блиннн. Я себе автокад сломал..
*Добавлено.
Семь бед - один резет! Перезагрузка помогла - все заработало.

СПАСИБО, Алексей!!!
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)

Последний раз редактировалось wetr, 09.04.2009 в 07:37. Причина: орфография
wetr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 14.10.2008, 08:52
#13
Кулик Алексей aka kpblc
Moderator

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


:?:
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 14.10.2008, 09:21
#14
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,553
Отправить сообщение для wetr с помощью ICQ Отправить сообщение для wetr с помощью Skype™


bbl2 + _overkill + _scalc_vc =
Будете у нас на Колыме - милости просим!
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 14.10.2008, 09:36
#15
Кулик Алексей aka kpblc
Moderator

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


Последнюю команду не понял.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 14.10.2008, 09:44
#16
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,553
Отправить сообщение для wetr с помощью ICQ Отправить сообщение для wetr с помощью Skype™


калькулятор веткадовский. Считает все!
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 24.12.2014, 20:14
#17
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,767
Отправить сообщение для Alan с помощью ICQ


>kpblc & all
Если будет время, глянь пжл
есть,
список точек - sp_po
блок с именем - mrkb (прямоугольник из полилиний, без атрибутов )
Код:
[Выделить все]
 ;;;  -----------------  вставка блоков ------------------------
      (setq j 0)

      (while (setq po (nth j sp_po))
	(command "_.INSERT" mrkb po 1 1 0) ;_ конец command
 ;_ конец command
	(setq j (1+ j))
      ) ;_ конец repeat
    ) ;_ конец progn
  ) ;_ конец if
Но уж больно долго вставляет блок в этом цикле командным методом
На списке из 2К точек - 18 мин.
Не владею ActiveX
Сами мы не местные....
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 24.12.2014, 20:27
#18
Кулик Алексей aka kpblc
Moderator

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


Ну невладение - это поправимо. А применять-то его можно?
P.S. Два варианта кода
Код:
[Выделить все]
 (foreach point sp_po
  (entmakex (list (cons 0 "INSERT")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbBlockReference")
                  (cons 2 mrkb)
                  (cons 10 point)
                  ) ;_ end of list
            ) ;_ end of entmakex
  ) ;_ end of foreach
Код:
[Выделить все]
 (vl-load-com)
(foreach point sp_po
  (vla-insertblock (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
                   (vlax-3d-point point)
                   mrkb
                   1.
                   1.
                   1.
                   0.
                   ) ;_ end of vla-InsertBlock
  ) ;_ end of foreach
----- добавлено через ~1 мин. -----
Заодно можно принудительно отключить регенерацию чертежа перед вставкой, а потом вернуть ее обратно
P.S. Еще момент: обычно добавление примитива через entmake / entmakex сразу требует изменения изображения на экране. ActiveX-методы регенерируют чертеж только после выполнения (это если я не ошибаюсь).
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.12.2014, 13:46
#19
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,767
Отправить сообщение для Alan с помощью ICQ


Спасибо огромное, Алексей, за быстрое и как всегда красивое решение.
Скорость впечатляет!!!
Время выполнения программы на том же тестовом примере порядка 2 (двух) секунд.
Пробовал оба варианта - работают, остановился на первом - он для меня более прост для понимания...
Была какая-то разница в регенерации, но трудно уловить. Будет еще тестовый пример, гляну.
__________________
По теории майский жук летать не может.
Но он этого не знает. И летает...
Alan вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.12.2014, 14:07
#20
Кулик Алексей aka kpblc
Moderator

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


Можно найти benchmark (где-то на форуме валялся) и погонять на имеющемся тесте. Хотя бы примерно оценить скорость уже будет можно
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp. Расстановка блоков на пересечении линий.

РЕВЕРС. Автоматическая пакетная печать множества рамок (форматов) из пространства модели и листов
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

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

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание нового типа линий Apelsinov AutoCAD 875 11.07.2018 09:41
LISP для подсчета суммы длин линий Kostinok LISP 18 26.04.2013 14:56
Нужен LISP для разрыва линий в точках пересечений ilka_t LISP 18 15.03.2013 16:35
Нужен Lisp для работы с типами линий Gostushev LISP 12 06.07.2005 14:50
Как изменять толщину линий и цвет линий для блоков? Highmax AutoCAD 1 08.03.2005 06:56

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||