如何按文本内容填充相应图块!

aihuyujian

(setq p1 (cdr (assoc 10 ent)))

aihuyujian

晕，中心点貌似还得判断文字最小包围盒一下吧……

edata

2. (defun sk_getbox1(ent / ll ur)
   
3.   (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
   
4.   (mapcar 'set '(ll ur)(mapcar 'vlax-safearray->list (list ll ur)))
   
5.   (mapcar '(lambda(x y)(*(+ x y) 0.5)) ll ur)
   
6.   )
   
7. (defun c:KK ()   
   
8.   (setvar "cmdecho" 0)  ;指令執行過程不響應
   
9.   (princ "\n圖面文字插入圖塊")
   
10.   (while (and (setq s1 (entsel "\n选择文字:"))
    
11.          (setq  ent (entget(car s1)))
    
12.          (= (cdr(assoc 0 ent)) "TEXT"))
    
13.    (setq fnm (strcat "D:/AA/" (cdr(assoc 1 ent)) ".DWG"))   
    
14.    (if (and (findfile fnm) (setq p1 (sk_getbox1 (car s1))))
    
15.     (command "-insert" fnm "non" p1 "" "" "")
    
16.      (princ "not find file!")
    
17.    )
    
18.   )
    
19.   (princ)
    
20. )

(defun sk_getbox1(ent / ll ur)<br />   (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)<br />   (mapcar 'set '(ll ur)(mapcar 'vlax-safearray->list (list ll ur)))<br />   (mapcar '(lambda(x y)(*(+ x y) 0.5)) ll ur)<br />   )<br /> (defun c:KK ()   <br />   (setvar "cmdecho" 0)  ;指令執行過程不響應<br />   (princ "\n圖面文字插入圖塊")<br />   (while (and (setq s1 (entsel "\n选择文字:"))<br />          (setq  ent (entget(car s1)))<br />          (= (cdr(assoc 0 ent)) "TEXT"))<br />    (setq fnm (strcat "D:/AA/" (cdr(assoc 1 ent)) ".DWG"))   <br />    (if (and (findfile fnm) (setq p1 (sk_getbox1 (car s1))))<br />     (command "-insert" fnm "non" p1 "" "" "")<br />      (princ "not find file!")<br />    )<br />   )<br />   (princ)<br /> )