AutoLisp. Аналог команды Change или Сhprop

AutoLisp. Аналог команды Change или Сhprop · 28.10.2011, 16:03

Имеются блоки, в них различные примитивы. Они в определенном слое. Нужно этот блок взорвать и затем восстановить принадлежность к слою, ибо после взрыва все примитивы переходят в слой 0. Сейчас делаю это так:

Код:

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

(vl-cmdf "_explode" name "") 
(setq l1 (ssget "p"))
(vl-cmdf "_chprop" l1 "" "la" layer "" "")

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

Кулик Алексей aka kpblc · 28.10.2011, 16:21

Попробуй либо bind, либо его аналог от VVA (поищи по форуму, тема "Express Bugs" - кажется, так). Ну или свою обработку писать...

VVA · 28.10.2011, 16:30

Цитата:

Сообщение от Кулик Алексей aka kpblc

Попробуй либо bind

burst. bind - это к xref.

Zaghim,
BGBLEXP - Взрывает блок и все блоки, входящие в него, превращая видимые атрибуты в текст

Zaghim · 28.10.2011, 16:30

Точно... про (только не Bind) Burst я и забыл... щас попробую.
Напомните только как пользоваться им... (command "burst" ... так нельзя... там в скобках просто (burst name) или как?

Кулик Алексей aka kpblc · 28.10.2011, 16:39

Ну звиняйте, господа хорошие... Голова с трудом варит...

Zaghim · 28.10.2011, 16:51

Подскажите, если нельзя запустить так берст и передать ему имя блока, то может воспользоваться кодом берста? Только не пойму, что нужно убрать а что оставить

Код:

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

;;;
;;;
;;;    BURST.LSP
;;;    Copyright © 1999-2006 by Autodesk, Inc.
;;;
;;;    Your use of this software is governed by the terms and conditions of the
;;;    License Agreement you accepted prior to installation of this software.
;;;    Please note that pursuant to the License Agreement for this software,
;;;    "[c]opying of this computer program or its documentation except as
;;;    permitted by this License is copyright infringement under the laws of
;;;    your country.  If you copy this computer program without permission of
;;;    Autodesk, you are violating the law."
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;  ----------------------------------------------------------------
 
(Defun C:BURST (/ item bitset bump att-text lastent burst-one burst
                  BCNT BLAYER BCOLOR ELAST BLTYPE ETYPE PSFLAG ENAME )
 
   ;-----------------------------------------------------
   ; Item from association list
   ;-----------------------------------------------------
   (Defun ITEM (N E) (CDR (Assoc N E)))
   ;-----------------------------------------------------
   ; Error Handler
   ;-----------------------------------------------------
 
  (acet-error-init
    (list
      (list "cmdecho" 0
            "highlight" 1
      )
      T     ;flag. True means use undo for error clean up.
    );list
  );acet-error-init
 
 
   ;-----------------------------------------------------
   ; BIT SET
   ;-----------------------------------------------------
 
   (Defun BITSET (A B) (= (Boole 1 A B) B))
 
   ;-----------------------------------------------------
   ; BUMP
   ;-----------------------------------------------------
 
   (Setq bcnt 0)
   (Defun bump (prmpt)
      (Princ
         (Nth bcnt '("\r-" "\r\\" "\r|" "\r/"))
      )
      (Setq bcnt (Rem (1+ bcnt) 4))
   )
 
   ;-----------------------------------------------------
   ; Convert Attribute Entity to Text Entity or MText Entity
   ;-----------------------------------------------------
 
   (Defun ATT-TEXT (AENT / ANAME TENT ILIST INUM)
      (setq ANAME (cdr (assoc -1 AENT)))
      (if (_MATTS_UTIL ANAME)
         (progn
            ; Multiple Line Text Attributes (MATTS) -
            ; make an MTEXT entity from the MATTS data
            (_MATTS_UTIL ANAME 1)
         )
         (progn
            ; else -Single line attribute conversion
            (Setq TENT '((0 . "TEXT")))
            (ForEach INUM '(8
                            6
                            38
                            39
                            62
                            67
                            210
                            10
                            40
                            1
                            50
                            41
                            51
                            7
                            71
                            72
                            73
                            11
                            74
                           )
               (If (Setq ILIST (Assoc INUM AENT))
                   (Setq TENT (Cons ILIST TENT))
               )
            )
            (Setq
               tent (Subst
                       (Cons 73 (item 74 aent))
                       (Assoc 74 tent)
                       tent
                    )
            )
            (EntMake (Reverse TENT))
         )
      )
   )
 
   ;-----------------------------------------------------
   ; Find True last entity
   ;-----------------------------------------------------
 
   (Defun LASTENT (/ E0 EN)
      (Setq E0 (EntLast))
      (While (Setq EN (EntNext E0))
         (Setq E0 EN)
      )
      E0
   )
 
   ;-----------------------------------------------------
   ; See if a block is explodable. Return T if it is, 
   ; otherwise return nil
   ;-----------------------------------------------------
 
   (Defun EXPLODABLE (BNAME / B expld)
      (vl-load-com)
      (setq BLOCKS (vla-get-blocks 
                     (vla-get-ActiveDocument (vlax-get-acad-object)))
       )
      
      (vlax-for B BLOCKS (if (and (= :vlax-false (vla-get-islayout B))
                                  (= (strcase (vla-get-name B)) (strcase BNAME)))
                      (setq expld (= :vlax-true (vla-get-explodable B)))
           )
       )
       expld
    )


   ;-----------------------------------------------------
   ; Burst one entity
   ;-----------------------------------------------------
 
   (Defun BURST-ONE (BNAME / BENT ANAME ENT ATYPE AENT AGAIN ENAME
                     ENT BBLOCK SS-COLOR SS-LAYER SS-LTYPE mirror ss-mirror
                     mlast)
      (Setq
         BENT   (EntGet BNAME)
         BLAYER (ITEM 8 BENT)
         BCOLOR (ITEM 62 BENT)
         BBLOCK (ITEM 2 BENT)
         BCOLOR (Cond
                   ((> BCOLOR 0) BCOLOR)
                   ((= BCOLOR 0) "BYBLOCK")
                   ("BYLAYER")
                )
         BLTYPE (Cond ((ITEM 6 BENT)) ("BYLAYER"))
      )
      (Setq ELAST (LASTENT))
      (If (and (EXPLODABLE BBLOCK) (= 1 (ITEM 66 BENT)))
         (Progn
            (Setq ANAME BNAME)
            (While (Setq
                      ANAME (EntNext ANAME)
                      AENT  (EntGet ANAME)
                      ATYPE (ITEM 0 AENT)
                      AGAIN (= "ATTRIB" ATYPE)
                   )
               (bump "Converting attributes")
               (ATT-TEXT AENT)
            )
         )
      )
         (Progn
            (bump "Exploding block")
            (acet-explode BNAME)
            ;(command "_.explode" bname)
         )
      (Setq
         SS-LAYER (SsAdd)
         SS-COLOR (SsAdd)
         SS-LTYPE (SsAdd)
         ENAME    ELAST
      )
      (While (Setq ENAME (EntNext ENAME))
         (bump "Gathering pieces")
         (Setq
            ENT   (EntGet ENAME)
            ETYPE (ITEM 0 ENT)
         )
         (If (= "ATTDEF" ETYPE)
            (Progn
               (If (BITSET (ITEM 70 ENT) 2)
                  (ATT-TEXT ENT)
               )
               (EntDel ENAME)
            )
            (Progn
               (If (= "0" (ITEM 8 ENT))
                  (SsAdd ENAME SS-LAYER)
               )
               (If (= 0 (ITEM 62 ENT))
                  (SsAdd ENAME SS-COLOR)
               )
               (If (= "BYBLOCK" (ITEM 6 ENT))
                  (SsAdd ENAME SS-LTYPE)
               )
            )
         )
      )
      (If (> (SsLength SS-LAYER) 0)
         (Progn
            (bump "Fixing layers")
            (Command
               "_.chprop" SS-LAYER "" "_LA" BLAYER ""
            )
         )
      )
      (If (> (SsLength SS-COLOR) 0)
         (Progn
            (bump "Fixing colors")
            (Command
               "_.chprop" SS-COLOR "" "_C" BCOLOR ""
            )
         )
      )
      (If (> (SsLength SS-LTYPE) 0)
         (Progn
            (bump "Fixing linetypes")
            (Command
               "_.chprop" SS-LTYPE "" "_LT" BLTYPE ""
            )
         )
      )
   )
 
   ;-----------------------------------------------------
   ; BURST MAIN ROUTINE
   ;-----------------------------------------------------
 
   (Defun BURST (/ SS1)
      (setq PSFLAG (if (= 1 (caar (vports)))
                       1 0
                   )
      )
      (Setq SS1 (SsGet (list (cons 0 "INSERT")(cons 67 PSFLAG))))
      (If SS1
         (Progn
            (Setvar "highlight" 0)
            (terpri)
            (Repeat
               (SsLength SS1)
               (Setq ENAME (SsName SS1 0))
               (SsDel ENAME SS1)
               (BURST-ONE ENAME)
            )
            (princ "\n")
         )
      )
   )
 
   ;-----------------------------------------------------
   ; BURST COMMAND
   ;-----------------------------------------------------
 
   (BURST)
 
  (acet-error-restore)
 
);end defun


(princ)

VVA · 28.10.2011, 17:23

Zaghim, Чем тебя BGBLEXP не устраивает? Зачем заново писать собственный Автокад?
По поводу BURST - там есть много недоработок. Можешь почитать здесь Express Tools Bugs ( Ошибки Express Tools ) пост #2
К этому добавлю только, что
1. если блок подрезан, то применив burst сильно удивишься результату
2. если используешь маскировку, она вылезет наверх
3. если в динамическом блоке ты visibility скрываешь часть атрибутов, то после burst увидишь их все
4. если в атрибуте были поля, ты их потеряешь
...
Если хочестя самому взрывать из лиспа, то используй ф-цию bg:explode-block из bgtools

Код:

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

(bg:explode-block (car(entsel "\nSelect block")) t)

Zaghim · 28.10.2011, 17:47

VVA, пишет вот что - ; error: unable to get ObjectID: nil

Вываливается здесь: (setq blk_obj (if (= (type blk) 'ENAME)(vlax-ename->vla-object blk) blk)))
blk имеет вид <Entity name: 7e8c0420>

А точнее это происходит на каком-то блоке. Они все динамические кстати с атрибутами... НО некоторые не динамические это имеет значение?

VVA · 28.10.2011, 18:01

1. Сделай _audit чертежу
2. Что возвращает (entget blk) и (vlax-ename->vla-object blk)?
3. Выложи чертеж с проблемным блоком или вышли почтой

Кулик Алексей aka kpblc · 28.10.2011, 21:57

Цитата:

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

unable to get ObjectID: nil

подозреваю 64-разрядный AutoCAD...

CB · 29.10.2011, 13:19

Обрисуй полную картину того, что ты хочешь получить после взрыва блока, какую цель ты преследуешь взрывом блока, что из себя представляют блоки? Сильно много непоняток. Например - есть блок с атрибутом. После explode блока - value атрибута превращается в tag - это нормально или как?

Zaghim · 31.10.2011, 09:52

Такс...автокад 32-разрядный, на каком блоке вылетает, сейчас посмотрим и выложу блоки.
По поводу целей. У меня есть чертеж, состоит исключительно из блоков, мне нужно сделать из него аксонометрию, дабы это сделать нужно вначале все взорвать, т.к. блок положить по 45 на мой взгляд нереально. Взрываю, соответственно атрибуты вылазят наружу и слой всего внутри уходит в 0. То что вылезли атрибуты - не проблема, ибо выбирают их в цикле и по одному удаляю, работает быстро. А вот восстановить слой нужно обязательно и моим кодом в шапке темы - это как то очень тормазно и ругательно))
Блоки практически все динамические и с атрибутами с визибл сетами. Но есть и просто блоки не динамические, но все с атрибутами.
Вылетает на этом блоке и еще на некоторых других.
И еще прога чувствительна к блокам, которые в базе есть, а на чертеже нет по-моему...
321.dwg - общая картина

VVA · 31.10.2011, 14:03

Без ошибок взорвались твои блоки командой BGBLEXP.

Zaghim · 31.10.2011, 14:11

А как мне соединить теперь мою команду и эту команду?
Просто мне нужно не все взрывать, а только некоторые блоки...
У меня есть только имя переменной, которую нужно взорвать. Почему не получается если сразу идти на bg:explode-block не понятно((

VVA · 31.10.2011, 15:05

BGBLEXP обрабатывает предварительный выбор.
Пример. Взорвать блоки с именем TEST

Код:

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

(if
  ;;;Формируем набор из нужных блоков
  (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 2 "TEST")(cons 410 (getvar "CTAB")))))
  (progn
    (SSSETFIRST nil ss) ;_Подсвечиваем набор ручками (предварительный выбор)
    (C:BGBLEXP) ;_Вызывает BGBLEXP
    )
  )

bgtools должны быть предварительно загружены

Zaghim · 31.10.2011, 15:15

VVA, нет так не прокатит, потому что у динамических блоков, когда их много, имена такого типа *U31 и тд...
Но я тут что-то наковырял, вроде сработало...а запарывалась она похоже из-за того, что и правда блоков физически не было, а определения хранились...

VVA · 31.10.2011, 18:26

Цитата:

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

VVA, нет так не прокатит, потому что у динамических блоков, когда их много, имена такого типа *U31 и тд..

Здесь решения Lee Mac для динамических блоков.

Код:

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

;; Returns list of the Anonymous names taken by a Dynamic Block (if any)  -  Lee Mac 2011  -  www.lee-mac.com
;; Arguments:  block  - name of Dynamic Block.

(defun AnonymousInstancesof ( block / def rec nme ref lst )
  (while (setq def (tblnext "BLOCK" (null def)))
    (if (= 1 (logand 1 (cdr (assoc 70 def))))
      (progn
        (setq rec
          (entget
            (cdr
              (assoc 330
                (entget
                  (tblobjname "BLOCK" (setq nme (cdr (assoc 2 def))))
                )
              )
            )
          )
        )
        (while (setq ref (assoc 331 rec))
          (if
            (and
              (eq block (vla-get-effectivename (vlax-ename->vla-object (cdr ref))))
              (not (member nme lst))
            )
            (setq lst (cons nme lst))
          )
          (setq rec (cdr (member (assoc 331 rec) rec)))
        )
      )
    )
  )
  (reverse lst)
)
(defun LM:BlockList->Str ( lst del / f )
  ;; © Lee Mac 2011

  (defun f ( s ) (if (wcmatch s "`**") (strcat "`" s) s))
  
  (if (cdr lst)
    (strcat (f (car lst)) del (LM:BlockList->Str (cdr lst) del))
    (f (car lst))
  )
)

использование

Код:

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

(ssget "_X"
  (list
    (cons 0 "INSERT")
    (cons 2 (LM:BlockList->Str (cons "TITLEBLOCK" (AnonymousInstancesof "TITLEBLOCK")) ","))
    (cons 66 1)
  )
)

Вместо TITLEBLOCK введи свое имя блока и получишь набор всех вариаций в чертеже этого динамического блока

Кулик Алексей aka kpblc · 31.10.2011, 21:32

не знаю почему, но у меня код LeeMac вываливает ошибку с завидным постоянством. Разбираться как-то лень.
P.S. Я пользуюсь таким кодом - пока устраивает...

Код:

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

 (vl-load-com)

(defun get-dynblock-references (doc name / fun_get-name res subname)
                               ;|
*    Получение списка указателей на вхождения блока внутрь документа
*    Параметры вызова:
	doc		vla-указатель на обрабатываемый документ. nil -> текущий документ
	name	полное имя блока, указатель на вхождение блока (vla- или ename-)
|;

  (defun fun_get-name (ent)
    (cond
      ((= (type ent) 'ename) (fun_get-name (vlax-ename->vla-object ent)))
      ((and (= (type ent) 'vla-object) (vlax-property-available-p ent 'effectivename))
       (vla-get-effectivename ent)
       )
      ((and (= (type ent) 'vla-object) (vlax-property-available-p ent 'name)) (vla-get-name ent))
      ) ;_ end of cond
    ) ;_ end of defun

  (cond
    ((not doc)
     (setq res (get-dynblock-references (vla-get-activedocument (vlax-get-acad-object)) name))
     )
    ((and (= (type doc) 'vla-object)
          (member (type name) (list 'ename 'vla-object))
          ) ;_ end of and
     (setq res (get-dynblock-references doc (fun_get-name (vlax-ename->vla-object name))))
     )
    ((and (= (type doc) 'vla-object)
          (= (type name) 'str)
          (not (wcmatch (strcase name) "`*U*"))
          ) ;_ end of and
     (vlax-for blk_def (vla-get-blocks doc)
       (if (and (equal (vla-get-isxref blk_def) :vlax-false)
                (/= (strcase (vla-get-name blk_def)) (strcase name))
                ) ;_ end of and
         (vlax-for subent blk_def
           (if (and (setq subname (fun_get-name subent))
                    (wcmatch (strcase subname) (strcase name))
                    ) ;_ end of and
             (setq res (cons subent res))
             ) ;_ end of if
           ) ;_ end of vlax-for
         ) ;_ end of if
       ) ;_ end of vlax-for
     (setq res (reverse res))
     )
    ) ;_ end of cond
  res
  ) ;_ end of defun

CB · 02.11.2011, 13:36

Проверь на одиночном блоке

Код:

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

 
(defun test (/ obj bl la)
;;;запоминаем последний элемент в базе чертежа
  (setq obj (entlast))
;;;выбираем блок
  (setq bl (vlax-ename->vla-object
             (car (entsel "\nУкажите блок:"))
           ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
;;;запоминаем слой выбранного блока
  (setq la (vla-get-layer bl))
;;;взрываем блок
  (vla-explode bl)
;;;удаляем его
  (vla-delete bl)
;;;в цикле, со всеми примитивами, появившимися в базе чертежа
;;;  после взрыва блока делаем все, что хотим:
;;;  можно удалить атрибуты, задать слой или цвет и т.д. 
  (while (setq obj (entnext obj))
;;;например - задаем примитивам слой la
    (vla-put-layer (vlax-ename->vla-object obj) la)
  ) ;_ end of while
  (princ)
)

28.10.2011, 16:03		#1
AutoLisp. Аналог команды Change или Сhprop Zaghim Регистрация: 01.07.2010 Сообщений: 521 Имеются блоки, в них различные примитивы. Они в определенном слое. Нужно этот блок взорвать и затем восстановить принадлежность к слою, ибо после взрыва все примитивы переходят в слой 0. Сейчас делаю это так: Код: [Выделить все] (vl-cmdf "_explode" name "") (setq l1 (ssget "p")) (vl-cmdf "_chprop" l1 "" "la" layer "" "") В таком варианте, во-первых все делается тем слоем, что задаю, а может быть и такое что внутри блока, например оси, могут быть жестко белые, а все остальное по слою. А во-вторых весь этот процесс очень тормазнутый
Просмотров: 4877

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
запуск программы из AutoCADа	kminas	Программирование	19	15.06.2012 13:42
Аналог lisp команды command в .net	xsakabsx	LISP	3	18.11.2010 23:31
Аналог команды Slice в Solid	Taracka	SolidWorks	12	24.09.2010 23:50
Аналог команды "_Fillet"	Mazai	Программирование	5	15.04.2008 21:36

	Реклама i