Контур по блоку (Страница 1 из 2)

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Тема: Контур по блоку

Ребята помогите......нужен лисп для создания контура с блока....т.е. щёлкаю блок и получаю его контур!!
пожалуйста...пожалуйста...пожалуйста

scj

scj
Восстановленный участник

На форуме с 1 сентября 2006г.
Сообщений: 19
Спасибо: 0

Re: Контур по блоку

[rus]Risovat' bol'shuju okruzhnost' vokrug bloka.
Risovat' tochku mezhdu okruzhnost'ej i blokom.
Kommanda [/rus]_BPOLY[rus] s jetoj tochkoj sozdajot 2 granichnye kontury: okruzhnost' i ogranichnuju polyliniju bloka.
Mnogo uspexov!
[/rus]
Jochen
www.black-cad.de

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

> scj
ГОСПОДИ........Спасибо за подсказку попробую обработать и выложу на форум....а скажи эта команда Када или Экспресса....я на dwg.ru просил помощи так там ничем не помогли....я вот и думал что очень сложно
спасибо

Юрий

Юрий
Восстановленный участник

На форуме с 10 апреля 2006г.
Сообщений: 178
Спасибо: 0

Re: Контур по блоку

А на LISP'е, без использования _BPOLY (в смысле без использования рук: отдал программе (entsel), получил на выходе LWPOLYLINE вокруг блока)?

Fatty

Fatty
Восстановленный участник

На форуме с 30 мая 2006г.
Сообщений: 989
Спасибо: 0

Re: Контур по блоку

> Август
Я согласен с Йоганном (Jochen, please, pardon me about of translation your real name)
Но здесь возможна ловушка, если помимо блока
внутри окружности будут находится другие примитивы
~'J'~

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

> Юрий
что за программа такая????
я в русском 2004 каде работаю

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Контур по блоку

> Август
Там же ясно написано _BPOLY. Набери в командной строке. Она же КПОЛИ, она же _boundary, она же КОНТУР

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

> VVA
СПасибо за разъяснение....
а другие....програмные средства есть????
почему спецЫ молчат????? неужели это так сложно реализовать

kpblc

kpblc
Активный участник

Откуда: С.-Петербург
На форуме с 29 ноября 2004г.
Сообщений: 8,348
Спасибо: 23

Re: Контур по блоку

Наверное потому что таки да, сложно. Расписываю возможные проблемы и трудности:
1. блок может быть 3Д. Чего делать бум? Проецировать в план? На какую систему координат - вставки блока, текущую, мировую? То есть писать еще и "плющилку" на (возможно) нетекущую систему координат. Круто...
2. Блок может иметь систему координат, не равную текущей. Чего делать бум?
3. Блок может иметь неравные коэффициенты по разным осям. ActiveX-методами его будет не расколошматить, придется использовать (command "_.explode"), то есть сначала его копировать самого на себя, потом експлодить.
4. А если это не блок, а minsert-блок? Да еще и не первый элемент ты рассматриваешь? Тогда совсем весело.
5. А если это внешняя ссылка? Да еще и с разными масштабами?
6. Блок может быть сделан "не совсем обычным методом" - у него могут быть примитивы на слоях не "0", а сам блок вставлен на отключенный слой. Чего делаем со слоями?
Ну и так далее. Размытость задачи определяет количество встречных вопросов.

Эдуард Смолянка

Эдуард Смолянка
Восстановленный участник

На форуме с 23 апреля 2003г.
Сообщений: 795
Спасибо: 0

Re: Контур по блоку

> Август
Спецы молчат , потому , что реализовать это довольно сложно. Вариант Jochen имеет смысл только в том случае если элементы блока составляют замкнутые контура.

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

> kpblc
Многоуважаемый kpblc согласен со всеми поставленными вопросоми скажу по секрету некоторые термины так и не понял поробую кокретизировать задачу: имеется безымянный блок в уровне 0; состоит блок из 2Д объектов; сам блок может удаляться после создания контура;

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

> kpblc
kpblc глянь свою почту....там как раз тот самый блок для которого нужен контур.
----------------
С уважением к Вашему таланту

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Контур по блоку

> Август
Задача интересная и алгоритм в принципе ясен. Но пока руки не доходят, много работы.
А алгоритм я пока вижу такой.
1. Выбираем блок, находим его boundary
2. Задаем некоторый допуск
3. Убедлаемся, что все точки контура на экране
4. Скрываем все объекты внутри кроме блока
5. Чертим полилинию
6. Вызываем _boundary
7. Удаляем полилинию
Вот набросок команды без анализа блокировки слоев

;| ! *******************************************************************
;; !                  lib:IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  - Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
(setq pt (trans pt 0 1))
(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
   SSZ (getvar "SCREENSIZE")
   X_Pix (car SSZ) Y_Pix (cadr SSZ)
   X_Len (* (/ X_Pix Y_Pix) Y_Len)
   Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
   Uc (polar Lc 0.0 X_Len)
   Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
   Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))
(if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
     (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)))
    T nil))
(defun DTR (a)(* pi (/ a 180.0)))
(defun RTD (a)(/ (* a 180.0) pi))
; ! ***********************************************************
;; !                             lib:Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' - Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns  : t - было зуммирование nil - нет
;; ! **********************************************************
(defun lib:Zoom2Lst( vlist / bl tr Lst OS)
;(setq *MIP-ZOOM-PREV* nil)
(setq    Lst (lib:pt_extents vlist)
    bl (car Lst) tr (cadr Lst))
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
(progn  (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0)
    (command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1)
        "_.Zoom" "0.95x")
 ;       (setq *MIP-ZOOM-PREV* 2)
    (setvar "OSMODE" OS)
  T) NIL))
;| ! ***************************************************************************
;; !           lib:pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' - Список точек
;; ! Returns  : Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defun  lib:pt_extents (vlist / tmp)
(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))
 (mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))
 '(0 1 2))));_setq
  (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
;https://www.caduser.ru/forum/topic30797.html
;Block Contour
(defun C:BC ( / *error* blk obj MinPt MaxPt hiden pt)
(defun *error* ( msg )(mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden))
(if (and (setq blk (car(entsel "\nУкажите блок: ")))
     (= (cdr(assoc 0 (entget blk))) "INSERT")
     (setq obj (vlax-ename->vla-object blk)))
  (progn
    ;;Границы блока
  (vla-GetBoundingBox OBJ 'MinPt 'MaxPt)
  (setq MinPt (vlax-safearray->list MinPt)
        MaxPt (vlax-safearray->list MaxPt)
    MinPt (mapcar '- MinPt '(10 10))
    MaxPt (mapcar '+ MaxPt '(10 10))
    )
  (lib:Zoom2Lst (list MinPt MaxPt))
  (setq sset (ssget "_C" MinPt MaxPt))
  (if sset
    (progn
      (setq hiden (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
        hiden (vl-remove obj hiden))
      (mapcar '(lambda(x)(vla-put-Visible x :vlax-false)) hiden)
      (setq pt (mapcar '+ MinPt '(5 5)))
      (vl-cmdf "_.RECTANG" (trans MinPt 0 1)(trans MaxPt 0 1))
      (setq pl (vlax-ename->vla-object(entlast)))
      (if (VL-CATCH-ALL-ERROR-P
        (VL-CATCH-ALL-APPLY '(lambda ()
           (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
              (while (> (getvar "CMDACTIVE") 0)(command ""))
                   )))
        (princ "\nНе удалось построить контур"))
      (vla-Erase pl)
      (vl-cmdf "_.ERASE" MinPt "")
      (setq pl (vlax-ename->vla-object(entlast)))
      (vla-get-objectName pl)
      (mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden)
      (initget  "Yes No")
      (if (and (= (getkword "\nУдалять блок? [Yes/No] <No> : ") "Yes")
           (vlax-write-enabled-p obj))
    (vla-Erase obj))
      )
    )
    )
  )
  (princ)
  )

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Контур по блоку

> scj
Спасибо Jochen
за толчок в нужном направлении

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Контур по блоку

Там еще нужно в начале

(vl-load-com)

прописать

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

> VVA
Спасибо....а (vl-load-com)в самое самое начало вставить........
буду пробывать

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

> VVA
пожалуйста расскажи как её запускать...
я сделал 1.lsp загрузил в Кад....а как вызывать то её

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Контур по блоку

Набери в ком строке BC.

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

отлично....пока всё работает
спасибо...вот пока есть такие люди земля русская стоять будет

scj

scj
Восстановленный участник

На форуме с 1 сентября 2006г.
Сообщений: 19
Спасибо: 0

Re: Контур по блоку

[rus]nadejus' - i nemeckaja zemlja...;-)
ZY 1: Spasibo,[/rus] VVA!!
[rus]ZY 2: Po transliteracii menja zovut: Ioxen -
Privet tebe,[/rus] Fatty
Привет ешхё раз
Jochen

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

Guten Tag Jochen!
Mich rufen den August
Und die Erde deutsch бедет zu stehen smile )

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Контур по блоку

Выяснилось, что если блок имеет атрибуты, то не всегда коррекно определяется BoundingBox, Так же не всегда он определяется коррекно, если ПСК не мировая. Если блок вложить в другой, то BoundingBox определяется корректно. Вот вариант с использованием временного анoнимного блока

;https://www.caduser.ru/forum/topic30797.html
;| ! *******************************************************************
;; !                  lib:IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  — Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
(setq pt (trans pt 0 1))
(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
   SSZ (getvar "SCREENSIZE")
   X_Pix (car SSZ) Y_Pix (cadr SSZ)
   X_Len (* (/ X_Pix Y_Pix) Y_Len)
   Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
   Uc (polar Lc 0.0 X_Len)
   Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
   Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))
(if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
   (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)))
  T nil))
(defun DTR (a)(* pi (/ a 180.0)))
(defun RTD (a)(/ (* a 180.0) pi))
; ! ***********************************************************
;; !                             lib:Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' — Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns  : t — было зуммирование nil — нет
;; ! **********************************************************
(defun lib:Zoom2Lst( vlist / bl tr Lst OS)
;(setq *MIP-ZOOM-PREV* nil)
(setq  Lst (lib:pt_extents vlist)
  bl (car Lst) tr (cadr Lst))
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
(progn  (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0)
  (command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1)
    "_.Zoom" "0.95x")
 ;       (setq *MIP-ZOOM-PREV* 2)
  (setvar "OSMODE" OS)
  T) NIL))
;| ! ***************************************************************************
;; !           lib:pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' — Список точек
;; ! Returns  : Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defun  lib:pt_extents (vlist / tmp)
(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))
 (mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))
 '(0 1 2))));_setq
  (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
;https://www.caduser.ru/forum/topic30797.html
;Block Contour
(defun C:BC ( / *error* blk obj MinPt MaxPt hiden pt pl unnamed_block adoc tmp_blk adoc)
(defun *error* ( msg )(mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden)
  (vla-endundomark adoc)(if (and tmp_blk (vlax-write-enabled-p tmp_blk))(vla-Erase tmp_blk)))
(vl-load-com)
(vl-cmdf "_.UCS" "")(vl-cmdf "_.Plan" "")
(setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(if (and (setq blk (car(entsel "\nУкажите блок: ")))
   (= (cdr(assoc 0 (entget blk))) "INSERT")
   (setq obj (vlax-ename->vla-object blk)))
  (progn
  (vla-GetBoundingBox OBJ 'MinPt 'MaxPt)  ;_Границы блока
  (setq MinPt (vlax-safearray->list MinPt)
        MaxPt (vlax-safearray->list MaxPt))
        MinPt (mapcar '- MinPt '(10 10))
        MaxPt (mapcar '+ MaxPt '(10 10)))
  (lib:Zoom2Lst (list MinPt MaxPt))
  (setq sset (ssget "_C" MinPt MaxPt))
  (if sset (progn
      (setq hiden (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))))
      (setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point '(0. 0. 0.)) "*U"))
      (vla-InsertBlock unnamed_block (vlax-3d-point '(0. 0. 0.))(vla-get-name obj) 1 1 1 0)
      (setq tmp_blk (vla-insertblock (vla-ObjectIDToObject adoc (vla-get-OwnerID obj))
    (vla-get-insertionpoint obj)(vla-get-name unnamed_block)
        (vla-get-xscalefactor obj)(vla-get-yscalefactor obj)
        (vla-get-zscalefactor obj)(vla-get-rotation obj)))
      (vla-put-Normal tmp_blk (vla-get-normal obj))
      (mapcar '(lambda(x)(vla-put-Visible x :vlax-false)) hiden)
      (setq pt (mapcar '+ MinPt '(5 5)))
      (vl-cmdf "_.RECTANG" (trans MinPt 0 1)(trans MaxPt 0 1))
      (setq pl (vlax-ename->vla-object(entlast)))
      (if (VL-CATCH-ALL-ERROR-P
      (VL-CATCH-ALL-APPLY '(lambda ()
         (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
              (while (> (getvar "CMDACTIVE") 0)(command "")))))
      (princ "\nНе удалось построить контур"))
      (vla-Erase pl)(vla-Erase tmp_blk)(vl-cmdf "_.ERASE" MinPt "")
      (setq pl (vlax-ename->vla-object(entlast)))
      (mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden)
      (initget  "Yes No")
      (if (and (= (getkword "\nУдалять блок? [Yes/No] <No> : ") "Yes")
         (vlax-write-enabled-p obj))(vla-Erase obj))))))
  (vla-endundomark adoc)(princ))
(princ "\nНаберите в командной строке BC")

Юрий

Юрий
Восстановленный участник

На форуме с 10 апреля 2006г.
Сообщений: 178
Спасибо: 0

Re: Контур по блоку

to VVA
Большое спасибо. Все ОК!

  (setq MinPt (vlax-safearray->list MinPt)
        MaxPt (vlax-safearray->list MaxPt)) ; <- лишняя правая скобка
        MinPt (mapcar '- MinPt '(10 10))
        MaxPt (mapcar '+ MaxPt '(10 10)))

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Контур по блоку

> Юрий
Сэнькс

;https://www.caduser.ru/forum/topic30797.html
;| ! *******************************************************************
;; !                  lib:IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  — Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
(setq pt (trans pt 0 1))
(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
   SSZ (getvar "SCREENSIZE")
   X_Pix (car SSZ) Y_Pix (cadr SSZ)
   X_Len (* (/ X_Pix Y_Pix) Y_Len)
   Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
   Uc (polar Lc 0.0 X_Len)
   Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
   Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))
(if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
   (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)))
  T nil))
(defun DTR (a)(* pi (/ a 180.0)))
(defun RTD (a)(/ (* a 180.0) pi))
; ! ***********************************************************
;; !                             lib:Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' — Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns  : t — было зуммирование nil — нет
;; ! **********************************************************
(defun lib:Zoom2Lst( vlist / bl tr Lst OS)
;(setq *MIP-ZOOM-PREV* nil)
(setq  Lst (lib:pt_extents vlist)
  bl (car Lst) tr (cadr Lst))
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
(progn  (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0)
  (command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1)
    "_.Zoom" "0.95x")
 ;       (setq *MIP-ZOOM-PREV* 2)
  (setvar "OSMODE" OS)
  T) NIL))
;| ! ***************************************************************************
;; !           lib:pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' — Список точек
;; ! Returns  : Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defun  lib:pt_extents (vlist / tmp)
(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))
 (mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))
 '(0 1 2))));_setq
  (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
;https://www.caduser.ru/forum/topic30797.html
;Block Contour
(defun C:BC ( / *error* blk obj MinPt MaxPt hiden pt pl unnamed_block adoc tmp_blk adoc)
(defun *error* ( msg )(mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden)
  (vla-endundomark adoc)(if (and tmp_blk (vlax-write-enabled-p tmp_blk))(vla-Erase tmp_blk)))
(vl-load-com)
(vl-cmdf "_.UCS" "")(vl-cmdf "_.Plan" "")
(setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(if (and (setq blk (car(entsel "\nУкажите блок: ")))
   (= (cdr(assoc 0 (entget blk))) "INSERT")
   (setq obj (vlax-ename->vla-object blk)))
  (progn
  (vla-GetBoundingBox OBJ 'MinPt 'MaxPt)  ;_Границы блока
  (setq MinPt (vlax-safearray->list MinPt)
        MaxPt (vlax-safearray->list MaxPt)
        MinPt (mapcar '- MinPt '(10 10))
        MaxPt (mapcar '+ MaxPt '(10 10)))
  (lib:Zoom2Lst (list MinPt MaxPt))
  (setq sset (ssget "_C" MinPt MaxPt))
  (if sset (progn
      (setq hiden (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))))
      (setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point '(0. 0. 0.)) "*U"))
      (vla-InsertBlock unnamed_block (vlax-3d-point '(0. 0. 0.))(vla-get-name obj) 1 1 1 0)
      (setq tmp_blk (vla-insertblock (vla-ObjectIDToObject adoc (vla-get-OwnerID obj))
    (vla-get-insertionpoint obj)(vla-get-name unnamed_block)
        (vla-get-xscalefactor obj)(vla-get-yscalefactor obj)
        (vla-get-zscalefactor obj)(vla-get-rotation obj)))
      (vla-put-Normal tmp_blk (vla-get-normal obj))
      (mapcar '(lambda(x)(vla-put-Visible x :vlax-false)) hiden)
      (setq pt (mapcar '+ MinPt '(5 5)))
      (vl-cmdf "_.RECTANG" (trans MinPt 0 1)(trans MaxPt 0 1))
      (setq pl (vlax-ename->vla-object(entlast)))
      (if (VL-CATCH-ALL-ERROR-P
      (VL-CATCH-ALL-APPLY '(lambda ()
         (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
              (while (> (getvar "CMDACTIVE") 0)(command "")))))
      (princ "\nНе удалось построить контур"))
      (vla-Erase pl)(vla-Erase tmp_blk)(vl-cmdf "_.ERASE" MinPt "")
      (setq pl (vlax-ename->vla-object(entlast)))
      (mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden)
      (initget  "Yes No")
      (if (and (= (getkword "\nУдалять блок? [Yes/No] <No> : ") "Yes")
         (vlax-write-enabled-p obj))(vla-Erase obj))))))
  (vla-endundomark adoc)(princ))
(princ "\nНаберите в командной строке BC")

Август

Август
Восстановленный участник

На форуме с 4 октября 2006г.
Сообщений: 32
Спасибо: 0

Re: Контур по блоку

> VVA
с удовольствием пользуюсь записанным кодом но, вот заметил такую штуку, что при частом использовании кода....он перестаёт работать....указываю блок...но контур не строится....и ещё поже обязательным условием является что б базовая точка лежала на контуре?
PS:русский 2004 Кад

Контур по блоку (Страница 1 из 2)

Сообщения с 1 по 25 из 40

#1 Тема от Август 24 октября 2006г. 13:36:40

Тема: Контур по блоку

#2 Ответ от scj 25 октября 2006г. 15:52:48

Re: Контур по блоку

#3 Ответ от Август 26 октября 2006г. 06:51:04

Re: Контур по блоку

#4 Ответ от Юрий 10 ноября 2006г. 14:57:37

Re: Контур по блоку

#5 Ответ от Fatty 11 ноября 2006г. 01:29:00

Re: Контур по блоку

#6 Ответ от Август 14 ноября 2006г. 08:09:12

Re: Контур по блоку

#7 Ответ от VVA 14 ноября 2006г. 09:19:37

Re: Контур по блоку

#8 Ответ от Август 14 ноября 2006г. 10:39:22

Re: Контур по блоку

#9 Ответ от kpblc 14 ноября 2006г. 11:35:32

Re: Контур по блоку

#10 Ответ от Эдуард Смолянка 14 ноября 2006г. 11:37:24

Re: Контур по блоку

#11 Ответ от Август 14 ноября 2006г. 12:09:15

Re: Контур по блоку

#12 Ответ от Август 14 ноября 2006г. 12:17:04

Re: Контур по блоку

#13 Ответ от VVA 14 ноября 2006г. 13:28:57

Re: Контур по блоку

#14 Ответ от VVA 14 ноября 2006г. 13:32:13

Re: Контур по блоку

#15 Ответ от VVA 14 ноября 2006г. 13:33:45

Re: Контур по блоку

#16 Ответ от Август 14 ноября 2006г. 13:40:02

Re: Контур по блоку

#17 Ответ от Август 14 ноября 2006г. 13:50:30

Re: Контур по блоку

#18 Ответ от VVA 14 ноября 2006г. 14:08:43

Re: Контур по блоку

#19 Ответ от Август 14 ноября 2006г. 14:15:49

Re: Контур по блоку

#20 Ответ от scj 14 ноября 2006г. 23:30:03

Re: Контур по блоку

#21 Ответ от Август 15 ноября 2006г. 05:43:51

Re: Контур по блоку

#22 Ответ от VVA 15 ноября 2006г. 18:42:34

Re: Контур по блоку

#23 Ответ от Юрий 16 ноября 2006г. 08:52:02

Re: Контур по блоку

#24 Ответ от VVA 16 ноября 2006г. 10:30:53

Re: Контур по блоку

#25 Ответ от Август 16 ноября 2006г. 12:09:25

Re: Контур по блоку

Сообщения с 1 по 25 из 40

Тему читают: 1 гость

Вход на форум «Форумы CADUser»x

Ссылки