新开一贴，我的最终：炸属性快

尘缘一生

http://bbs.mjtd.com/thread-190689-1-1.html
上一贴太乱，各种解决办法，做一个最终用的吧，三领现在暂时用，不排除假以时日，还有更精炼的，那么为什么发这个问题呢？
因为三领在这个问题上，代码也换了7,8次了，各种不完美，当然，接到那份图之后呢，竟然炸开丢失，最大可能是我电脑
引起来这个问题，竟然有人说啊，这个问题我不懂！是吧？我只有送你两个字“呵呵”。
深入再一次研究一番，不用迷信洋鬼子，对于茹毛饮血的原始鬼子，你迷信它干什么？BURST吗，很早以前就用的是它，后来，又换了那段冗长的，这都不能解决彻底.....


今早晨哪，我又重新写代码，把这个问题，作一下子，各种代码看看，到底怎么回事！！
实际上，不用那么多的语句，冗长无比，

代码共55句，弄那么多长代码，还不解决问题，不能放之四海而皆准！如果不能，就干脆不作这个事，也绝不允许无效。
对于代码里面的函数，本坛基本都有，看字面模样就是了。

2. ;;炸属性块bnam----(一级)--------
   
3. ;(slblka2t (car (entsel)))
   
4. ;;Modify by  SLdesign V3.0  QQ:15290049 2024年7月9号
   
5. (defun slblka2t (bnam / e_lst e attnam atdef nam obj str p h ly lt col ly0 lt0 col0 ang ss ss-layer ss-color ss-ltype)
   
6.   (if (and (= (dxf1 bnam 0) "INSERT") (= (dxf1 bnam 66) 1) (setq obj (en2obj bnam)) (= (vla-get-hasattributes obj) :vlax-true))
   
7.     (progn
   
8.       (setq e_lst (sysvar '("QAFLAGS" "CMDECHO")))
   
9.       (setvar "CMDECHO" 0)
   
10.       (setvar "QAFLAGS" 0)
    
11.       (setq ly (dxf1 bnam 8) lt (sl-linetype bnam) col (sl-getcolor bnam))
    
12.       (setq attnam (entnext bnam) e (entlast))
    
13.       (while (= "ATTRIB" (dxf1 attnam 0))
    
14.         (setq p (e9pt attnam 5) str (dxf1 attnam 1) h (dxf1 attnam 40) ang (angle-sharp (dxf1 attnam 50)))
    
15.         (if (/= "STAR" (dxf1 attnam 2))
    
16.           (progn
    
17.             (slmkwz str p (/ h slbl) ang 0.7 (dxf1 attnam 8) $hz (sl-getcolor attnam) "m") ；写文字函数，居中
    
18.             (text:alignmod (entlast) "L")；文字变左定位系统
    
19.             (if (if-color) ；三领变色开关，总设置，注销即可
    
20.               (vla-put-color (en2obj (entlast)) (atoi (slsjqs)))
    
21.             )
    
22.           )
    
23.         )
    
24.         (setq attnam (entnext attnam))
    
25.       )
    
26.       (command "explode" bnam) ；对于炸开，原始这句最奏效，其余的集成还不如这句，虽然我最恶心COMMAND
    
27.       (setq ss-layer (ssadd) ss-color (ssadd) ss-ltype (ssadd) ss (last_ent e))
    
28.       (while (setq nam (ssname ss 0))
    
29.         (setq ly0 (dxf1 nam 8) col0 (dxf1 nam 62) lt0 (dxf1 nam 6))
    
30.         (if (= (dxf1 nam 0) "ATTDEF" )
    
31.           (sl-att-text nam) ;(entdel atdef) 此时此刻呢，还需要思量的
    
32.           (cond
    
33.             ((and (= ly0 "0")(/= ly0 ly))
    
34.               (ssadd nam ss-layer)
    
35.             )
    
36.             ((and (= col0 "0")(/= col0 col))
    
37.               (ssadd nam ss-color)
    
38.             )
    
39.             ((and (= lt0 "BYBLOCK") (/= lt0 lt))
    
40.               (ssadd nam ss-ltype)
    
41.             )
    
42.           )
    
43.         )
    
44.         (ssdel nam ss)
    
45.       )
    
46.       (if (> (sslength ss-layer) 0)
    
47.         (command  "_.chprop" ss-layer "" "_LA" ly "") ;改图层罢了，没想集成，实际都可以不这么用，但仅一句，省事。
    
48.       )
    
49.       (if (> (sslength ss-color) 0)
    
50.         (slchcol ss-color col) ；此处集成三领，选择集换颜色系统
    
51.       )
    
52.       (if (> (sslength ss-ltype) 0)
    
53.         (command "_.chprop" ss-ltype "" "_LT" lt "") ；改线型罢了，没想集成，实际都可以不这么用，但仅一句，省事。
    
54.       )
    
55.       (mapcar 'eval e_lst)
    
56.     )
    
57.   )
    
58.   (princ)
    
59. )

;;炸属性块bnam----(一级)--------<br /> ;(slblka2t (car (entsel)))<br /> ;;Modify by  SLdesign V3.0  QQ:15290049 2024年7月9号<br /> (defun slblka2t (bnam / e_lst e attnam atdef nam obj str p h ly lt col ly0 lt0 col0 ang ss ss-layer ss-color ss-ltype)<br />   (if (and (= (dxf1 bnam 0) "INSERT") (= (dxf1 bnam 66) 1) (setq obj (en2obj bnam)) (= (vla-get-hasattributes obj) :vlax-true))<br />     (progn<br />       (setq e_lst (sysvar '("QAFLAGS" "CMDECHO")))<br />       (setvar "CMDECHO" 0)<br />       (setvar "QAFLAGS" 0)<br />       (setq ly (dxf1 bnam 8) lt (sl-linetype bnam) col (sl-getcolor bnam))<br />       (setq attnam (entnext bnam) e (entlast))<br />       (while (= "ATTRIB" (dxf1 attnam 0))<br />         (setq p (e9pt attnam 5) str (dxf1 attnam 1) h (dxf1 attnam 40) ang (angle-sharp (dxf1 attnam 50)))<br />         (if (/= "STAR" (dxf1 attnam 2))<br />           (progn<br />             (slmkwz str p (/ h slbl) ang 0.7 (dxf1 attnam 8) $hz (sl-getcolor attnam) "m") ；写文字函数，居中<br />             (text:alignmod (entlast) "L")；文字变左定位系统<br />             (if (if-color) ；三领变色开关，总设置，注销即可<br />               (vla-put-color (en2obj (entlast)) (atoi (slsjqs)))<br />             )<br />           )<br />         )<br />         (setq attnam (entnext attnam))<br />       )<br />       (command "explode" bnam) ；对于炸开，原始这句最奏效，其余的集成还不如这句，虽然我最恶心COMMAND<br />       (setq ss-layer (ssadd) ss-color (ssadd) ss-ltype (ssadd) ss (last_ent e))<br />       (while (setq nam (ssname ss 0)) <br />         (setq ly0 (dxf1 nam 8) col0 (dxf1 nam 62) lt0 (dxf1 nam 6))<br />         (if (= (dxf1 nam 0) "ATTDEF" )<br />           (sl-att-text nam) ;(entdel atdef) 此时此刻呢，还需要思量的<br />           (cond<br />             ((and (= ly0 "0")(/= ly0 ly))<br />               (ssadd nam ss-layer)<br />             )<br />             ((and (= col0 "0")(/= col0 col))<br />               (ssadd nam ss-color)<br />             )<br />             ((and (= lt0 "BYBLOCK") (/= lt0 lt))<br />               (ssadd nam ss-ltype)<br />             )<br />           )<br />         )<br />         (ssdel nam ss)<br />       )<br />       (if (> (sslength ss-layer) 0)<br />         (command  "_.chprop" ss-layer "" "_LA" ly "") ;改图层罢了，没想集成，实际都可以不这么用，但仅一句，省事。<br />       )<br />       (if (> (sslength ss-color) 0)<br />         (slchcol ss-color col) ；此处集成三领，选择集换颜色系统<br />       )<br />       (if (> (sslength ss-ltype) 0)<br />         (command "_.chprop" ss-ltype "" "_LT" lt "") ；改线型罢了，没想集成，实际都可以不这么用，但仅一句，省事。<br />       )<br />       (mapcar 'eval e_lst)<br />     )<br />   )<br />   (princ)<br /> )

尘缘一生

moshouhot 发表于 2024-7-22 16:07
老哥，sl:list-substassoc函数能不能发一下？

;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元-----(一级)--------
;lstSub需要替换的列表   lstSource源列表   bAdd是否向源列表中追加 原本没有的元素
(defun sl:list-substassoc (lstSub        lstSource        bAdd / e e1)
        (foreach e lstSub
                (if (setq e1 (assoc (car e) lstSource))
                        (setq lstSource (subst e (assoc (car e) lstSource) lstSource))
                        (if bAdd (setq lstSource (append lstSource (list e))))
                )
        )
        lstSource
)

尘缘一生

kzd2004 发表于 2024-7-20 10:02
谢谢你了啊。

不客气，对于块来说呢，光炸这个功能，就是个很复杂的，因为很多情况。
要做到任何块，加密的也好，都万能炸开，本坛并没有谁给出集成源码，我发的也是一部分。
大致来说，有这么些方面。

尘缘一生

bai2000 发表于 2024-7-19 19:29
text:alignmod 是什么函数？

本坛有的，就是啊，原位改文字定位方式函数，因为三领是左定位系统，可以直接注销这一句。
对于文字定位方式：历史演变是这样的：最早啊，PKPM，就用的双穴点定位，那么中科院为什么这么用？哪当然好处是大大的好。可以作到系统对文字
准确定位，为什么后来左定位的多了？哪都因为天正的出现，中科院根本不在乎建筑界的发展的！所以才有了，当你打开别人的图纸，总说明部分，由于字库的不同，右侧总是参差不齐的毛病，没办法，这都是历史演变造成的。好在啊，这个问题早已不是个问题了。那么三领的开发呢，在前10年，是紧跟PKPM系统的。后来又出现了，装潢，室内....这些行业，更乱了。为了适应，才改为了全部左定位。

2. ;原位修改文字对齐方式---(一级)----
   
3. (defun text:alignmod (nam mode / p10 p11 ent box b ang)
   
4.   (setq ent (entget nam) p10 (dxf1 ent 10) b (cadr (textbox ent)) ang (dxf1 ent 50))
   
5.   (setq ent
   
6.     (entmod
   
7.       (cond
   
8.         ((= (strcase mode) "L") ;左对齐
   
9.           (sl:list-substassoc (list (cons 10 p10) '(72 . 0) '(73 . 0)) ent t)
   
10.         )
    
11.         ((= (strcase mode) "C") ;中对齐
    
12.           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 0)) ent t)
    
13.         )
    
14.         ((= (strcase mode) "R") ;右对齐
    
15.           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 0)) ent t)
    
16.         )
    
17.         ((= (strcase mode) "M") ;中心对齐
    
18.           (sl:list-substassoc (list (cons 11 p10) '(72 . 4) '(73 . 0)) ent t)
    
19.         )
    
20.         ((= (strcase mode) "A") ;对齐
    
21.           (setq p11 (polar p10 ang (car b)))
    
22.           (sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 3) '(73 . 0)) ent t)
    
23.         )
    
24.         ((= (strcase mode) "F") ;调整
    
25.           (setq p11 (polar p10 ang (car b)))
    
26.           (sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 5) '(73 . 0)) ent t)
    
27.         )
    
28.         ((= (strcase mode) "BL") ;左下
    
29.           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 1)) ent t)
    
30.         )
    
31.         ((= (strcase mode) "BC") ;中下
    
32.           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 1)) ent t)
    
33.         )
    
34.         ((= (strcase mode) "BR") ;右下
    
35.           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 1)) ent t)
    
36.         )
    
37.         ((= (strcase mode) "ML") ;左中
    
38.           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 2)) ent t)
    
39.         )
    
40.         ((= (strcase mode) "MC") ;正中
    
41.           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 2)) ent t)
    
42.         )
    
43.         ((= (strcase mode) "MR") ;右中
    
44.           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 2)) ent t)
    
45.         )
    
46.         ((= (strcase mode) "tL") ;左上
    
47.           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 3)) ent t)
    
48.         )
    
49.         ((= (strcase mode) "tC") ;中上
    
50.           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 3)) ent t)
    
51.         )
    
52.         ((= (strcase mode) "tR") ;右上
    
53.           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 3)) ent t)
    
54.         )
    
55.         (t ent)
    
56.       )
    
57.     )
    
58.   )
    
59.   (setq ent (entget (dxf1 ent -1)))
    
60.   (setq p11 (mapcar '+ (mapcar '- p10 (dxf1 ent 10)) (dxf1 ent 11)))
    
61.   (entmod (sl:list-substassoc (list (cons 10 p10) (cons 11 p11)) ent t))
    
62. )

;原位修改文字对齐方式---(一级)----<br /> (defun text:alignmod (nam mode / p10 p11 ent box b ang)<br />   (setq ent (entget nam) p10 (dxf1 ent 10) b (cadr (textbox ent)) ang (dxf1 ent 50))<br />   (setq ent<br />     (entmod<br />       (cond<br />         ((= (strcase mode) "L") ;左对齐<br />           (sl:list-substassoc (list (cons 10 p10) '(72 . 0) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "C") ;中对齐<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "R") ;右对齐<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "M") ;中心对齐<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 4) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "A") ;对齐<br />           (setq p11 (polar p10 ang (car b)))<br />           (sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 3) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "F") ;调整<br />           (setq p11 (polar p10 ang (car b)))<br />           (sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 5) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "BL") ;左下<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 1)) ent t)<br />         )<br />         ((= (strcase mode) "BC") ;中下<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 1)) ent t)<br />         )<br />         ((= (strcase mode) "BR") ;右下<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 1)) ent t)<br />         )<br />         ((= (strcase mode) "ML") ;左中<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 2)) ent t)<br />         )<br />         ((= (strcase mode) "MC") ;正中<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 2)) ent t)<br />         )<br />         ((= (strcase mode) "MR") ;右中<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 2)) ent t)<br />         )<br />         ((= (strcase mode) "tL") ;左上<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 3)) ent t)<br />         )<br />         ((= (strcase mode) "tC") ;中上<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 3)) ent t)<br />         )<br />         ((= (strcase mode) "tR") ;右上<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 3)) ent t)<br />         )<br />         (t ent)<br />       )<br />     )<br />   )<br />   (setq ent (entget (dxf1 ent -1)))<br />   (setq p11 (mapcar '+ (mapcar '- p10 (dxf1 ent 10)) (dxf1 ent 11)))<br />   (entmod (sl:list-substassoc (list (cons 10 p10) (cons 11 p11)) ent t))<br /> )

cchessbd

不管怎么说，谢谢大佬分享了这么多代码！
目前我用的是LeeMac的炸块代码，还没遇到不能炸开的。
当然我图里面的块不多，也许没遇到过那么多问题过。

bai2000

text:alignmod 是什么函数？

muai2010

啥也不说，支持大佬

gble119

感谢大佬 支持

_admin

感谢大佬，无私奉献

paulpipi

感谢无私分享，支持大佬

hubeiwdlue

支持陈总，支持陈总

MZ_li

大佬无私！大佬牛逼！