图块合并

bikeboy

将两个不同的块，合并成另外一个新块，合并完成后删除原来两个块，请各位大侠提供一下思路。多谢。

newer

两种方法
1、建立标记，炸开两个块，获得标记后新生成的所有实体到选择集，然后把这个选集建立一个块。你可以用COMMAND
2、直接点，将两个BLOCK内的实体原位拷贝份，然后把拷贝添加到另外一个新快的内部。

csharp

只炸开一次，使用 ssget p 即可获取炸开后的所有实体

Lispboy

用下 晓东通用LISP函数库，试下下面代码

1. (defun c:tt()
   
2.    (if (and (setq e1 (car (xdrx_entsel "\n第一个块<退出>:" '((0 . "insert")))))
   
3.             (setq e2 (car (xdrx_entsel "\n第二个块<退出>:" '((0 . "insert")))))
   
4.        )
   
5.      (progn
   
6.         (setq pj (xd::geom:get9pt (list e1 e2) 5)   ;;两INSERT包围盒中心点做合并块的插入点
   
7.               ss (xdrx_entity_explode (list e1 e2))   ;;炸开获得选集                        
   
8.         )
   
9.         (xdrx_block_make ss pj t)              ;;合并成无名块
   
10.      )
    
11.   )
    
12.   (princ)
    
13. )
    

(defun c:tt()<br />    (if (and (setq e1 (car (xdrx_entsel "\n第一个块<退出>:" '((0 . "insert")))))<br />             (setq e2 (car (xdrx_entsel "\n第二个块<退出>:" '((0 . "insert")))))<br />        )<br />      (progn<br />         (setq pj (xd::geom:get9pt (list e1 e2) 5)   ;;两INSERT包围盒中心点做合并块的插入点<br />               ss (xdrx_entity_explode (list e1 e2))   ;;炸开获得选集                         <br />         )<br />         (xdrx_block_make ss pj t)              ;;合并成无名块<br />      )<br />   )<br />   (princ)<br /> )<br />

iLisp

command 方法

2. 
   
3. (defun c:tt (/ e1 e2 ss bn)
   
4.   (if (and (setq ss (ssget '((0 . "insert"))))
   
5.            (= (sslength ss) 2)
   
6.            (setq e1 (ssname ss 0))
   
7.            (setq e2 (ssname ss 1))
   
8.            (/= (cdr (assoc 2 (entget e1)))
   
9.                (cdr (assoc 2 (entget e2)))
   
10.            )
    
11.            (setq bn (getstring "\nBlock Name: "))
    
12.            (not (tblsearch "block" bn))
    
13.       )
    
14.     (progn
    
15.       (setvar "qaflags" 1)
    
16.       (vl-cmdf ".explode" ss "")
    
17.       (command "-block" bn (getvar "viewctr") (ssget "p") "")
    
18.       (command ".-insert" bn (getvar "viewctr") 1.0 1.0 0.0)
    
19.     )
    
20.   )
    
21.   (princ)
    
22. )

<br /> (defun c:tt (/ e1 e2 ss bn)<br />   (if (and (setq ss (ssget '((0 . "insert"))))<br />            (= (sslength ss) 2)<br />            (setq e1 (ssname ss 0))<br />            (setq e2 (ssname ss 1))<br />            (/= (cdr (assoc 2 (entget e1)))<br />                (cdr (assoc 2 (entget e2)))<br />            )<br />            (setq bn (getstring "\nBlock Name: "))<br />            (not (tblsearch "block" bn))<br />       )<br />     (progn<br />       (setvar "qaflags" 1)<br />       (vl-cmdf ".explode" ss "")<br />       (command "-block" bn (getvar "viewctr") (ssget "p") "")<br />       (command ".-insert" bn (getvar "viewctr") 1.0 1.0 0.0)<br />     )<br />   )<br />   (princ)<br /> )

/db_自贡黄明儒_

为什么要炸开?

Lispboy

/db_自贡黄明儒_ 发表于 2016-7-18 23:07
为什么要炸开?

楼主的意思好像是炸开后合并。

bikeboy

Lispboy 发表于 2016-7-19 00:24
楼主的意思好像是炸开后合并。

感谢各位老大的指导，主要目的是根据别人写的图框程序，做了些修改，想要的结果是根据老大的思路想最终做成一个带属性的块。目前出来的是几个单独的东西，因此需要修改修改。

bikeboy

/db_自贡黄明儒_ 发表于 2016-7-18 23:07
为什么要炸开?

不炸开的话怎么处理？求指导。

iLisp

适合 等比，旋转为 0 的两个块，其它情况需要再处理

2. 
   
3. (defun c:tt (/ e1 e2 lst1 ls2 ms blks bn1 bn2 el bn p2 p1 v)
   
4.   (if (and (setq e1 (car (entsel "\n选择图块1: ")))
   
5.            (= (cdr (assoc 0 (setq lst1 (entget e1)))) "INSERT")
   
6.            (setq e2 (car (entsel "\n选择图块1: ")))
   
7.            (= (cdr (assoc 0 (setq lst2 (entget e2)))) "INSERT")
   
8.       )
   
9.     (progn
   
10.       (setq ms         (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
    
11.             blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    
12.       )
    
13.       (setq bn1        (cdr (assoc 2 lst1))
    
14.             bn2        (cdr (assoc 2 lst2))
    
15.             p1        (cdr (assoc 10 lst1))
    
16.             p2        (cdr (assoc 10 lst2))
    
17.             v        (mapcar '- p2 p1)
    
18.       )
    
19.       (setq bn (vla-add blks (vlax-3d-point '(0 0 0)) "*U"))
    
20.       (vlax-for        obj (vla-item blks bn1)
    
21.         (setq el (cons obj el))
    
22.       )
    
23.       (vla-copyobjects
    
24.         (vla-get-activedocument (vlax-get-acad-object))
    
25.         (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length el)))) el)
    
26.         bn
    
27.       )
    
28.       (setq el nil)
    
29.       (vlax-for        obj (vla-item blks bn2)
    
30.         (setq el (cons obj el))
    
31.       )
    
32.       (foreach obj (safearray-value
    
33.                      (variant-value
    
34.                        (vla-copyobjects
    
35.                          (vla-get-activedocument (vlax-get-acad-object))
    
36.                          (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length el)))) el)
    
37.                          bn
    
38.                        )
    
39.                      )
    
40.                    )
    
41.         (vla-move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point v))
    
42.       )
    
43.       (entdel e1)
    
44.       (entdel e2)
    
45.       (vla-insertblock
    
46.         ms
    
47.         (vlax-3d-point p1)
    
48.         (vla-get-name bn)
    
49.         (cdr (assoc 41 lst1))
    
50.         (cdr (assoc 42 lst1))
    
51.         (cdr (assoc 43 lst1))
    
52.         (cdr (assoc 50 lst1))
    
53.       )
    
54.     )
    
55.   )
    
56.   (princ)
    
57. )

<br /> (defun c:tt (/ e1 e2 lst1 ls2 ms blks bn1 bn2 el bn p2 p1 v)<br />   (if (and (setq e1 (car (entsel "\n选择图块1: ")))<br />            (= (cdr (assoc 0 (setq lst1 (entget e1)))) "INSERT")<br />            (setq e2 (car (entsel "\n选择图块1: ")))<br />            (= (cdr (assoc 0 (setq lst2 (entget e2)))) "INSERT")<br />       )<br />     (progn<br />       (setq ms         (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))<br />             blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))<br />       )<br />       (setq bn1        (cdr (assoc 2 lst1))<br />             bn2        (cdr (assoc 2 lst2))<br />             p1        (cdr (assoc 10 lst1))<br />             p2        (cdr (assoc 10 lst2))<br />             v        (mapcar '- p2 p1)<br />       )<br />       (setq bn (vla-add blks (vlax-3d-point '(0 0 0)) "*U"))<br />       (vlax-for        obj (vla-item blks bn1)<br />         (setq el (cons obj el))<br />       )<br />       (vla-copyobjects<br />         (vla-get-activedocument (vlax-get-acad-object))<br />         (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length el)))) el)<br />         bn<br />       )<br />       (setq el nil)<br />       (vlax-for        obj (vla-item blks bn2)<br />         (setq el (cons obj el))<br />       )<br />       (foreach obj (safearray-value<br />                      (variant-value<br />                        (vla-copyobjects<br />                          (vla-get-activedocument (vlax-get-acad-object))<br />                          (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length el)))) el)<br />                          bn<br />                        )<br />                      )<br />                    )<br />         (vla-move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point v))<br />       )<br />       (entdel e1)<br />       (entdel e2)<br />       (vla-insertblock<br />         ms<br />         (vlax-3d-point p1)<br />         (vla-get-name bn)<br />         (cdr (assoc 41 lst1))<br />         (cdr (assoc 42 lst1))<br />         (cdr (assoc 43 lst1))<br />         (cdr (assoc 50 lst1))<br />       )<br />     )<br />   )<br />   (princ)<br /> )

/db_自贡黄明儒_

iLisp 发表于 2016-7-20 10:04
适合 等比，旋转为 0 的两个块，其它情况需要再处理

要取一个英霸一点的名字呀，比如小张同小英结婚，生了一个儿子，就取名张英龙

iLisp

/db_自贡黄明儒_ 发表于 2016-7-20 10:30
要取一个英霸一点的名字呀，比如小张同小英结婚，生了一个儿子，就取名张英龙

(setq bn (vla-add blks (vlax-3d-point '(0 0 0)) "*U")) => (setq bn (vla-add blks (vlax-3d-point '(0 0 0)) "张英龙"))

Acad 里面 张英龙 不允许重名啊！ (tblsearc "block" "张英龙")

bikeboy

进行了相应修改，提示参数类型错误，什么情况？dcl文件及图块见楼上

2. (defun title0 (/ p_a p_c viewcp x1 y1 pc p_a1 pn1 what_next n_list m_list di sal sl a0_list a1_list a2_list a3_list a4_list f0_list f1_list f2_list f3_list sl_list d_list ss_in handle_list sl_sel pop1_in p_list edit_in check_in defaults show_list set_status do_frame)
   
3.         (if title_data
   
4.         (mapcar 'set '(ver_hor sz lb1 lb2 Long Width sal di sl) title_data)
   
5.         (setq ver_hor nil sz 1 lb1 T lb2 T Long 841 Width 594 sal 100 di 0 sl 6)
   
6.         ) ;end if
   
7. ;(setvar "CMDECHO" 0)
   
8.     (setq
   
9.         ;lb3       (= 0 (getvar "tilemode"))
   
10.         ;标准图幅尺寸
    
11.         p_list'((841 1189)(594 841)(420 594)(297 420)(210 297))
    
12.         ;加长尺寸列表
    
13.         a0_list '(1189 1338 1487 1635 1784 1932 2081 2230 2387)
    
14.         a1_list '(841 1051 1261 1472 1682 1892 2102)
    
15.         a2_list '(594 743 892 1041 1189 1338 1487 1635 1784 1932 2081)
    
16.         a3_list '(420 631 841 1051 1261 1472 1682 1892)
    
17.         a4_list '(297 445 594)
    
18.         ;加长几分之几
    
19.         f0_list '("1/8""1/4""3/8""1/2""5/8""3/4""7/8""1")
    
20.         f1_list '("1/4""1/2""3/4""1""5/4""3/2")
    
21.         f2_list '("1/4""1/2""3/4""1""5/4""3/2""7/4""2""9/4""9/2")
    
22.         f3_list '("1/2""1""3/2""2""5/2""3""7/2")
    
23.         f4_list '("1/2""1")
    
24.         ;比例列表
    
25.         sl_list '(1000 500 300 250 200 150 100 50 30 25 20 10 5)
    
26.         )
    
27. 
    
28. ;(defun check_in(input format kk /)
    
29. ;        (if(and (distof input 2) (>(atof input)0) )
    
30. ;        (progn(rs_error)input)
    
31. ;        (progn
    
32. ;        (set_tile "error" (strcat"无效的"format"输入"))
    
33. ;        (mode_tile kk 2)
    
34. ;        nil);end progn
    
35. ;        );end if
    
36. ;);end defun
    
37.         
    
38. (defun handle_list(/ d0 ln)
    
39.         (cond
    
40.                 ((= sz 0)(setq ln 8 n_list f0_list m_list a0_list))
    
41.                 ((= sz 1)(setq ln 6 n_list f1_list m_list a1_list))
    
42.                 ((= sz 2)(setq ln 10 n_list f2_list m_list a2_list))
    
43.                 ((= sz 3)(setq ln 7 n_list f3_list m_list a3_list))
    
44.                 (T(setq ln 2 n_list f4_list m_list a4_list))
    
45.        );end cond
    
46.       ln;调用函数赋值。
    
47. )
    
48. 
    
49. (defun set_status()
    
50.         (set_tile "size_sel" (strcat"A"(itoa sz)))        ;1 size_sel标准图幅 itoa 转化字符串
    
51.        (set_tile "title"   (if lb1 "1""0"))                ;3 title    会签栏
    
52.         (set_tile "inside"   (if lb2 "1""0"))                ;2 inside    图标
    
53.         (set_tile "type_sel" (if ver_hor "ver""hor"))        ;4 type_sel格式(立式,横式)
    
54.         (set_tile "his"      (if lb3 "1""0"))                ;5 his       图纸空间、模型空间
    
55.         (set_tile "l_size"   (itoa Long))                ;6 l_size    图纸长度
    
56.         (set_tile "w_size"   (itoa Width))                ;7 w_size    图纸宽度
    
57.         (set_tile "dim_list" (itoa di))                        ;8 dim_list加长S
    
58.         (set_tile "scal"   (itoa sal))                ;9 scal      比例
    
59.         (set_tile "scal_list"(itoa sl))                        ;0 scal_list 比例列表
    
60. );end defun
    
61. 
    
62. (defun defaults(/ d0 d2 d3 i)
    
63.         (set_status)
    
64.         (setq
    
65.                 d3(handle_list)
    
66.                 d0(strcat"A"(itoa sz))
    
67.                 d_list(list d0)
    
68.                 i 0
    
69.                 )               
    
70.         (repeat d3
    
71.                 (setq
    
72.                         d2 (nth i n_list) ;nth 此函数将返回n_list中的第i个元素,第一个元素由零开始的
    
73.                         i(1+ i)
    
74.                         d_list (if(= i 0) d_list(append d_list(list(strcat d0"+"d2))))
    
75.                 );end setq
    
76.         );end repeat
    
77.         ;d_list = (A1 A1+1/4 A1+1/2 A1+3/4 A1+1 A1+5/4 A1+3/2)
    
78.         
    
79.         ;(show_list "dim_list" d_list)                ;取消没影响....        
    
80.         (set_tile "dim_list" "0")
    
81.         (do_frame)
    
82. );end defun
    
83. (defun show_list(k1 l1)
    
84.         (start_list k1)
    
85.         (mapcar ' add_list l1)
    
86.         (end_list)
    
87.         )
    
88.         
    
89. (defun do_frame()
    
90.         (setq         p1 '(0 0)
    
91.                 ;p_a 25
    
92.                 p_c '(10 5)
    
93.                 viewcp (getvar"viewctr");viewctr 存储当前视口中视图的中心点。该值用 UCS 坐标表示。
    
94.                 pc (if(< sz 3)(car p_c)(cadr p_c))
    
95.                 x1 (*(float Width)sal)
    
96.                 y1 (*(float Long)sal)
    
97.                 pc (*(float pc)sal)
    
98.                 ins_scl sal
    
99.                 p_a1 (* 25 sal)
    
100.                 ;p_a1 (*(float p_a)sal)
     
101.                 )
     
102.         ;(setvar"tilemode"(if lb3 0 1));tilemode 将“模型”选项卡或最后一个布局选项卡置为当前。
     
103. (if ver_hor
     
104.         (progn ;progn--aa
     
105.                 (setq p2 (list 0 y1) p3(list x1 y1) p4(list x1 0))
     
106.                 (if(/= sz 4)
     
107.                         (setq         pn1(list pc pc)
     
108.                                 pn2(list(- x1 pc)pc)
     
109.                                 pn3(list(- x1 pc)(- y1 p_a1))
     
110.                                 pn4(list pc(- y1 p_a1))
     
111.                                 )
     
112.         
     
113.                         (setq         pn1(list p_a1 pc)
     
114.                                 pn2(list(- x1 pc)pc)
     
115.                                 pn3(list(- x1 pc)(- y1 pc))
     
116.                                 pn4(list p_a1(- y1 pc))
     
117.                                 )
     
118.                 );end if
     
119.         );end progn--aa
     
120.         (setq         p2(list 0 x1)
     
121.                 p3(list y1 x1)
     
122.                 p4(list y1 0)
     
123.                 pn1(list p_a1 pc)
     
124.                 pn2(list(- y1 pc)pc)
     
125.                 pn3(list(- y1 pc)(- x1 pc))
     
126.                 pn4(list p_a1(- x1 pc))
     
127.                 )
     
128. );end if
     
129.                
     
130.         ;(setq plist(list nil p1 p2 p2 p3 p3 p4 p4 p1 pn1 pn2 pn2 pn3 pn3 pn4 pn4 pn1))
     
131.         ;(start_image"show_ig")
     
132.         ;(fill_image 0 0 winx winy -2)
     
133.         ;(foreach sublt(apply 'getpfxl plist)(apply 'vector_image sublt)) ;;getpfxl未定义        
     
134.         ;(end_image)
     
135. );end defun
     
136. 
     
137. (defun ss_in(/ d1 d2 d3 i)
     
138.         (setq sz(atoi(substr $value 2 1))
     
139.               d0(nth sz p_list)
     
140.               Width(car d0)
     
141.               Long(cadr d0)
     
142.               d_list(list $value)
     
143.               i 0
     
144.               d3(handle_list)
     
145.               )
     
146.         (repeat d3
     
147.                 (setq         d2(nth i n_list)
     
148.                         i(1+ i)
     
149.                         d_list (if(= i 0) d_list (append d_list(list(strcat $value"+"d2))))
     
150.                 )
     
151.         );end repeat
     
152. (show_list "dim_list" d_list)
     
153. (set_tile "dim_list" "0")
     
154. (set_tile "w_size" (itoa Width))
     
155. (set_tile "l_size" (itoa Long))
     
156. (do_frame)
     
157. )
     
158. 
     
159. (defun edit_in(n val / ppt k1)
     
160.         (cond
     
161.                 ((= n 1)(setq ppt"图长"k1"l_size"))
     
162.                 ((= n 2)(setq ppt"图宽"k1"w_size"))
     
163.                 ((= n 3)(setq ppt"比例"k1"scal"))
     
164.         )
     
165. (if T;(check_in val ppt k1)
     
166.         (cond        ((= n 1)(setq long (atoi val)))
     
167.                 ((= n 2)(setq width (atoi val)))
     
168.                 ((= n 3)(setq sal (atoi val)))
     
169.         )
     
170. )
     
171. (do_frame)
     
172. )
     
173. 
     
174. (defun list_in(/ a1)
     
175.         (setq di(atoi $value))
     
176.         (handle_list)
     
177.         (setq Long (nth di m_list))
     
178.         (set_tile "l_size" (itoa Long))
     
179. (do_frame)
     
180. )
     
181. 
     
182. (defun sl_sel()
     
183.         (setq sl (atoi $value) sal (nth sl sl_list))
     
184.         (set_tile "scal" (itoa sal))
     
185. (do_frame)
     
186. );end defun
     
187. 
     
188. (if (and (not til_id)(<(setq til_id(load_dialog "title.dcl"))0))
     
189.         (exit)
     
190. );end if
     
191. (setq what_next 5)
     
192. (if(not(new_dialog "title" til_id ))(exit))
     
193. (setq winx (dimx_tile"show_ig") winy (dimy_tile"show_ig") )
     
194. ;(rdshx winx winy)
     
195. (defaults)
     
196. (action_tile"size_sel"   "(ss_in)")
     
197. (action_tile"title"   "(setq lb1 (= $value "1"))")
     
198. (action_tile"inside"   "(setq lb2 (= $value "1"))")
     
199. (action_tile"type_sel"   "(setq ver_hor (= $value "ver"))(do_frame)")
     
200. (action_tile"his"      "(setq lb3 (= $value "1"))")
     
201. (action_tile"l_size"   "(edit_in 1 $value)")
     
202. (action_tile"w_size"   "(edit_in 2 $value)")
     
203. (action_tile"dim_list"   "(List_in)")
     
204. (action_tile"scal"       "(edit_in 3 $value)")
     
205. (action_tile"scal_list""(sl_sel)")
     
206. (action_tile"help"       "(do_help "ddtitle")")
     
207. 
     
208. (setq what_next(start_dialog))
     
209.         (if(= what_next 1)
     
210.                 (progn
     
211.                 (setq title_data(list ver_hor sz lb1 lb2 Long Width sal di sl))
     
212.                 ;(command".zoom""C" viewcp (*(cadr p3)1.2))
     
213.                 ;(getcd"公共图框")
     
214.               (start)
     
215.               (GX-030)
     
216.                 (command".pline"pn1"w"sal sal pn2 pn3 pn4 "c")
     
217.                 (setq ssti(ssadd(entlast)))  
     
218.               (GX-031)
     
219.                 (command".pline"p1"w"0 0 p2 p3 p4"c")
     
220.                 (ssadd(entlast)ssti)
     
221.               (end)
     
222.                 (setq p1 pn1 p2 pn3 p3(list(* 0.5 sal long)(* 0.5 sal width)))
     
223.                 );end progn
     
224.          nil
     
225.         );end if
     
226. )
     
227. 
     
228. 
     
229. ;;调用幻灯的共享子程序
     
230. ;;;调用方法:(slide "DCL中的KEY值" "wjfhdk(key)")
     
231. 
     
232. (defun slide(key sld / x y );调
     
233.    (setq x (dimx_tile key))
     
234.    (setq y (dimy_tile key))
     
235.    (start_image key)
     
236.    (fill_image 0 0 x y -2);背景色:1白2A黑3蓝4白5灰6白7红8灰9白10蓝
     
237.    (slide_image 0 0 x y sld);图像坐标,通常用幻灯片制作时来调整
     
238.    (end_image)
     
239. );此为共享子程序
     
240. 
     
241. 
     
242. (defun start( )
     
243.   (setvar "cmdecho" 0)
     
244.   (setq os (getvar "osmode"))
     
245.   (setq lay (getvar "clayer"))
     
246.   ;(command "undo" "be")
     
247.   )
     
248. 
     
249.   (defun end( )
     
250. (setvar "osmode" os)
     
251. (setvar "clayer" lay)
     
252. (setvar "cmdecho" 1)
     
253. ;(command "undo" "e")
     
254. )
     
255. 
     
256. ;;;;;;;;;;专门加载  GEN-FRAME02  图层 的共享子程序    调用方法(GX-030)
     
257. (defun GX-030 ()
     
258. (if (tblsearch "layer" "GEN-FRAME02")
     
259. (setvar "clayer" "GEN-FRAME02")
     
260. (command "-layer" "m" "GEN-FRAME02" "c" "97" "" "l" "continuous" "" "lw" "0.4" "" "")
     
261. )
     
262. )
     
263. 
     
264. 
     
265. ;;;;;;;;;;专门加载  GEN-FRAME01  图层 的共享子程序    调用方法(GX-031)
     
266. (defun GX-031 ()
     
267. (if (tblsearch "layer" "GEN-FRAME01")
     
268. (setvar "clayer" "GEN-FRAME01")
     
269. (command "-layer" "m" "GEN-FRAME01" "c" "96" "" "l" "continuous" "" "lw" "0.09" "" "p" "n" "" "")
     
270. )
     
271. )
     
272. 
     
273. 
     
274. 
     
275. (defun c:title(/ ver_hor Long Width sz lb3 lb1 lb2 ins_scl ssti p1 p2 p3 p4 pn2 pn3 pn4 ss1)
     
276.     (if (title0)
     
277.         (progn
     
278.                         (if lb1
     
279.                                 (progn
     
280.                                         (command".-insert""_TITLE" pn2 ins_scl ins_scl 0) ;两个ins_scl改为100'
     
281.                                                  ;insert块名,插入点,X比例,Y比例,旋转角度
     
282.                                                 
     
283.                                         ;(setq ssti(ssadd(entlast)ssti))
     
284.                                     (setvar "qaflags" 1)
     
285.                                     (vl-cmdf ".explode" "L" "")
     
286.                                     (setq ssti(ssadd (ssget "P")ssti))
     
287.                                );end progn
     
288.                        );end if                              
     
289.                         (if lb2
     
290.                                 (progn
     
291.                                         (command".-insert""_INSIDE"
     
292.                                         pn3 ;(if(and ver_hor (/= sz 4))pn4 pn3)
     
293.                                         ins_scl ins_scl ;两个ins_scl改为100                                       
     
294.                                         ;90 ;;0是添加后面的是原来的语句。
     
295.                                         0
     
296.                                     ;(if(and ver_hor (/= sz 4))0 90);;no defun angtos1;;(angtos1 _pi2)改为90
     
297.                                         )
     
298.                                         ;;ver_hor 值nil为横式,T是立式
     
299.                                         ;(setq ssti(ssadd(entlast)ssti))
     
300.                                     
     
301.                                     (setvar "qaflags" 1)
     
302.                                     (vl-cmdf ".explode" "L" "")
     
303.                                     (setq ssti(ssadd (ssget "P")ssti))
     
304.                                         );end progn
     
305.                         );end if
     
306. 
     
307.                         (if lb3
     
308.                                 (progn
     
309.                                         (command".-insert""_HISTORY"
     
310.                                         pn3 ;(if(and ver_hor (/= sz 4))pn4 pn3)
     
311.                                         ins_scl ins_scl ;两个ins_scl改为100                                       
     
312.                                         ;90 ;;0是添加后面的是原来的语句。
     
313.                                         0
     
314.                                     ;(if(and ver_hor (/= sz 4))0 90);;no defun angtos1;;(angtos1 _pi2)改为90
     
315.                                         )
     
316.                                         ;;ver_hor 值nil为横式,T是立式
     
317.                                         (setq ssti(ssadd(entlast)ssti))
     
318.                                         );end progn
     
319.                         );end if
     
320.                         (if not (tblsearch "block" sz))
     
321.       (command ".-block" sz  p1 ssti "")
     
322.       (command ".-insert" sz p1 ins_scl ins_scl 0)  
     
323.       (princ"\n请点取插入点: ")
     
324.       ;;(line1)
     
325.         (setvar"orthomode"0)
     
326.        (command ".move" "L" p3)
     
327.         ;(command ".move"ssti""p3)
     
328.         );end progn
     
329.    );end if
     
330. (princ)
     
331. )
     
332. ;end defun
     

(defun title0 (/ p_a p_c viewcp x1 y1 pc p_a1 pn1 what_next n_list m_list di sal sl a0_list a1_list a2_list a3_list a4_list f0_list f1_list f2_list f3_list sl_list d_list ss_in handle_list sl_sel pop1_in p_list edit_in check_in defaults show_list set_status do_frame)<br />         (if title_data<br />         (mapcar 'set '(ver_hor sz lb1 lb2 Long Width sal di sl) title_data)<br />         (setq ver_hor nil sz 1 lb1 T lb2 T Long 841 Width 594 sal 100 di 0 sl 6)<br />         ) ;end if<br /> ;(setvar "CMDECHO" 0)<br />     (setq <br />         ;lb3       (= 0 (getvar "tilemode"))<br />         ;标准图幅尺寸<br />         p_list'((841 1189)(594 841)(420 594)(297 420)(210 297))<br />         ;加长尺寸列表<br />         a0_list '(1189 1338 1487 1635 1784 1932 2081 2230 2387)<br />         a1_list '(841 1051 1261 1472 1682 1892 2102)<br />         a2_list '(594 743 892 1041 1189 1338 1487 1635 1784 1932 2081)<br />         a3_list '(420 631 841 1051 1261 1472 1682 1892)<br />         a4_list '(297 445 594)<br />         ;加长几分之几<br />         f0_list '("1/8""1/4""3/8""1/2""5/8""3/4""7/8""1")<br />         f1_list '("1/4""1/2""3/4""1""5/4""3/2")<br />         f2_list '("1/4""1/2""3/4""1""5/4""3/2""7/4""2""9/4""9/2")<br />         f3_list '("1/2""1""3/2""2""5/2""3""7/2")<br />         f4_list '("1/2""1")<br />         ;比例列表<br />         sl_list '(1000 500 300 250 200 150 100 50 30 25 20 10 5)<br />         )<br /> <br /> ;(defun check_in(input format kk /)<br /> ;        (if(and (distof input 2) (>(atof input)0) )<br /> ;        (progn(rs_error)input)<br /> ;        (progn<br /> ;        (set_tile "error" (strcat"无效的"format"输入"))<br /> ;        (mode_tile kk 2)<br /> ;        nil);end progn<br /> ;        );end if<br /> ;);end defun<br />         <br /> (defun handle_list(/ d0 ln)<br />         (cond<br />                 ((= sz 0)(setq ln 8 n_list f0_list m_list a0_list))<br />                 ((= sz 1)(setq ln 6 n_list f1_list m_list a1_list))<br />                 ((= sz 2)(setq ln 10 n_list f2_list m_list a2_list))<br />                 ((= sz 3)(setq ln 7 n_list f3_list m_list a3_list))<br />                 (T(setq ln 2 n_list f4_list m_list a4_list))<br />        );end cond<br />       ln;调用函数赋值。<br /> )<br /> <br /> (defun set_status()<br />         (set_tile "size_sel" (strcat"A"(itoa sz)))        ;1 size_sel标准图幅 itoa 转化字符串<br />        (set_tile "title"   (if lb1 "1""0"))                ;3 title    会签栏<br />         (set_tile "inside"   (if lb2 "1""0"))                ;2 inside    图标<br />         (set_tile "type_sel" (if ver_hor "ver""hor"))        ;4 type_sel格式(立式,横式)<br />         (set_tile "his"      (if lb3 "1""0"))                ;5 his       图纸空间、模型空间<br />         (set_tile "l_size"   (itoa Long))                ;6 l_size    图纸长度<br />         (set_tile "w_size"   (itoa Width))                ;7 w_size    图纸宽度<br />         (set_tile "dim_list" (itoa di))                        ;8 dim_list加长S<br />         (set_tile "scal"   (itoa sal))                ;9 scal      比例<br />         (set_tile "scal_list"(itoa sl))                        ;0 scal_list 比例列表<br /> );end defun<br /> <br /> (defun defaults(/ d0 d2 d3 i)<br />         (set_status)<br />         (setq <br />                 d3(handle_list)<br />                 d0(strcat"A"(itoa sz))<br />                 d_list(list d0)<br />                 i 0<br />                 )                <br />         (repeat d3<br />                 (setq <br />                         d2 (nth i n_list) ;nth 此函数将返回n_list中的第i个元素,第一个元素由零开始的<br />                         i(1+ i)<br />                         d_list (if(= i 0) d_list(append d_list(list(strcat d0"+"d2))))<br />                 );end setq<br />         );end repeat<br />         ;d_list = (A1 A1+1/4 A1+1/2 A1+3/4 A1+1 A1+5/4 A1+3/2)<br />         <br />         ;(show_list "dim_list" d_list)                ;取消没影响....        <br />         (set_tile "dim_list" "0")<br />         (do_frame)<br /> );end defun<br /> (defun show_list(k1 l1)<br />         (start_list k1)<br />         (mapcar ' add_list l1)<br />         (end_list)<br />         )<br />         <br /> (defun do_frame()<br />         (setq         p1 '(0 0)<br />                 ;p_a 25 <br />                 p_c '(10 5)<br />                 viewcp (getvar"viewctr");viewctr 存储当前视口中视图的中心点。该值用 UCS 坐标表示。<br />                 pc (if(< sz 3)(car p_c)(cadr p_c))<br />                 x1 (*(float Width)sal)<br />                 y1 (*(float Long)sal)<br />                 pc (*(float pc)sal)<br />                 ins_scl sal <br />                 p_a1 (* 25 sal)<br />                 ;p_a1 (*(float p_a)sal)<br />                 )<br />         ;(setvar"tilemode"(if lb3 0 1));tilemode 将“模型”选项卡或最后一个布局选项卡置为当前。<br /> (if ver_hor<br />         (progn ;progn--aa<br />                 (setq p2 (list 0 y1) p3(list x1 y1) p4(list x1 0))<br />                 (if(/= sz 4)<br />                         (setq         pn1(list pc pc)<br />                                 pn2(list(- x1 pc)pc)<br />                                 pn3(list(- x1 pc)(- y1 p_a1))<br />                                 pn4(list pc(- y1 p_a1))<br />                                 )<br />         <br />                         (setq         pn1(list p_a1 pc)<br />                                 pn2(list(- x1 pc)pc)<br />                                 pn3(list(- x1 pc)(- y1 pc))<br />                                 pn4(list p_a1(- y1 pc))<br />                                 )<br />                 );end if<br />         );end progn--aa<br />         (setq         p2(list 0 x1)<br />                 p3(list y1 x1)<br />                 p4(list y1 0)<br />                 pn1(list p_a1 pc)<br />                 pn2(list(- y1 pc)pc)<br />                 pn3(list(- y1 pc)(- x1 pc))<br />                 pn4(list p_a1(- x1 pc))<br />                 )<br /> );end if<br />                 <br />         ;(setq plist(list nil p1 p2 p2 p3 p3 p4 p4 p1 pn1 pn2 pn2 pn3 pn3 pn4 pn4 pn1))<br />         ;(start_image"show_ig")<br />         ;(fill_image 0 0 winx winy -2)<br />         ;(foreach sublt(apply 'getpfxl plist)(apply 'vector_image sublt)) ;;getpfxl未定义        <br />         ;(end_image)<br /> );end defun<br /> <br /> (defun ss_in(/ d1 d2 d3 i)<br />         (setq sz(atoi(substr $value 2 1))<br />               d0(nth sz p_list)<br />               Width(car d0)<br />               Long(cadr d0)<br />               d_list(list $value)<br />               i 0 <br />               d3(handle_list)<br />               )<br />         (repeat d3<br />                 (setq         d2(nth i n_list)<br />                         i(1+ i)<br />                         d_list (if(= i 0) d_list (append d_list(list(strcat $value"+"d2))))<br />                 )<br />         );end repeat<br /> (show_list "dim_list" d_list)<br /> (set_tile "dim_list" "0")<br /> (set_tile "w_size" (itoa Width))<br /> (set_tile "l_size" (itoa Long))<br /> (do_frame)<br /> )<br /> <br /> (defun edit_in(n val / ppt k1)<br />         (cond<br />                 ((= n 1)(setq ppt"图长"k1"l_size"))<br />                 ((= n 2)(setq ppt"图宽"k1"w_size"))<br />                 ((= n 3)(setq ppt"比例"k1"scal"))<br />         )<br /> (if T;(check_in val ppt k1)<br />         (cond        ((= n 1)(setq long (atoi val)))<br />                 ((= n 2)(setq width (atoi val)))<br />                 ((= n 3)(setq sal (atoi val)))<br />         )<br /> )<br /> (do_frame)<br /> )<br /> <br /> (defun list_in(/ a1)<br />         (setq di(atoi $value))<br />         (handle_list)<br />         (setq Long (nth di m_list))<br />         (set_tile "l_size" (itoa Long))<br /> (do_frame)<br /> )<br /> <br /> (defun sl_sel()<br />         (setq sl (atoi $value) sal (nth sl sl_list))<br />         (set_tile "scal" (itoa sal))<br /> (do_frame)<br /> );end defun <br /> <br /> (if (and (not til_id)(<(setq til_id(load_dialog "title.dcl"))0))<br />         (exit)<br /> );end if<br /> (setq what_next 5)<br /> (if(not(new_dialog "title" til_id ))(exit))<br /> (setq winx (dimx_tile"show_ig") winy (dimy_tile"show_ig") )<br /> ;(rdshx winx winy)<br /> (defaults)<br /> (action_tile"size_sel"   "(ss_in)")<br /> (action_tile"title"   "(setq lb1 (= $value "1"))")<br /> (action_tile"inside"   "(setq lb2 (= $value "1"))")<br /> (action_tile"type_sel"   "(setq ver_hor (= $value "ver"))(do_frame)")<br /> (action_tile"his"      "(setq lb3 (= $value "1"))")<br /> (action_tile"l_size"   "(edit_in 1 $value)")<br /> (action_tile"w_size"   "(edit_in 2 $value)")<br /> (action_tile"dim_list"   "(List_in)")<br /> (action_tile"scal"       "(edit_in 3 $value)")<br /> (action_tile"scal_list""(sl_sel)")<br /> (action_tile"help"       "(do_help "ddtitle")")<br /> <br /> (setq what_next(start_dialog))<br />         (if(= what_next 1)<br />                 (progn<br />                 (setq title_data(list ver_hor sz lb1 lb2 Long Width sal di sl))<br />                 ;(command".zoom""C" viewcp (*(cadr p3)1.2))<br />                 ;(getcd"公共图框")<br />               (start)<br />               (GX-030)<br />                 (command".pline"pn1"w"sal sal pn2 pn3 pn4 "c")<br />                 (setq ssti(ssadd(entlast)))  <br />               (GX-031)<br />                 (command".pline"p1"w"0 0 p2 p3 p4"c")<br />                 (ssadd(entlast)ssti)<br />               (end)<br />                 (setq p1 pn1 p2 pn3 p3(list(* 0.5 sal long)(* 0.5 sal width)))<br />                 );end progn<br />          nil<br />         );end if<br /> )<br /> <br /> <br /> ;;调用幻灯的共享子程序 <br /> ;;;调用方法:(slide "DCL中的KEY值" "wjfhdk(key)")<br /> <br /> (defun slide(key sld / x y );调<br />    (setq x (dimx_tile key))<br />    (setq y (dimy_tile key))<br />    (start_image key)<br />    (fill_image 0 0 x y -2);背景色:1白2A黑3蓝4白5灰6白7红8灰9白10蓝<br />    (slide_image 0 0 x y sld);图像坐标,通常用幻灯片制作时来调整<br />    (end_image)<br /> );此为共享子程序<br /> <br /> <br /> (defun start( )<br />   (setvar "cmdecho" 0)<br />   (setq os (getvar "osmode"))<br />   (setq lay (getvar "clayer"))<br />   ;(command "undo" "be")<br />   )<br /> <br />   (defun end( )<br /> (setvar "osmode" os)<br /> (setvar "clayer" lay)<br /> (setvar "cmdecho" 1)<br /> ;(command "undo" "e")<br /> )<br /> <br /> ;;;;;;;;;;专门加载  GEN-FRAME02  图层 的共享子程序    调用方法(GX-030)<br /> (defun GX-030 ()<br /> (if (tblsearch "layer" "GEN-FRAME02")<br /> (setvar "clayer" "GEN-FRAME02")<br /> (command "-layer" "m" "GEN-FRAME02" "c" "97" "" "l" "continuous" "" "lw" "0.4" "" "")<br /> )<br /> )<br /> <br /> <br /> ;;;;;;;;;;专门加载  GEN-FRAME01  图层 的共享子程序    调用方法(GX-031)<br /> (defun GX-031 ()<br /> (if (tblsearch "layer" "GEN-FRAME01")<br /> (setvar "clayer" "GEN-FRAME01")<br /> (command "-layer" "m" "GEN-FRAME01" "c" "96" "" "l" "continuous" "" "lw" "0.09" "" "p" "n" "" "")<br /> )<br /> )<br /> <br /> <br /> <br /> (defun c:title(/ ver_hor Long Width sz lb3 lb1 lb2 ins_scl ssti p1 p2 p3 p4 pn2 pn3 pn4 ss1)<br />     (if (title0)<br />         (progn<br />                         (if lb1<br />                                 (progn<br />                                         (command".-insert""_TITLE" pn2 ins_scl ins_scl 0) ;两个ins_scl改为100'<br />                                                  ;insert块名,插入点,X比例,Y比例,旋转角度<br />                                                  <br />                                         ;(setq ssti(ssadd(entlast)ssti))<br />                                     (setvar "qaflags" 1)<br />                                     (vl-cmdf ".explode" "L" "")<br />                                     (setq ssti(ssadd (ssget "P")ssti))<br />                                );end progn<br />                        );end if                              <br />                         (if lb2<br />                                 (progn<br />                                         (command".-insert""_INSIDE" <br />                                         pn3 ;(if(and ver_hor (/= sz 4))pn4 pn3)<br />                                         ins_scl ins_scl ;两个ins_scl改为100                                        <br />                                         ;90 ;;0是添加后面的是原来的语句。<br />                                         0 <br />                                     ;(if(and ver_hor (/= sz 4))0 90);;no defun angtos1;;(angtos1 _pi2)改为90<br />                                         )<br />                                         ;;ver_hor 值nil为横式,T是立式<br />                                         ;(setq ssti(ssadd(entlast)ssti))<br />                                     <br />                                     (setvar "qaflags" 1)<br />                                     (vl-cmdf ".explode" "L" "")<br />                                     (setq ssti(ssadd (ssget "P")ssti))<br />                                         );end progn<br />                         );end if<br /> <br />                         (if lb3<br />                                 (progn<br />                                         (command".-insert""_HISTORY" <br />                                         pn3 ;(if(and ver_hor (/= sz 4))pn4 pn3)<br />                                         ins_scl ins_scl ;两个ins_scl改为100                                        <br />                                         ;90 ;;0是添加后面的是原来的语句。<br />                                         0 <br />                                     ;(if(and ver_hor (/= sz 4))0 90);;no defun angtos1;;(angtos1 _pi2)改为90<br />                                         )<br />                                         ;;ver_hor 值nil为横式,T是立式<br />                                         (setq ssti(ssadd(entlast)ssti))<br />                                         );end progn<br />                         );end if <br />                         (if not (tblsearch "block" sz)) <br />       (command ".-block" sz  p1 ssti "")<br />       (command ".-insert" sz p1 ins_scl ins_scl 0)  <br />       (princ"\n请点取插入点: ")<br />       ;;(line1)<br />         (setvar"orthomode"0)<br />        (command ".move" "L" p3)<br />         ;(command ".move"ssti""p3)<br />         );end progn<br />    );end if<br /> (princ)<br /> )<br /> ;end defun<br />