Все выбранное в блок. Напомните ЛИСП.

Neznayka · 19.10.2007, 10:54

Все выбранное в блок. Напомните ЛИСП.
Где-то видел ЛИСП, ума не приложу, как найти. Смысл лиспа таков:
Тыкаем по примитиву, и он сразу в блок, любой.
Очень хорошо, чтоб быстрый выбор работал. Для каждого объекта свой блок.
Спасибо.

Кулик Алексей aka kpblc · 19.10.2007, 11:04

http://dwg.ru/f/showthread.php?t=5661 ?

Neznayka · 19.10.2007, 11:51

СПАСИБО.
вечером посмотрю

Neznayka · 19.10.2007, 13:06

Ой не то, там много вопросов задает.
Мне бы так:
Выбираешь нужное, CTRL+X, затем CTRL+shift+v
и все.

Profan · 19.10.2007, 13:19

А зачем всякие Ctrl, лучше уж "Выбираешь нужное, нажимаешь ПКМ и все".

ASLYS · 19.10.2007, 13:30

комманда _group
а еще лучше лисп fastgroup, у kpblc был такой лисп

Neznayka · 19.10.2007, 13:52

ПКМ это" правая кнопка мыши" ?
если да, то не мне ПКМ не подойдёт
идеально для меня, чтоб для каждого объекта создался блок, если выбрать объёкты быстрым выбором. Центр блока в ц.м. объекта, имя любое

VVA · 19.10.2007, 13:58

Так что ли

Код:

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

;Selected Entities To Unnamed Block
;http://dwg.ru/f/showthread.php?t=14295
(defun C:SETUB ( / ss adoc csp unnamed_block tmp_blk lst)
(vl-load-com)
(and (setq ss (ssget "_:L"))
(setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(setq ss nil adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq csp (if (and (zerop (vla-get-activespace adoc))(= :vlax-false (vla-get-mspace adoc)))
             (vla-get-paperspace adoc)(vla-get-modelspace adoc)))      
(setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point '(0 0 0)) "*U"))
(vla-copyobjects adoc
              (vlax-make-variant (vlax-safearray-fill
                  (vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
                  lst)) unnamed_block)
(setq tmp_blk (vla-insertblock csp (vlax-3d-point '(0 0 0))(vla-get-name unnamed_block) 1.0 1.0 1.0 0.0))
(mapcar 'vla-erase lst)       
)
)

Neznayka · 19.10.2007, 14:04

ASLYS, мне нужен именно блок, я с группой не смогу сделать тоже что с блоком

Neznayka · 19.10.2007, 14:41

VVA, так то оно так, но зачем лисп точку вставки блока на 0,0 делает, мне бы центре масс или на гране примитива

Кулик Алексей aka kpblc · 19.10.2007, 14:47

А если так?

Код:

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

          ;Selected Entities To Unnamed Block
          ;http://dwg.ru/f/showthread.php?t=14295
(defun c:setub2 (/ ss adoc pt_lst center blk *error*)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if (not (vl-catch-all-error-p
             (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
    (progn
      (setq
        ss     (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                       ) ;_ end of mapcar
        pt_lst (apply 'append
                      (mapcar
                        '(lambda (x / minp maxp)
                           (vla-getboundingbox x 'minp 'maxp)
                           (list (vlax-safearray->list minp)
                                 (vlax-safearray->list maxp)
                                 ) ;_ end of append
                           ) ;_ end of lambda
                        ss
                        ) ;_ end of mapcar
                      ) ;_ end of append
        center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                       (list (apply 'min (mapcar 'car pt_lst))
                             (apply 'min (mapcar 'cadr pt_lst))
                             (apply 'min (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       (list (apply 'max (mapcar 'car pt_lst))
                             (apply 'max (mapcar 'cadr pt_lst))
                             (apply 'max (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       ) ;_ end of mapcar
        blk    (vla-add (vla-get-blocks adoc)
                        (vlax-3d-point center)
                        "*U"
                        ) ;_ end of vla-add
        ) ;_ end of setq
      (vla-copyobjects
        adoc
        (vlax-make-variant
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
            ss
            ) ;_ end of vlax-safearray-fill
          ) ;_ end of vlax-make-variant
        blk
        ) ;_ end of vla-copyobjects
      (vla-insertblock
        (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
        (vlax-3d-point center)
        (vla-get-name blk)
        1.0
        1.0
        1.0
        0.0
        ) ;_ end of vla-insertblock
      (mapcar 'vla-erase ss)
      ) ;_ end of and
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Neznayka · 19.10.2007, 15:07

Кулик Алексей aka kpblc,
УРА! Работает.
Спасибо

VVA · 01.07.2008, 17:04

Еще один вариант, делает из каждого выбранного элемента отдельный блок
SETUB3 -делает из каждого выбранного элемента отдельный анонимный блок
SETNB1 - делает из каждого выбранного элемента отдельный именованный блок
SETNB0 - делает из каждого выбранного элемента отдельный именованный блок с точкой вставки 0,0,0

Код:

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

(defun c:setub3 (/ ss adoc pt_lst center blk *error* lst)
;;;https://forum.dwg.ru/showpost.php?p=262006&postcount=13
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if (not (vl-catch-all-error-p
             (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
    (progn
      (mapcar '(lambda(item)
      (setq
	ss (list item)
        pt_lst (apply 'append
                      (mapcar
                        '(lambda (x / minp maxp)
                           (vla-getboundingbox x 'minp 'maxp)
                           (list (vlax-safearray->list minp)
                                 (vlax-safearray->list maxp)
                                 ) ;_ end of append
                           ) ;_ end of lambda
                        ss
                        ) ;_ end of mapcar
                      ) ;_ end of append
        center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                       (list (apply 'min (mapcar 'car pt_lst))
                             (apply 'min (mapcar 'cadr pt_lst))
                             (apply 'min (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       (list (apply 'max (mapcar 'car pt_lst))
                             (apply 'max (mapcar 'cadr pt_lst))
                             (apply 'max (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       ) ;_ end of mapcar
        blk    (vla-add (vla-get-blocks adoc)
                        (vlax-3d-point center)
                        "*U"
                        ) ;_ end of vla-add
        ) ;_ end of setq
      (vla-copyobjects
        adoc
        (vlax-make-variant
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
            ss
            ) ;_ end of vlax-safearray-fill
          ) ;_ end of vlax-make-variant
        blk
        ) ;_ end of vla-copyobjects
      (vla-insertblock
        (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
        (vlax-3d-point center)
        (vla-get-name blk)
        1.0
        1.0
        1.0
        0.0
        ) ;_ end of vla-insertblock
		 )
	  (setq
        lst     (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                       ) ;_ end of mapcar
	)
	      )
      
      (mapcar 'vla-erase lst)
      ) ;_ end of and
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  )
(defun c:SETNB1 (/ ss adoc pt_lst center blk *error* lst bpat bname bi)
  ;;;Each primitive in a separate named block
  ;;;Каждый примитив в отдельный Имсенованный блок
;;;https://forum.dwg.ru/showpost.php?p=262006&postcount=13
  ;;;http://www.cadtutor.net/forum/showthread.php?p=287449&posted=1#post287449
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (setq bpat "BLOCK-") ;_ <- Edit block name pattern here
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if (not (vl-catch-all-error-p
             (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
    (progn
      (mapcar '(lambda(item)
      (setq
	ss (list item)
        pt_lst (apply 'append
                      (mapcar
                        '(lambda (x / minp maxp)
                           (vla-getboundingbox x 'minp 'maxp)
                           (list (vlax-safearray->list minp)
                                 (vlax-safearray->list maxp)
                                 ) ;_ end of append
                           ) ;_ end of lambda
                        ss
                        ) ;_ end of mapcar
                      ) ;_ end of append
        center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                       (list (apply 'min (mapcar 'car pt_lst))
                             (apply 'min (mapcar 'cadr pt_lst))
                             (apply 'min (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       (list (apply 'max (mapcar 'car pt_lst))
                             (apply 'max (mapcar 'cadr pt_lst))
                             (apply 'max (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       ) ;_ end of mapcar
        bname
        (progn
          (setq bi 0)
          (while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
             bname)
        blk    (vla-add (vla-get-blocks adoc)
                        (vlax-3d-point center)
                        bname
                        ) ;_ end of vla-add
        ) ;_ end of setq
      (vla-copyobjects
        adoc
        (vlax-make-variant
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
            ss
            ) ;_ end of vlax-safearray-fill
          ) ;_ end of vlax-make-variant
        blk
        ) ;_ end of vla-copyobjects
      (vla-insertblock
        (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
        (vlax-3d-point center)
        (vla-get-name blk)
        1.0
        1.0
        1.0
        0.0
        ) ;_ end of vla-insertblock
		 )
	  (setq
        lst     (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                       ) ;_ end of mapcar
	)
	      )
      
      (mapcar 'vla-erase lst)
      ) ;_ end of and
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  )
(defun c:SETNB0 (/ ss adoc pt_lst center blk *error* lst bpat bname bi)
 ;;;Each primitive in a separate named block insert point 0,0,0
 ;;;Каждый примитив в отдельный Имсенованный блок c точкой вставки 0,0,0
 ;;; https://forum.dwg.ru/showpost.php?p=262006&postcount=13
 ;;;http://www.cadtutor.net/forum/showthread.php?p=287449&posted=1#post287449
 (defun *error* (msg)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (setq bpat "BLOCK-") ;_ <- Edit block name pattern here
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (if (not (vl-catch-all-error-p
            (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
   (progn
     (mapcar '(lambda(item)
     (setq
ss (list item)
       center (list 0.0 0.0 0.0) 
       bname
       (progn
         (setq bi 0)
         (while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
            bname)
       blk    (vla-add (vla-get-blocks adoc)
                       (vlax-3d-point center)
                       bname
                       ) ;_ end of vla-add
       ) ;_ end of setq
     (vla-copyobjects
       adoc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
           ss
           ) ;_ end of vlax-safearray-fill
         ) ;_ end of vlax-make-variant
       blk
       ) ;_ end of vla-copyobjects
     (vla-insertblock
       (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
       (vlax-3d-point center)
       (vla-get-name blk)
       1.0
       1.0
       1.0
       0.0
       ) ;_ end of vla-insertblock
	 )
  (setq
       lst     (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                      ) ;_ end of mapcar
)
      )
     
     (mapcar 'vla-erase lst)
     ) ;_ end progn
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 )

skkkk · 01.07.2008, 17:20

А нельзя, чтобы каждый объект становился отдельным блоком?(я о #11)
Добавлено: снимаю вопрос. Начал давно писать, и отвлекся....Потом закончил, отправил, смотрю, а VVA уже опередил мой вопрос

, он знал, что я его задам. Дай Бог Вам здоровья, Владимир

. Кстати сразу проверил, работает как часы

skkkk · 02.07.2008, 05:03

Новый вопрос по #11. Как сделать, чтобы блок создавался с заданным именем (piket)? А лучше при нажатии кнопки на панели инструментов создавался отрезок длиной 3,3мм в определенном слое, даже если он не текущий (_Пикеты) и загонялся в блок. Только неясно, что будет при повторном нажатии этой кнопки.....Но мне она нужна один раз на каждом новом чертеже.
Дело в том, что при расстановке пикетов (разметке полилинии блоком piket) макросом

Код:

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

^C^C_measure;\_b;piket;;200;_xplode;_p;;;;

в новом файле заново приходится создавать блок.

В самом идеале было бы .....при нажатии кнопки на панели создавался бы блок (отрезок 3,3мм) и им размечалась полилиния.

ОООчень пожалуйста

VVA · 16.01.2009, 13:50

Анонимные блоки нельзя редактировать bedit'ом. Выриант на основе Setub2 с присвоением имени. Имя получается как Шаблон + Счетчик

Код:

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

;;;Selected Entities To Named Block
(defun c:setnb (/ ss adoc pt_lst center blk *error* bi bname bpat)
;;;Selected Entities To Named Block
  (setq bpat "BLOCK-") ;_ <- Edit block name pattern here
                               ;_ <- Шаблон имени блока менять здесь
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if (not (vl-catch-all-error-p
             (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
    (progn
      (setq
        ss     (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                       ) ;_ end of mapcar
        pt_lst (apply 'append
                      (mapcar
                        '(lambda (x / minp maxp)
                           (vla-getboundingbox x 'minp 'maxp)
                           (list (vlax-safearray->list minp)
                                 (vlax-safearray->list maxp)
                                 ) ;_ end of append
                           ) ;_ end of lambda
                        ss
                        ) ;_ end of mapcar
                      ) ;_ end of append
        center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                       (list (apply 'min (mapcar 'car pt_lst))
                             (apply 'min (mapcar 'cadr pt_lst))
                             (apply 'min (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       (list (apply 'max (mapcar 'car pt_lst))
                             (apply 'max (mapcar 'cadr pt_lst))
                             (apply 'max (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       ) ;_ end of mapcar
        bname
        (progn
          (setq bi 0)
          (while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
             bname)
        blk    (vla-add (vla-get-blocks adoc)
                        (vlax-3d-point center)
                        bname
                        ) ;_ end of vla-add
        ) ;_ end of setq
      (vla-copyobjects
        adoc
        (vlax-make-variant
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
            ss
            ) ;_ end of vlax-safearray-fill
          ) ;_ end of vlax-make-variant
        blk
        ) ;_ end of vla-copyobjects
      (vla-insertblock
        (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
        (vlax-3d-point center)
        (vla-get-name blk)
        1.0
        1.0
        1.0
        0.0
        ) ;_ end of vla-insertblock
      (mapcar 'vla-erase ss)
      ) ;_ end of and
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

_nick_ · 01.10.2009, 12:31

Цитата:

Сообщение от VVA

Анонимные блоки нельзя редактировать bedit'ом. Выриант на основе Setub2 с присвоением имени. Имя получается как Шаблон + Счетчик

Спасибо огромное, очень помогло.
Но возник вопрос. Не мог бы ты изменить код,
чтобы вместо счетчика в названии блока, вписывало время и дату.
Это необходимо для избежания одинаковых названий блоков в других файлах.
Если мне нужно будет перенести блок из одного файла в другой!!!!!!

ытя · 01.10.2009, 13:43

Цитата:

Сообщение от _nick_

в названии блока, вписывало время и дату.

вместо

Код:

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

(setq bi 0)
(while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))

Код:

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

(while (tblsearch "BLOCK" (setq bname (strcat bpat (menucmd "M=$(edtime,$(getvar,date),DD\"-\"MO\"-\"YYYY\"_\"HH\":\"MM\":\"SS)")))))

и убрать переменную bi в начале - лишняя стала

VVA · 01.10.2009, 14:08

_nick_, Вариант с текущей датой и временем. Имя блока будет что-то типа "BLOCK-20091001_13062511"
>ытя Вопрос получения даты решил немного по другому:
(vl-string-translate "." "_" (setq bname (strcat bpat (rtos (getvar "CDATE") 2 9))))

Код:

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

(defun c:setnb (/ ss adoc pt_lst center blk *error* bname bpat)
;;;Selected Entities To Named Block
  (setq bpat "BLOCK-") ;_ <- Edit block name pattern here
                               ;_ <- Шаблон имени блока менять здесь
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if (not (vl-catch-all-error-p
             (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
    (progn
      (setq
        ss     (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                       ) ;_ end of mapcar
        pt_lst (apply 'append
                      (mapcar
                        '(lambda (x / minp maxp)
                           (vla-getboundingbox x 'minp 'maxp)
                           (list (vlax-safearray->list minp)
                                 (vlax-safearray->list maxp)
                                 ) ;_ end of append
                           ) ;_ end of lambda
                        ss
                        ) ;_ end of mapcar
                      ) ;_ end of append
        center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                       (list (apply 'min (mapcar 'car pt_lst))
                             (apply 'min (mapcar 'cadr pt_lst))
                             (apply 'min (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       (list (apply 'max (mapcar 'car pt_lst))
                             (apply 'max (mapcar 'cadr pt_lst))
                             (apply 'max (mapcar 'caddr pt_lst))
                             ) ;_ end of list
                       ) ;_ end of mapcar
        bname
        (progn
          (while (tblsearch "BLOCK" (vl-string-translate "." "_" (setq bname (strcat bpat (rtos (getvar "CDATE") 2 9))))))
             bname)
        blk    (vla-add (vla-get-blocks adoc)
                        (vlax-3d-point center)
                        bname
                        ) ;_ end of vla-add
        ) ;_ end of setq
      (vla-copyobjects
        adoc
        (vlax-make-variant
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
            ss
            ) ;_ end of vlax-safearray-fill
          ) ;_ end of vlax-make-variant
        blk
        ) ;_ end of vla-copyobjects
      (vla-insertblock
        (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
        (vlax-3d-point center)
        (vla-get-name blk)
        1.0
        1.0
        1.0
        0.0
        ) ;_ end of vla-insertblock
      (mapcar 'vla-erase ss)
      ) ;_ end of and
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  )

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Хитрый блок	Vova	Динамические блоки	166	20.03.2017 15:13
Как заменить один блок на другой? (не все)	Абдулнасир	Динамические блоки	2	21.05.2009 11:38
Как програмно запихнуть в блок все примитивы	Хотабыч	Программирование	4	06.05.2006 21:03
Разберемся со спецификацией раз и навсегда.	Pave1	AutoCAD	3	30.03.2006 13:12
проблема .....все на одном слое .....	Startrek	AutoCAD	20	20.10.2005 08:03

19.10.2007, 10:54		#1
Все выбранное в блок. Напомните ЛИСП. Neznayka Регистрация: 24.03.2005 Сообщений: 320 Все выбранное в блок. Напомните ЛИСП. Где-то видел ЛИСП, ума не приложу, как найти. Смысл лиспа таков: Тыкаем по примитиву, и он сразу в блок, любой. Очень хорошо, чтоб быстрый выбор работал. Для каждого объекта свой блок. Спасибо.
Просмотров: 7193