插入图块--探讨

尘缘一生

1. 
   

复制代码

看到一些插入图块的代码，我组织一下子，说实话，有的地方，我还拿不准。在晓东哪边，看到黄大师部分代码而来。
关于炸开不炸开，还有动态块就不炸开等等，我认为也应该代码里面智能做了它。
人为再干预是炸还是不炸，能省去即该省去。当然，以下代码只是插入罢了。

比如：做图库插入部分吧，如果插入的是动态块，属性块，程序应该智能不炸，其他，可以弹出个人为干预，炸OR NO。

2. ;;插入图块----(一级)-----
   
3. ;;Modify by SLdesign V3.0  尘缘一生   QQ:15290049
   
4. (defun vla-ins-b (bname pt xscale yscale zscale rot / e en p10 str)
   
5.   (defun vla-ins-b1 (bname pt xscale yscale zscale rot / mspace)
   
6.     (if (= (getvar "CTAB") "Model") (setq mspace *Model-Space*) (setq mspace *Paper-Space*))
   
7.     (vla-InsertBlock mspace (vlax-3d-point pt) bname xscale yscale zscale rot)
   
8.   )
   
9.   ;;-----------------
   
10.   (defun mkattrib (pt str h)
    
11.     (entmake
    
12.       (list
    
13.         '(0 . "ATTRIB")
    
14.         '(100 . "AcDbEntity")
    
15.         '(100 . "AcDbText")
    
16.         (cons 10 pt)
    
17.         (cons 40 h)
    
18.         (cons 1 str)
    
19.         '(100 . "AcDbAttribute")
    
20.         (cons 2 str)
    
21.         '(70 . 0)
    
22.       )
    
23.     )   
    
24.   )
    
25.   ;;-----------------
    
26.   (setq pt (trans pt 1 0)) ;若此句不要，会如何不好呢？
    
27.   (if (setq e (tblobjname "Block" bname))
    
28.     (cond   
    
29.       ((equal (assoc 70 (entget e)) '(70 . 0))
    
30.         (entmake (list '(0 . "INSERT") (cons 2 bname) (cons 10 pt) (cons 10 pt) (cons 41 xscale) (cons 42 yscale) (cons 43 zscale) (cons 50 rot)))
    
31.       )
    
32.       (T
    
33.         (entmake (list '(0 . "INSERT") '(66 . 1) (cons 2 bname) (cons 10 pt) (cons 41 xscale) (cons 42 yscale) (cons 43 zscale) (cons 50 rot)))
    
34.         (while (setq e (entnext e))
    
35.           (setq en (entget e))
    
36.           (cond
    
37.             ((equal (assoc 0 en) '(0 . "ATTDEF"))  
    
38.               (setq p10 (mapcar '+ pt (cdr (assoc 10 en))))
    
39.               (setq str (cdr (assoc 1 en)))  
    
40.               (mkattrib p10 str (cdr (assoc 40 en)))
    
41.             )
    
42.           )
    
43.         )
    
44.         (entmake '((0 . "SEQEND")))
    
45.       )
    
46.     )
    
47.     (vla-ins-b1 bname pt xscale yscale zscale rot)
    
48.   )
    
49.   (entlast)
    
50. )

;;插入图块----(一级)-----<br /> ;;Modify by SLdesign V3.0  尘缘一生   QQ:15290049<br /> (defun vla-ins-b (bname pt xscale yscale zscale rot / e en p10 str)<br />   (defun vla-ins-b1 (bname pt xscale yscale zscale rot / mspace)<br />     (if (= (getvar "CTAB") "Model") (setq mspace *Model-Space*) (setq mspace *Paper-Space*))<br />     (vla-InsertBlock mspace (vlax-3d-point pt) bname xscale yscale zscale rot)<br />   )<br />   ;;-----------------<br />   (defun mkattrib (pt str h)<br />     (entmake <br />       (list<br />         '(0 . "ATTRIB")<br />         '(100 . "AcDbEntity")<br />         '(100 . "AcDbText")<br />         (cons 10 pt)<br />         (cons 40 h)<br />         (cons 1 str)<br />         '(100 . "AcDbAttribute")<br />         (cons 2 str)<br />         '(70 . 0)<br />       )<br />     )   <br />   )<br />   ;;-----------------<br />   (setq pt (trans pt 1 0)) ;若此句不要，会如何不好呢？<br />   (if (setq e (tblobjname "Block" bname))<br />     (cond   <br />       ((equal (assoc 70 (entget e)) '(70 . 0))<br />         (entmake (list '(0 . "INSERT") (cons 2 bname) (cons 10 pt) (cons 10 pt) (cons 41 xscale) (cons 42 yscale) (cons 43 zscale) (cons 50 rot)))<br />       )<br />       (T<br />         (entmake (list '(0 . "INSERT") '(66 . 1) (cons 2 bname) (cons 10 pt) (cons 41 xscale) (cons 42 yscale) (cons 43 zscale) (cons 50 rot)))<br />         (while (setq e (entnext e))<br />           (setq en (entget e))<br />           (cond <br />             ((equal (assoc 0 en) '(0 . "ATTDEF"))  <br />               (setq p10 (mapcar '+ pt (cdr (assoc 10 en))))<br />               (setq str (cdr (assoc 1 en)))  <br />               (mkattrib p10 str (cdr (assoc 40 en)))<br />             )<br />           )<br />         )<br />         (entmake '((0 . "SEQEND")))<br />       )<br />     )<br />     (vla-ins-b1 bname pt xscale yscale zscale rot)<br />   )<br />   (entlast)<br /> )

bai2000

支持一下老陈。。。。。

尘缘一生

再次斟酌

2. ;;插入图块----(一级)-----
   
3. ;;Modify by SLdesign V3.0  尘缘一生   QQ:15290049
   
4. ;;(vla-ins-b "\\ XYZ\\kuai.dwg" '(0 0 0) 1 1 1 0)
   
5. (defun vla-ins-b (bname pt xscale yscale zscale rot / e en p0 mspace nam)
   
6.   (defun vla-ins-b1 (bname pt xscale yscale zscale rot)
   
7.     (if (= (getvar "CTAB") "Model") (setq mspace *Model-Space*) (setq mspace *Paper-Space*))
   
8.     (vla-InsertBlock mspace (vlax-3d-point pt) bname xscale yscale zscale rot)
   
9.   )
   
10.   ;;-----------------
    
11.   (defun mkattrib (pt str h)
    
12.     (entmake
    
13.       (list
    
14.         '(0 . "ATTRIB")
    
15.         '(100 . "AcDbEntity")
    
16.         '(100 . "AcDbText")
    
17.         (cons 10 pt)
    
18.         (cons 40 h)
    
19.         (cons 1 str)
    
20.         '(100 . "AcDbAttribute")
    
21.         (cons 2 str)
    
22.         '(70 . 0)
    
23.       )
    
24.     )   
    
25.   )
    
26.   ;;----------------
    
27.   (setq pt (trans pt 1 0) nam (vl-filename-base bname))
    
28.   (if (setq e (tblobjname "Block" nam)) ;如果图中已存在改名字图块
    
29.     (if (/= (dxf1 e 66) 1)  
    
30.       (entmake (list '(0 . "INSERT") (cons 2 nam) (cons 10 pt) (cons 41 xscale) (cons 42 yscale) (cons 43 zscale) (cons 50 rot)))
    
31.       ;;;(vla-ins-b1 nam pt xscale yscale zscale rot)
    
32.       (progn
    
33.         (entmake (list '(0 . "INSERT") '(66 . 1) (cons 2 nam) (cons 10 pt) (cons 41 xscale) (cons 42 yscale) (cons 43 zscale) (cons 50 rot)))
    
34.         (while (setq e (entnext e))
    
35.           (setq en (entget e))
    
36.           (cond
    
37.             ((equal (assoc 0 en) '(0 . "ATTDEF"))  
    
38.               (setq p0 (mapcar '+ pt (cdr (assoc 10 en))))
    
39.               (mkattrib p0 (cdr (assoc 1 en)) (cdr (assoc 40 en)))
    
40.             )
    
41.           )
    
42.         )
    
43.         (entmake '((0 . "SEQEND")))
    
44.       )
    
45.     )
    
46.     (vla-ins-b1 bname pt xscale yscale zscale rot)
    
47.   )
    
48. )

;;插入图块----(一级)-----<br /> ;;Modify by SLdesign V3.0  尘缘一生   QQ:15290049<br /> ;;(vla-ins-b "\\ XYZ\\kuai.dwg" '(0 0 0) 1 1 1 0)<br /> (defun vla-ins-b (bname pt xscale yscale zscale rot / e en p0 mspace nam)<br />   (defun vla-ins-b1 (bname pt xscale yscale zscale rot)<br />     (if (= (getvar "CTAB") "Model") (setq mspace *Model-Space*) (setq mspace *Paper-Space*))<br />     (vla-InsertBlock mspace (vlax-3d-point pt) bname xscale yscale zscale rot)<br />   )<br />   ;;-----------------<br />   (defun mkattrib (pt str h)<br />     (entmake <br />       (list<br />         '(0 . "ATTRIB")<br />         '(100 . "AcDbEntity")<br />         '(100 . "AcDbText")<br />         (cons 10 pt)<br />         (cons 40 h)<br />         (cons 1 str)<br />         '(100 . "AcDbAttribute")<br />         (cons 2 str)<br />         '(70 . 0)<br />       )<br />     )   <br />   )<br />   ;;----------------<br />   (setq pt (trans pt 1 0) nam (vl-filename-base bname))<br />   (if (setq e (tblobjname "Block" nam)) ;如果图中已存在改名字图块<br />     (if (/= (dxf1 e 66) 1)  <br />       (entmake (list '(0 . "INSERT") (cons 2 nam) (cons 10 pt) (cons 41 xscale) (cons 42 yscale) (cons 43 zscale) (cons 50 rot)))<br />       ;;;(vla-ins-b1 nam pt xscale yscale zscale rot)<br />       (progn<br />         (entmake (list '(0 . "INSERT") '(66 . 1) (cons 2 nam) (cons 10 pt) (cons 41 xscale) (cons 42 yscale) (cons 43 zscale) (cons 50 rot)))<br />         (while (setq e (entnext e))<br />           (setq en (entget e))<br />           (cond <br />             ((equal (assoc 0 en) '(0 . "ATTDEF"))  <br />               (setq p0 (mapcar '+ pt (cdr (assoc 10 en))))<br />               (mkattrib p0 (cdr (assoc 1 en)) (cdr (assoc 40 en)))<br />             )<br />           )<br />         )<br />         (entmake '((0 . "SEQEND")))<br />       )<br />     )<br />     (vla-ins-b1 bname pt xscale yscale zscale rot)<br />   )<br /> )