图块属性:
名称:文字
长度:100
阀门位号:XV-123
页码:1
(Defun C:BURST11 (/ 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))
;-----------------------------------------------------
; MUTTERING
;-----------------------------------------------------
(defun muttering ()
(= (getvar "NOMUTT") 0)
)
;-----------------------------------------------------
; BUMP
;-----------------------------------------------------
(Setq bcnt 0)
(Defun bump (prmpt)
(if (muttering)
(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
2
50
41
51
7
71
72
73
11
74
)
(If (Setq ILIST (Assoc INUM AENT))
(Setq TENT (Cons ILIST TENT))
)
)
;打印自定义属性
(setq IblockText (cdr (assoc 1 TENT)))
(setq IblockTextName (cdr (assoc 2 TENT)))
;;;(princ IblockText)
;;;(princ iblocktextname)
(Setq
tent (Subst
(Cons 73 (item 74 aent))
(Assoc 74 tent)
tent
)
)
;;;(EntMake (Reverse TENT))
)
)
;返回数
(cons iblocktextname iblocktext)
)
;-----------------------------------------------------
; 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
)
;-----------------------------------------------------
; Burs·1 11e entity
;-----------------------------------------------------
(Defun BURST-ONE (BNAME / BENT ANAME ENT ATYPE AENT AGAIN ENAME
ENT BBLOCK SS-COLOR SS-LAYER SS-LTYPE mirror ss-mirror
mlast)
;;;初始化list_blocktext为空列表
(setq list_blocktext nil)
(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)
(SETQ BLOCKTEXT (ATT-TEXT AENT))
;;;(princ BLOCKTEXT)
;;;组成列表
;;;list_blocktext不能是空值
(setq LIST_BLOCKTEXT (cons blocktext list_blocktext))
(princ list_blocktext)
(princ "\n")
)
)
)
(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 ""
)
)
)
(princ "返回长度:\n")
(princ "\n")
list_blocktext
)
;-----------------------------------------------------
; BURST MAIN ROUTINE
;-----------------------------------------------------
(Defun BURST11 (/ SS1)
(setq list_blocktext1 nil)
(setq list_lang 0.0)
(setq qyg_lang_val 0.0)
(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)
(setq list_blocktext1 (BURST-ONE ENAME))
(princ list_blocktext1)
(princ "\n 长度:\n")
(setq qyg_lang (assoc "长度" list_blocktext1))
(setq qyg_lang_val (cdr qyg_lang))
;;;处理字符转换成双精度
(setq qyg_lang_val (float (atoi qyg_lang_val)))
(princ qyg_lang_val)
(setq list_lang (+ list_lang qyg_lang_val))
(princ "\n")
)
(princ "\n气源管总长度: ")
(princ list_lang)
(if (muttering)
(princ "\n")
)
)
)
)
;-----------------------------------------------------
; BURST COMMAND
;-----------------------------------------------------
(BURST11)
;;;(acet-error-restore)
);end defun
(princ "973490770@qq.com")
(princ)
;;;(c:burst11)