Explode attributes to text

Explode attributes to text · 13.09.2006, 21:26

Уважаемые программисты помогите пожалуйста:
Есть lisp: burst.lsp - из експрессов
но нужно доработать сам я пока не силен:
задача в следующем:
1) определить какие атрибуты отображаются в соответствии с состоянием видимости динамического блока.
2) их нужно разбить превратив в текст (так как это делает burst.lsp)
3) те которые не отображаются в соответствии с состоянием видимости - удалить.
Заранее благодарен.

AY · 14.09.2006, 10:26

Вот измененный код отражающий ваше замечание.
Для надежности сохраните копию старого варианта burst.lsp

Пробуйте...

Код:

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

;;;
;;;
;;;    BURST.LSP
;;;    Copyright © 1999 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
   ;-----------------------------------------------------
 
   (Defun ATT-TEXT (AENT / TENT ILIST INUM)
      (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))
;;;========================================

     
;;;новый код
;;;======================================= 
     (if (not (and (assoc 60 aent)(= (cdr (assoc 60 aent)) 1)))
      (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)
      (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)

[/code]

Sleekka · 14.09.2006, 20:07

Спасибо огромное. Все корректно работает.

Sleekka · 15.09.2006, 10:39

Еще одна маленькая просьба, я использую несколько атрибутов которые invisible потом из них и получается заполнение тех которые распределены по состояниям видимости, нельзя ли доработать чтоб invisible атрибуты не разбивались. (т е удалялись при разбиении так как те которые не попали в данное состояние видимости).?

AY · 15.09.2006, 13:17

Пробуй:

Код:

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

;;; 
;;; 
;;;    BURST.LSP 
;;;    Copyright © 1999 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 
   ;----------------------------------------------------- 
  
   (Defun ATT-TEXT (AENT / TENT ILIST INUM) 
      (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)) 
;;;======================================== 

      
;;; измененный вариант
;;;======================================= 
     (if (and (/= (cdr (assoc 70 aent)) 1)
	     (not (and (assoc 60 aent) (= (cdr (assoc 60 aent)) 1))))
       (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) 
      (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)

Sleekka · 21.09.2006, 18:04

Спасибо огромное еще раз!!!

Sleekka · 04.12.2006, 18:48

Цитата:

;;; измененный вариант
;;;=======================================
(Setq sl1 (cdr (assoc 70 aent)))
(if (and or ((/= sl1 1) (/= sl1 3) (/= sl1 5) (/= sl1 9) (/= sl1 7) (/= sl1 11) (/= sl1 13) (/= sl1 15))
(not (and (assoc 60 aent) (= (cdr (assoc 60 aent)) 1))))
(EntMake (Reverse TENT))
)

подскажите пожалуйста кто-нибудь (я новичок в этом), судя по последнему коду выложенному AY, удалялись также и атрибуты у который был Invisible, это отражается наличием битового флага в dxf коде 70 у атрибута, но бывает что я использую атрибуты у который помимо Invisible стоит к примеру Preset, тогда сумма битовых флагов равна 9, я вот и решил поправить код так, чтобы удалялись все где есть Invisible, а не только те где он один, мой кусок кода выше подскажите что не так, у меня выдает bad funсtion: T в командной строке автокада.

fixo · 04.12.2006, 20:34

Без проверки:
перед OR скобку добавь а после него убери

~'J'~

VVA · 04.12.2006, 20:58

Значения кодов группы 70

Цитата:

Attribute flags:
1 = Attribute is invisible (does not appear)
2 = This is a constant attribute
4 = Verification is required on input of this attribute
8 = Attribute is preset (no prompt during insertion

Тогда должно работать так

Код:

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

(Setq sl1 (cdr (assoc 70 aent))) 
(if (and
	(= (logand sl1 1) 0) ;_Bit 1 не установлен
	(not (and (assoc 60 aent) (= (cdr (assoc 60 aent)) 1)))
	) 
(EntMake (Reverse TENT))
)

Krieger · 05.12.2006, 07:14

А можно ли как-нибудь добавить отбрасывание обрезанных частей блока командой _xclip?

Sleekka · 05.12.2006, 18:56

2VVA Спасибо, твой код работает. а вот мой заработал, когда я поправил, как сказал fatty, но заработал неправильно. Буду разбираться, и попробую еще проапгрейдить burst, на мой взгляд там еще многого не хватает с точки зрения пользователя.

jon73 · 15.05.2015, 11:02

Здравствуйте, на работе не установлен экспресс тулс, и стоит запрет на установку. как мне взорвать блок чтобы остался видимым видимый атрибут? команды burst не работают выдает ошибку ошибка: no function definition: ACET-ERROR-INIT

skkkk · 15.05.2015, 11:20

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

Цитата:

If you copy this computer program without permission of Autodesk, you are violating the law.

(Если вы копируете эту программу без разрешения Аутодеск, вы нарушаете закон.)
Однако, изменение данных программ, видимо, тоже является нарушением. И неясно, почему они тогда не защитили данные программы компиляцией, например в *.fas?

jon73 · 15.05.2015, 11:26

жаль.. я думал есть готовый липс...

skkkk · 15.05.2015, 11:48

Сейчас вспомнил, что он всё-таки есть. Правда не липс, а лисп

jon73 · 15.05.2015, 11:59

Спасибо то что нужно!

13.09.2006, 21:26		#1
Explode attributes to text Sleekka - Москва Регистрация: 24.07.2005 Сообщений: 1,335 Уважаемые программисты помогите пожалуйста: Есть lisp: burst.lsp - из експрессов но нужно доработать сам я пока не силен: задача в следующем: 1) определить какие атрибуты отображаются в соответствии с состоянием видимости динамического блока. 2) их нужно разбить превратив в текст (так как это делает burst.lsp) 3) те которые не отображаются в соответствии с состоянием видимости - удалить. Заранее благодарен.
Просмотров: 7646