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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как преобразовать точки в блоки?

Как преобразовать точки в блоки?

Ответ
Поиск в этой теме
Непрочитано 22.10.2012, 01:27 #1
Как преобразовать точки в блоки?
reddiska
 
Регистрация: 18.08.2012
Сообщений: 52

Подскажите, пожалуйста) Хорошо бы лисп какой-нибудь! Нужно преобразовать точки в блоки, но при этом чтобы координата z осталась исходной! А то я нашла один лисп, точки поменялись на блоки, но координаты высоты у всех новых блоков стали нулевыми(((
Просмотров: 14973
 
Непрочитано 22.10.2012, 09:42
#2
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,685


Цитата:
Сообщение от reddiska Посмотреть сообщение
Подскажите, пожалуйста) Хорошо бы лисп какой-нибудь! Нужно преобразовать точки в блоки, но при этом чтобы координата z осталась исходной! А то я нашла один лисп, точки поменялись на блоки, но координаты высоты у всех новых блоков стали нулевыми(((


Код:
[Выделить все]
;Программа меняет набор примитивов на выбранный примитив.
;Примеры применения:

;Замена одних блоков другими.
;Замена точек блоками или окружностями.
;Замена одних надписей другими.


;Сначала надо выбрать заменяемые объекты и нажать Enter, затем указать заменяющий объект. ;Вставка производится в центр ограничевающего (габаритного) прямоугольника старых объектов. ;Новые объекты вставляются в слои которые к которым пренадлежали старые объекты. ;Поддерживается предварительный выбор.

(defun c:frto(/ ACTDOC COPOBJ ERRCOUNT EXTLST
       EXTSET FROMCEN LAYCOL MAXPT CURLAY
       MINPT OBJLAY OKCOUNT OLAYST
       SCLAY TOCEN TOOBJ VLAOBJ *ERROR*)

  (vl-load-com)

  (defun *ERROR*(msg)
    (if olaySt
      (vla-put-Lock objLay olaySt)
      ); end if
    (vla-EndUndoMark actDoc)
    (princ)
    ); end of *ERROR*


  (defun GetBoundingCenter(vlaObj / blPt trPt cnPt)
  (vla-GetBoundingBox vlaObj 'minPt 'maxPt)
      (setq blPt(vlax-safearray->list minPt)
      trPt(vlax-safearray->list maxPt)
      cnPt(vlax-3D-point
      (list
            (+(car blPt)(/(-(car trPt)(car blPt))2))
            (+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2))
         0.0
            ); end list
     ); end vlax-3D-point
    ); end setq
  ); end of GetBoundingCenter

  (if(not(setq extSet(ssget "_I")))
    (progn
      (princ "\n+++ Выберите заменяемые объекты <- ")
      (setq extSet(ssget))
      ); end progn
    ); end if
  (if(not extSet)
    (princ "\nDistination objects isn't selected!")
    ); end if
  (if
    (and
    extSet
    (setq toObj(entsel "\n+++ Выберите заменяющий объект -> "))
    ); and and
    (progn
      (setq actDoc
       (vla-get-ActiveDocument
         (vlax-get-Acad-object))
      layCol
       (vla-get-Layers actDoc)
      extLst
       (mapcar 'vlax-ename->vla-object
                    (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex extSet))))
      vlaObj(vlax-ename->vla-object(car toObj))
      objLay(vla-Item layCol
          (vla-get-Layer vlaObj))
      olaySt(vla-get-Lock objLay)
      fromCen(GetBoundingCenter vlaObj)
      errCount 0
      okCount 0
      ); end setq
      (vla-StartUndoMark actDoc)
      (foreach obj extLst
  (setq toCen(GetBoundingCenter obj)
        scLay(vla-Item layCol
           (vla-get-Layer obj))
           );end setq
  (if(/= :vlax-true(vla-get-Lock scLay))
    (progn
    (setq curLay(vla-get-Layer obj))
    (vla-put-Lock objLay :vlax-false)
    (setq copObj(vla-copy vlaObj))
    (vla-Move copObj fromCen toCen)
    (vla-put-Layer copObj curLay)
    (vla-put-Lock objLay olaySt)
    (vla-Delete obj)
    (setq okCount(1+ okCount))
    ); end progn
    (setq errCount(1+ errCount))
    ); end if
  ); end foreach
      (princ
  (strcat "\n" (itoa okCount) " were changed. "
    (if(/= 0 errCount)
      (strcat (itoa errCount) " were on locked layer! ")
      ""
      ); end if
    ); end strcat
  ); end princ
      (vla-EndUndoMark actDoc)
      ); end progn
    (princ "\nSource object isn't selected! ")
    ); end if
  (princ)
  ); end of c:frto


Попросите кого нибудь из лиспописателей отредактировать код, по идее не должно быть это сложно..
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума  
 
Автор темы   Непрочитано 22.10.2012, 09:47
#3
reddiska


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


Лисп именно что этот.

Помогите кто-нибудь!!! Пожалуйста!!!
reddiska вне форума  
 
Непрочитано 22.10.2012, 09:58
#4
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Код:
[Выделить все]
 (vl-load-com)
(defun point-to-block (name)
  (if (tblsearch "block" name)
      ((lambda (doc ss)
         (vla-startundomark doc)
         ((lambda (model)
            (mapcar '(lambda (ent)
                       (vla-insertblock model (vlax-3d-point (cdr (assoc 10 (entget ent)))) name 1 1 1 0)
                       (entdel ent))
                    ss)
            (vla-endundomark doc))
          (vla-get-modelspace doc)))
       (vla-get-activedocument(vlax-get-acad-object))
       (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "POINT")))))))
      "Нет такого блока"))
(point-to-block name) где name имя блока.
p.s. исправил - при переносе скобка ушла
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 22.10.2012, 10:33
#5
5hev

roads
 
Регистрация: 22.12.2010
msk
Сообщений: 121
<phrase 1= Отправить сообщение для 5hev с помощью Skype™


Позвольте подправить
Код:
[Выделить все]
 (vl-load-com)
(defun points-to-block	( / sel counter blk en)
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (setq counter 0)
  (if (/= (setq sel (ssget '((0 . "point")))) nil)
    (while (ssname sel 0)
      (setq en	    (ssname sel 0)
	    counter (1+ counter)
            blk (vla-add (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
			 (vlax-3d-point '(0. 0. 0.))
			 (strcat "ptblock-" (itoa counter))))
      (vla-addpoint blk (vlax-3d-point '(0. 0. 0.)))
      (vla-insertblock
	(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
	(vlax-3d-point (cdr (assoc 10 (entget en))))
	(strcat "ptblock-" (itoa counter))
	1
	1
	1
	0)
      (ssdel en sel)
      (entdel en)))
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))))
5hev вне форума  
 
Непрочитано 22.10.2012, 10:54
#6
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Цитата:
Сообщение от 5hev ru
Позвольте подправить
Ну я могу допустить, что автору на самом деле надо разные блоки на каждую точку (здесь как и в большинстве случаев приходиться только угадывать), но Ваш "исправленный" лисп не запуститься корректно более 1-го раза.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 22.10.2012, 10:56
#7
5hev

roads
 
Регистрация: 22.12.2010
msk
Сообщений: 121
<phrase 1= Отправить сообщение для 5hev с помощью Skype™


Дима_, если автору нужно то, что я думаю, то раза вполне достаточно. Ну или откатываться будет. Минусы своего подхода я знаю, спасибо
Но, в общем-то, согласен, формулировать задачи нужно получше

Последний раз редактировалось 5hev, 22.10.2012 в 11:02.
5hev вне форума  
 
Непрочитано 22.10.2012, 11:02
#8
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Цитата:
Сообщение от 5hev ru Посмотреть сообщение
то раза вполне достаточно
один лиш раз ....
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Автор темы   Непрочитано 22.10.2012, 11:06
#9
reddiska


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


Автору надо один и тот же блок на все точки, но чтобы координата z у каждого из этих блоков была такой же, как и у каждой первоначальной точки. То есть куча одинаковых блоков с разной отметкой высоты.


Цитата:
Сообщение от 5hev[ru
;987266]Дима_, если автору нужно то, что я думаю, то раза вполне достаточно.
Возможно, что и достаточно, но я не понимаю, как этим пользоваться. Это же не лисп?
reddiska вне форума  
 
Непрочитано 22.10.2012, 11:09
#10
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Я Вас расстрою это именно ОН. Копировать из #4 (5hev[ru] - таки меня интуиция не подвела) с помошью всплывающей иконки в правом верхнем углу (текст в *.lsp файле должен сохраниться без строк).
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 22.10.2012, 11:10
#11
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Offtop:
Мне сразу вспомнилась обратная задача: получение 3D точек на основе имеющихся вхождений блоков, мало ли, может кому пригодится: тынц.
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
 
Непрочитано 22.10.2012, 11:21
#12
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Offtop: То hwd - осталось сюда аттрибут высоты добавить.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 22.10.2012, 18:24
#13
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Попробуй из старых запасов, не проверял:
Код:
[Выделить все]
(defun C:pz (/ acsp adoc atts block_coll block_def bref cnt osm pt tht)
  
(vl-load-com)
  (setq osm(getvar "osmode" ))
(or adoc
    (setq adoc (vla-get-activedocument
		 (vlax-get-acad-object))))
(or acsp
    (setq acsp (if (= (getvar "CVPORT") 1)
		 (vla-get-paperspace
		   adoc)
		 (vla-get-modelspace
		   adoc)
		 )
	  )
    )

  
(setq block_coll (vla-get-blocks adoc))

(vla-startundomark  adoc)
(if (not (tblsearch "block" "pt_z"));<-- имя блока
 (progn
 (setvar "clayer" "0")
 (setq tht  (getreal (strcat "\nВысота текста атрибута <" (rtos (getvar "textsize"))">: ")))
 (cond ((not tht)(setq tht  (getvar "textsize"))))
(setq block_def (vla-add block_coll (vlax-3D-Point '(0 0 0)) "pt_z"))
(vla-put-color  (vla-Addattribute block_def  2.5 4 "Z-coordinate" (vlax-3d-point(list (/ tht 2.) (/ tht 2.) 0.0)) "Z" "0.000")0)
(vlax-release-object block_def))
  )
  (setvar "osmode" 8)
  (setq cnt 0)
 (while (setq pt (getpoint "\n Pick Point >>"))
   (setq cnt (1+ cnt))
(setq bref (vlax-invoke acsp 'Insertblock pt "pt_z" 1 1 1 0) )
   (setq atts (vlax-invoke bref 'getattributes))
   (foreach at	atts
     (cond
       ((eq "Z" (vla-get-tagstring at))
	(vla-put-textstring at (rtos (caddr pt) 2 3))) ;<-- точность 3 знака после запятой
       )
     )


   )
 (setvar "osmode" osm) 
(vla-endundomark adoc)  
(princ)
)
Олег (jr.) вне форума  
 
Непрочитано 22.10.2012, 18:26
1 | #14
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Offtop:
Цитата:
не проверял
Меня всегда настораживает код, имеющий такую пометку
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
 
Автор темы   Непрочитано 22.10.2012, 20:46
#15
reddiska


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


Цитата:
Сообщение от Олег (jr.) Посмотреть сообщение
Попробуй из старых запасов, не проверял:
Код:
[Выделить все]
(defun C:pz (/ acsp adoc atts block_coll block_def bref cnt osm pt tht)
  

)

Немножко не то. Оно делает атрибуты с отметкой высоты. В обчем спасибо, но не то.

А vl-load-com почему-то у меня не работает. Это просто обычный лисп, его как лисп сохранять, и имя команды должно быть points-to-block?

Последний раз редактировалось reddiska, 22.10.2012 в 20:53.
reddiska вне форума  
 
Непрочитано 22.10.2012, 21:43
1 | #16
5hev

roads
 
Регистрация: 22.12.2010
msk
Сообщений: 121
<phrase 1= Отправить сообщение для 5hev с помощью Skype™


Обычный лисп, сохранять как lsp файл, имя команды такое как Вы указали. Вот доработанная версия
Код:
[Выделить все]
 (vl-load-com)
(defun c:points-to-block	( / sel blname en)
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  ;(setq counter 0)
  (setq blname (vla-get-effectivename (vlax-ename->vla-object (car(entsel "\nВыбор блока-образца")))))
  (if (/= (setq sel (ssget '((0 . "point")))) nil)
    (while (ssname sel 0)
      (setq en	    (ssname sel 0)
	    ;counter (1+ counter)
               ;blk (vla-add (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point '(0. 0. 0.)) (strcat "ptblock-" (itoa counter)))
      )
      ;(vla-addpoint blk (vlax-3d-point '(0. 0. 0.)))
      (vla-insertblock
	(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
	(vlax-3d-point (cdr (assoc 10 (entget en))))
	;(strcat "ptblock-" (itoa counter))
           blname
	1
	1
	1
	0)
      (ssdel en sel)
      ;(entdel en)
))
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))))
5hev вне форума  
 
Автор темы   Непрочитано 22.10.2012, 21:50
#17
reddiska


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


Цитата:
Сообщение от 5hev[ru] Посмотреть сообщение
Обычный лисп, сохранять как lsp файл, имя команды такое как Вы указали. Вот доработанная версия
Код:



спасибо большое, то, что надо!
reddiska вне форума  
 
Непрочитано 25.10.2012, 12:32
#18
VVA

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


Цитата:
Сообщение от reddiska Посмотреть сообщение
Лисп именно что этот.

Помогите кто-нибудь!!! Пожалуйста!!!
Для исторической справедливости. Предложенная в #2 - это одна из первых версий FRTO. Потом ее доделали
Caduser (с поста #10)
Cadtutor
Код:
[Выделить все]
;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=44&TID=21135&MID=118777#message118777
;;; http://www.cadtutor.net/forum/showthread.php?p=340865#post340865
;;;Программа меняет набор примитивов на выбранный примитив.
;;;Примеры применения:
;;;Замена одних блоков другими.
;;;Замена точек блоками или окружностями.
;;;Замена одних надписей другими.
;;;
;;;Сначала надо выбрать образец, затем указать заменяемые объекты. Вставка производится в центр ограничевающего
;;;(габаритного) прямоугольника старых объектов. Новые объекты вставляются в слои которые к которым пренадлежали старые объекты.
;;;Поддерживается предварительный выбор.

;;; Command changes the set of primitives for the selected primitive. 
;;; Examples: 
;;; Replacement of some other blocks. 
;;; Replacement blocks or dots circles. 
;;; Replacement of some other titles. 
;;; 
;;; First you need to select a sample, and then specify replaceable objects. Box is in the center is restricted (bounding) rectangle of old objects. New objects are inserted into the layers that Belonged to which the old objects. 
;;; Supports pre-selection.
(defun c:frto(/ ACTDOC COPOBJ ERRCOUNT EXTLST
       EXTSET FROMCEN LAYCOL MAXPT CURLAY
       MINPT OBJLAY OKCOUNT OLAYST
       SCLAY TOCEN TOOBJ VLAOBJ *ERROR* ASK)
  (vl-load-com)
  (defun *ERROR*(msg)
    (if olaySt (vla-put-Lock objLay olaySt)); end if
    (vla-EndUndoMark actDoc)(princ)); end of *ERROR*

  (defun GetBoundingCenter(vlaObj / blPt trPt cnPt)
  (vla-GetBoundingBox vlaObj 'minPt 'maxPt)
      (setq blPt(vlax-safearray->list minPt)
      trPt(vlax-safearray->list maxPt)
      cnPt(vlax-3D-point
      (list
            (+(car blPt)(/(-(car trPt)(car blPt))2))
            (+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2))
            (+(caddr blPt)(/(-(caddr trPt)(caddr blPt))2)) ;_<<< Заменили
            )))); end of GetBoundingCenter
  (setq extSet(ssget "_I"))
 (while (not (setq toObj(entsel "\n+++ Select source object -> ")))
   (princ "\nSource objects isn't selected!"))
  (if(not extSet)
    (progn
      (princ "\n+++ Select destination objects and press Enter <- ")
      (setq extSet(ssget "_:L")))); end if
  (if(not extSet)(princ "\nDestination objects isn't selected!")); end if
  (if (and extSet toObj)
    (progn
      (initget "Yes No")
      (setq ask (getkword "\nRemove destination object [Yes/No] <No>:"))
      (setq actDoc (vla-get-ActiveDocument(vlax-get-Acad-object))
      layCol (vla-get-Layers actDoc)
      extLst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex extSet))))
      vlaObj (vlax-ename->vla-object(car toObj))
      objLay (vla-Item layCol (vla-get-Layer (vlax-ename->vla-object(car toObj))))
      olaySt (vla-get-Lock objLay)
     fromCen (GetBoundingCenter vlaObj)
      errCount 0  okCount 0); end setq
      (vla-StartUndoMark actDoc)
      (foreach obj extLst
        (setq toCen (GetBoundingCenter obj)
              scLay (vla-Item layCol (vla-get-Layer obj)));end setq
  (if(/= :vlax-true(vla-get-Lock scLay))
    (progn
    (setq curLay(vla-get-Layer obj))
    (vla-put-Lock objLay :vlax-false)
    (setq copObj(vla-copy vlaObj))
    (vla-Move copObj fromCen toCen)
    (_kpblc-ent-properties-copy obj copObj)
    (vla-put-Layer copObj curLay)
    (vla-put-Lock objLay olaySt)
    (if (= ask "Yes")(vla-Delete obj))
    (setq okCount(1+ okCount))
    ); end progn
    (setq errCount(1+ errCount))
    ); end if
  ); end foreach
      (princ (strcat "\n" (itoa okCount) " were changed. "
    (if(/= 0 errCount)(strcat (itoa errCount) " were on locked layer! ")  "")))
      (vla-EndUndoMark actDoc)); end progn
    (princ "\nSource object isn't selected! ")
    ); end if
  (princ)); end of c:frto
;|=============================================================================
*    Функция копирования настроек примитивов
*    Параметры вызова:
*   source   примитив-источник (vla)
*   dest   примитив-получатель (vla)
*    Выполняется копирование всех настроек (кроме точек, координат и т.п.), если
* это возможно. Копирование радиусов дуг и окружностей не выполняется.
*    Контроль и преобразование параметров не выполняется.
*    Примеры вызова:
(_kpblc-ent-properties-copy (vlax-ename->vla-object (car (entsel))) (vlax-ename->vla-object (car (entsel))))
*    URL http://www.arcada.com.ua/forum/viewtopic.php?t=504&start=15
=============================================================================|;
(defun _kpblc-ent-properties-copy (source dest)
 (foreach prop   '("Angle" "Layer" "Linetype" "LinetypeScale" "Lineweight"
        "Normal" "PlotStyleName" "Thickness" "Color" "Visible"
        "Closed" ;|"ConstantWidth" ; не копируется|; "Elevation" "LinetypeGeneration"
        "LinetypeScale" ;|"StartAngle" "EndAngle" ; не копируются|; "Alignment"
        "Backward" "Height" "ObliqueAngle" "Rotation" "ScaleFactor" "StyleName"
        "TextGenerationFlag"  "TextHeight"  "UpsideDown"  "AttachmentPoint" "BackgroundFill"
        "DrawingDirection"  "LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle"  "Width"
        "XScaleFactor" "YScaleFactor" "ZScaleFactor" ;| Viewport|; "ArcSmoothness" "CustomScale"
        "Direction" "DisplayLocked"  "GridOn" "LensLength" "ModelView" "ShadePlot" "SheetView"
        "SnapBasePoint" "SnapOn" "SnapRotationAngle" "StandardScale" "Target"  "TwistAngle"
        "UCSIconAtOrigin"   "UCSIconOn"     "UCSPerViewport" "ViewportOn")
 (if (and (vlax-property-available-p source prop)(vlax-property-available-p dest prop t))
  (_kpblc-error-catch
    '(lambda ()(vlax-put-property dest prop (vlax-get-property source prop))) nil)))) ;_ end of defun
;|=============================================================================
*    Оболочка отлова ошибок.
*    Параметры вызова:
*   protected-function   — "защищаемая" функция
*   on-error-function   — функция, выполняемая в случае ошибки
*    URL http://www.arcada.com.ua/forum/viewtopic.php?t=504&start=15
=============================================================================|;
(defun _kpblc-error-catch
       (protected-function on-error-function / catch_error_result)
  (setq catch_error_result (vl-catch-all-apply protected-function))
  (if (and (vl-catch-all-error-p catch_error_result) on-error-function)
    (apply on-error-function
      (list (vl-catch-all-error-message catch_error_result)))
    catch_error_result)) ;_ end of defun
(princ "\nType FRTO in command line")
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.02.2016, 22:18
#19
config


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


Доброго времени суток, уважаемые форумчане. Возник вопрос в процессе использования лиспа Frto. Передо мной стоит задача - создать в местах вставки блоков копии точек с высотой. После запуска программы точки вставляются мимо вставки и вообще, не понятно где. Подскажите, отчего это происходит? Понимаю, что не в программе дело, а скорее в блоке, но где? Спасибо.
Миниатюры
Нажмите на изображение для увеличения
Название: 001.png
Просмотров: 166
Размер:	7.0 Кб
ID:	166153  Нажмите на изображение для увеличения
Название: 002.png
Просмотров: 139
Размер:	5.5 Кб
ID:	166154  Нажмите на изображение для увеличения
Название: 003.png
Просмотров: 110
Размер:	3.7 Кб
ID:	166156  
Вложения
Тип файла: dwg
DWG 2007
Пример.dwg (489.4 Кб, 24 просмотров)
config вне форума  
 
Непрочитано 28.02.2016, 00:05
#20
VVA

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


Цитата:
Сообщение от config Посмотреть сообщение
Подскажите, отчего это происходит?
Фрагмент из пояснений к команде
Цитата:
;;; ... Вставка производится в центр ограничевающего
;;;(габаритного) прямоугольника старых объектов. Новые объекты вставляются в слои которые к которым пренадлежали старые объекты.
;;;Поддерживается предварительный выбор.
Атрибуты участвуют при определении габарита
Для твоего случая
Код:
[Выделить все]
(defun C:B2P (/ attname ss z)
;;;Block to Point
  (vl-load-com)
  (setq attname "OTMETKA") ;_Имя тага атрибута для отметки Z
  (setq SS (ssget "_:L" '((0 . "INSERT"))))
  (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
    (if (setq z (cdr (assoc attname (get-all-atts blk))))
      (point
        (reverse
          (cons
            (atof (vl-string-translate
                    ","
                    "."
                    (vl-string-trim "%UuoOcC \t" z)
                  ) ;_ end of vl-string-translate
            ) ;_ end of atof
            (cdr (reverse (cdr (assoc 10 (entget blk)))))
          ) ;_ end of cons
        ) ;_ end of reverse
      ) ;_ end of point
    ) ;_ end of if
  ) ;_ end of foreach
  (princ)
) ;_ end of defun
(defun get-all-atts (obj)
  (if (= (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of if
  (if (and obj
           (vlax-property-available-p obj 'Hasattributes)
           (eq :vlax-true (vla-get-hasattributes obj))
      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (mapcar (function (lambda (x)
                              (cons (vla-get-tagstring x)
                                    (vla-get-textstring x)
                              ) ;_ end of cons
                            ) ;_ end of lambda
                  ) ;_ end of function
                  (append (vlax-invoke obj 'Getattributes)
                          (vlax-invoke obj 'Getconstantattributes)
                  ) ;_ end of append
          ) ;_ end of mapcar
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun
(defun Point (pt)
  (entmakex (list (cons 0 "POINT") (cons 10 pt)))
) ;_ end of defun
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как преобразовать точки в блоки?

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как программно повернуть выбранные блоки к указанной точке? zamtmn Программирование 14 21.01.2020 15:52
Круги в точки Димас AutoCAD 11 26.06.2014 09:37
Как перенести блоки на смещенную траекторию? angel-fear AutoCAD 11 05.07.2011 16:09
Преобразование вершин TIN модели (треугольников) в точки с координатой Z WeMaN Разное 16 09.07.2009 13:49
Преобразование вершин горизонталей в точки WeMaN Программирование 4 05.03.2009 10:17