当前位置:   article > 正文

提取autocad2024图形中图块的属性的代码-统计选中图块长度属性的总长度

提取autocad2024图形中图块的属性的代码-统计选中图块长度属性的总长度

图块属性:

名称:文字

长度:100

阀门位号:XV-123

页码:1

  1. (Defun C:BURST11 (/ item bitset bump att-text lastent burst-one burst
  2. BCNT BLAYER BCOLOR ELAST BLTYPE ETYPE PSFLAG ENAME )
  3. ;-----------------------------------------------------
  4. ; Item from association list
  5. ;-----------------------------------------------------
  6. (Defun ITEM (N E) (CDR (Assoc N E)))
  7. ;-----------------------------------------------------
  8. ; Error Handler
  9. ;-----------------------------------------------------
  10. (acet-error-init
  11. (list
  12. (list "cmdecho" 0
  13. "highlight" 1
  14. )
  15. T ;flag. True means use undo for error clean up.
  16. );list
  17. );acet-error-init
  18. ;-----------------------------------------------------
  19. ; BIT SET
  20. ;-----------------------------------------------------
  21. (Defun BITSET (A B) (= (Boole 1 A B) B))
  22. ;-----------------------------------------------------
  23. ; MUTTERING
  24. ;-----------------------------------------------------
  25. (defun muttering ()
  26. (= (getvar "NOMUTT") 0)
  27. )
  28. ;-----------------------------------------------------
  29. ; BUMP
  30. ;-----------------------------------------------------
  31. (Setq bcnt 0)
  32. (Defun bump (prmpt)
  33. (if (muttering)
  34. (Princ
  35. (Nth bcnt '("\r-" "\r\\" "\r|" "\r/"))
  36. )
  37. )
  38. (Setq bcnt (Rem (1+ bcnt) 4))
  39. )
  40. ;-----------------------------------------------------
  41. ; Convert Attribute Entity to Text Entity or MText Entity
  42. ;-----------------------------------------------------
  43. (Defun ATT-TEXT (AENT / ANAME TENT ILIST INUM)
  44. (setq ANAME (cdr (assoc -1 AENT)))
  45. (if (_MATTS_UTIL ANAME)
  46. (progn
  47. ; Multiple Line Text Attributes (MATTS) -
  48. ; make an MTEXT entity from the MATTS data
  49. (_MATTS_UTIL ANAME 1)
  50. )
  51. (progn
  52. ; else -Single line attribute conversion
  53. (Setq TENT '((0 . "TEXT")))
  54. (ForEach INUM '(8
  55. 6
  56. 38
  57. 39
  58. 62
  59. 67
  60. 210
  61. 10
  62. 40
  63. 1
  64. 2
  65. 50
  66. 41
  67. 51
  68. 7
  69. 71
  70. 72
  71. 73
  72. 11
  73. 74
  74. )
  75. (If (Setq ILIST (Assoc INUM AENT))
  76. (Setq TENT (Cons ILIST TENT))
  77. )
  78. )
  79. ;打印自定义属性
  80. (setq IblockText (cdr (assoc 1 TENT)))
  81. (setq IblockTextName (cdr (assoc 2 TENT)))
  82. ;;;(princ IblockText)
  83. ;;;(princ iblocktextname)
  84. (Setq
  85. tent (Subst
  86. (Cons 73 (item 74 aent))
  87. (Assoc 74 tent)
  88. tent
  89. )
  90. )
  91. ;;;(EntMake (Reverse TENT))
  92. )
  93. )
  94. ;返回数
  95. (cons iblocktextname iblocktext)
  96. )
  97. ;-----------------------------------------------------
  98. ; Find True last entity
  99. ;-----------------------------------------------------
  100. (Defun LASTENT (/ E0 EN)
  101. (Setq E0 (EntLast))
  102. (While (Setq EN (EntNext E0))
  103. (Setq E0 EN)
  104. )
  105. E0
  106. )
  107. ;-----------------------------------------------------
  108. ; See if a block is explodable. Return T if it is,
  109. ; otherwise return nil
  110. ;-----------------------------------------------------
  111. (Defun EXPLODABLE (BNAME / B expld)
  112. (vl-load-com)
  113. (setq BLOCKS (vla-get-blocks
  114. (vla-get-ActiveDocument (vlax-get-acad-object)))
  115. )
  116. (vlax-for B BLOCKS (if (and (= :vlax-false (vla-get-islayout B))
  117. (= (strcase (vla-get-name B)) (strcase BNAME)))
  118. (setq expld (= :vlax-true (vla-get-explodable B)))
  119. )
  120. )
  121. expld
  122. )
  123. ;-----------------------------------------------------
  124. ; Burs·1 11e entity
  125. ;-----------------------------------------------------
  126. (Defun BURST-ONE (BNAME / BENT ANAME ENT ATYPE AENT AGAIN ENAME
  127. ENT BBLOCK SS-COLOR SS-LAYER SS-LTYPE mirror ss-mirror
  128. mlast)
  129. ;;;初始化list_blocktext为空列表
  130. (setq list_blocktext nil)
  131. (Setq
  132. BENT (EntGet BNAME)
  133. BLAYER (ITEM 8 BENT)
  134. BCOLOR (ITEM 62 BENT)
  135. BBLOCK (ITEM 2 BENT)
  136. BCOLOR (Cond
  137. ((> BCOLOR 0) BCOLOR)
  138. ((= BCOLOR 0) "BYBLOCK")
  139. ("BYLAYER")
  140. )
  141. BLTYPE (Cond ((ITEM 6 BENT)) ("BYLAYER"))
  142. )
  143. (Setq ELAST (LASTENT))
  144. (If (and (EXPLODABLE BBLOCK) (= 1 (ITEM 66 BENT)))
  145. (Progn
  146. (Setq ANAME BNAME)
  147. (While (Setq
  148. ANAME (EntNext ANAME)
  149. AENT (EntGet ANAME)
  150. ATYPE (ITEM 0 AENT)
  151. AGAIN (= "ATTRIB" ATYPE)
  152. )
  153. ;;;(bump "Converting attributes")
  154. ;;;提取属性
  155. ;;;(ATT-TEXT AENT)
  156. (SETQ BLOCKTEXT (ATT-TEXT AENT))
  157. ;;;(princ BLOCKTEXT)
  158. ;;;组成列表
  159. ;;;list_blocktext不能是空值
  160. (setq LIST_BLOCKTEXT (cons blocktext list_blocktext))
  161. (princ list_blocktext)
  162. (princ "\n")
  163. )
  164. )
  165. )
  166. (Progn
  167. ;;;(bump "Exploding block")
  168. ;;;(acet-explode BNAME)
  169. ;(command "_.explode" bname)
  170. )
  171. (Setq
  172. SS-LAYER (SsAdd)
  173. SS-COLOR (SsAdd)
  174. SS-LTYPE (SsAdd)
  175. ENAME ELAST
  176. )
  177. (While (Setq ENAME (EntNext ENAME))
  178. ;;;(bump "Gathering pieces")
  179. (Setq
  180. ENT (EntGet ENAME)
  181. ETYPE (ITEM 0 ENT)
  182. )
  183. (If (= "ATTDEF" ETYPE)
  184. (Progn
  185. (If (BITSET (ITEM 70 ENT) 2)
  186. (ATT-TEXT ENT)
  187. )
  188. (EntDel ENAME)
  189. )
  190. (Progn
  191. (If (= "0" (ITEM 8 ENT))
  192. (SsAdd ENAME SS-LAYER)
  193. )
  194. (If (= 0 (ITEM 62 ENT))
  195. (SsAdd ENAME SS-COLOR)
  196. )
  197. (If (= "BYBLOCK" (ITEM 6 ENT))
  198. (SsAdd ENAME SS-LTYPE)
  199. )
  200. )
  201. )
  202. )
  203. (If (> (SsLength SS-LAYER) 0)
  204. (Progn
  205. ;;;(bump "Fixing layers")
  206. (Command
  207. "_.chprop" SS-LAYER "" "_LA" BLAYER ""
  208. )
  209. )
  210. )
  211. (If (> (SsLength SS-COLOR) 0)
  212. (Progn
  213. ;;;(bump "Fixing colors")
  214. (Command
  215. "_.chprop" SS-COLOR "" "_C" BCOLOR ""
  216. )
  217. )
  218. )
  219. (If (> (SsLength SS-LTYPE) 0)
  220. (Progn
  221. ;;;(bump "Fixing linetypes")
  222. (Command
  223. "_.chprop" SS-LTYPE "" "_LT" BLTYPE ""
  224. )
  225. )
  226. )
  227. (princ "返回长度:\n")
  228. (princ "\n")
  229. list_blocktext
  230. )
  231. ;-----------------------------------------------------
  232. ; BURST MAIN ROUTINE
  233. ;-----------------------------------------------------
  234. (Defun BURST11 (/ SS1)
  235. (setq list_blocktext1 nil)
  236. (setq list_lang 0.0)
  237. (setq qyg_lang_val 0.0)
  238. (setq PSFLAG (if (= 1 (caar (vports)))
  239. 1 0
  240. )
  241. )
  242. (Setq SS1 (SsGet (list (cons 0 "INSERT")(cons 67 PSFLAG))))
  243. (If SS1
  244. (Progn
  245. (Setvar "highlight" 0)
  246. (terpri)
  247. (Repeat
  248. (SsLength SS1)
  249. (Setq ENAME (SsName SS1 0))
  250. (SsDel ENAME SS1)
  251. (setq list_blocktext1 (BURST-ONE ENAME))
  252. (princ list_blocktext1)
  253. (princ "\n 长度:\n")
  254. (setq qyg_lang (assoc "长度" list_blocktext1))
  255. (setq qyg_lang_val (cdr qyg_lang))
  256. ;;;处理字符转换成双精度
  257. (setq qyg_lang_val (float (atoi qyg_lang_val)))
  258. (princ qyg_lang_val)
  259. (setq list_lang (+ list_lang qyg_lang_val))
  260. (princ "\n")
  261. )
  262. (princ "\n气源管总长度: ")
  263. (princ list_lang)
  264. (if (muttering)
  265. (princ "\n")
  266. )
  267. )
  268. )
  269. )
  270. ;-----------------------------------------------------
  271. ; BURST COMMAND
  272. ;-----------------------------------------------------
  273. (BURST11)
  274. ;;;(acet-error-restore)
  275. );end defun
  276. (princ "973490770@qq.com")
  277. (princ)
  278. ;;;(c:burst11)

声明:本文内容由网友自发贡献,不代表【wpsshop博客】立场,版权归原作者所有,本站不承担相应法律责任。如您发现有侵权的内容,请联系我们。转载请注明出处:https://www.wpsshop.cn/w/我家小花儿/article/detail/882332
推荐阅读
相关标签
  

闽ICP备14008679号