1 (vl-load-com)
2
3 ;;;标注文字增加公差
4 ;;;命令：GV
5 ;;;极限公差文字高度可设置成主尺寸文字高度的任意比例，缺省值为0.7
6 ;;;当上公差与下公差相等时为对称公差
7 (defun c:gv(/ sztoleranceheightscale rtoleranceheightscale sztoleranceupperlimit %sk1 sztolerancelowerlimit %sk2 nprecision ss i vobj ename elist)
8 (Berni_Start)
9
10 (cond
11 ((setq szToleranceHeightScale (vl-registry-read "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceHeightScale")))
12 (T
13 (setq szToleranceHeightScale "0.7")
14 (vl-registry-write "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceHeightScale" "0.7")
15 )
16 )
17 (setq rToleranceHeightScale (atof szToleranceHeightScale))
18 (vl-registry-write "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceHeightScale" (vl-princ-to-string rToleranceHeightScale))
19 (cond
20 ((setq szToleranceUpperLimit (vl-registry-read "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceUpperLimit")))
21 (T
22 (setq szToleranceUpperLimit "0.1")
23 (vl-registry-write "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceUpperLimit" "0.1")
24 )
25 )
26
27 (initget "S")
28 (setq %sk1 (getreal (strcat "\n输入上公差或 [字高比例(S)] <" szToleranceUpperLimit ">:"))); "S" nil 实数
29 (cond
30 ((= %sk1 "S")
31 (while
32 (progn
33 (cond
34 ((setq rToleranceHeightScale (getreal (strcat "\n指定公差值的文字高度相对于标注文字高度的比例因子 <" szToleranceHeightScale ">:"))))
35 (T
36 (setq rToleranceHeightScale (atof szToleranceHeightScale))
37 )
38 )
39 (setq rToleranceHeightScale (abs rToleranceHeightScale))
40 (vl-registry-write "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceHeightScale" (vl-princ-to-string rToleranceHeightScale))
41 (cond
42 ((> rToleranceHeightScale 0))
43 (T;输入了0
44 (vlax-invoke (vla-GetInterfaceObject (vlax-get-acad-object) "WScript.Shell") "popup" "必须为正" 2 "错误" 48);警告内容 延迟秒数 对话框标题 确定按钮+黄色感叹号
45 (setq rToleranceHeightScale nil)
46 )
47 )
48 (not rToleranceHeightScale)
49 )
50 )
51 ;实数 nil
52 (cond
53 ((setq %sk1 (getreal (strcat "\n输入上公差 <" szToleranceUpperLimit ">:"))));实数
54 (T;nil
55 (setq %sk1 (atof szToleranceUpperLimit));使用缺省值
56 )
57 )
58 );"S"
59 ((= (type %sk1) 'REAL));实数
60 (T;nil
61 (setq %sk1 (atof szToleranceUpperLimit))
62 )
63 )
64 (vl-registry-write "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceUpperLimit" (vl-princ-to-string %sk1))
65
66 (cond
67 ((setq szToleranceLowerLimit (vl-registry-read "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceLowerLimit")))
68 (T
69 (setq szToleranceLowerLimit "0.1")
70 (vl-registry-write "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceLowerLimit" "0.1")
71 )
72 )
73
74 (cond
75 ((setq %sk2 (getreal (strcat "\n输入下公差 <" szToleranceLowerLimit ">:"))))
76 (T
77 (setq %sk2 (atof szToleranceLowerLimit))
78 )
79 )
80 (vl-registry-write "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw" "ToleranceLowerLimit" (vl-princ-to-string %sk2))
81 (setq nPrecision (max (BF-numOfSignificantDigitsAfterDecimalPoint %sk1) (BF-numOfSignificantDigitsAfterDecimalPoint %sk2)));获取小数位数
82
83 (princ "\n选择尺寸:")
84 (while (setq ss (ssget ":S" '((0 . "DIMENSION"))))
85 (repeat (setq i (sslength ss))
86 (setq vObj (vla-ssname ss (setq i (1- i))))
87 (vla-put-ToleranceDisplay vObj 2);显示公差:极限偏差
88 (vla-put-ToleranceUpperLimit vObj %sk1)
89 (vla-put-ToleranceLowerLimit vObj %sk2)
90 (Vlax-Put-Property vObj 'TolerancePrecision nPrecision )
91 (setq ename (vlax-vla-object->ename vObj))
92 (setq eList (entget ename))
93 (cond
94 ((and (member '(100 . "AcDb2LineAngularDimension") eList) (< (Vlax-Get vObj 'TextPrecision) nPrecision));角度标注
95 (Vlax-Put-Property vObj 'TextPrecision nPrecision)
96 )
97 )
98 (Vlax-Put-Property vObj 'ToleranceHeightScale rToleranceHeightScale )
99 (cond
100 ((= %sk1 %sk2);对称公差
101 (Vlax-Put-Property vObj 'ToleranceHeightScale 1.0)
102 )
103 )
104 (Vlax-Put-Property vObj 'ToleranceSuppressTrailingZeros -1 )
105 )
106 (cond
107 ((= %sk1 %sk2)
108 (princ "\n增加对称公差已完成!")
109 )
110 (T
111 (princ "\n增加极限公差已完成!")
112 )
113 )
114 );while
115
116 (Berni_End)
117 (princ)
118 );defun
119
120 ;;;name:BF-numOfSignificantDigitsAfterDecimalPoint
121 ;;;desc:小数点后有效（非零）数字的位数
122 ;;;arg:rNum:要检查小数点后有效（非零）数字位数的数字
123 ;;;return:rNum为数字时返回有效小数位数,否则返回nil
124 ;;;example:(BF-numOfSignificantDigitsAfterDecimalPoint 0.123) 返回 3
125 (defun BF-numOfSignificantDigitsAfterDecimalPoint(rNum / str pos nRetVal)
126 (cond
127 ((numberp rNum)
128 (setq str (rtos rNum 2 16))
129 (cond
130 ((setq pos (vl-string-search "." str))
131 (setq str (substr str (+ pos 2)));小数点以后的字符串(不含小数点)
132 (setq str (vl-string-right-trim "0" str));去掉右边的数字0
133 (setq nRetVal (strlen str))
134 )
135 (T (setq nRetVal 0))
136 )
137 )
138 (T (setq nRetVal nil))
139 )
140 nRetVal
141 )
142
143 ;;;返回选择集ss中第index（从0开始）个图元的对象名
144 (defun vla-ssname(ss index)
145 (vlax-ename->vla-object (ssname ss index))
146 )
147
148 ;|
149 消除重合线
150 命令：SX
151 移除几何上是多余的对象。例如：
152 1.对象重复的副本将被删除。
153 2.圆弧对象正好覆盖了圆的一部分，这个圆弧不能显现。此圆弧将被删除。
154 3.两条直线其角度相同且部分重叠。这两条直线将合并为一条直线。
155 |;
156 ;;; *****消除重线 程序开始*****
157 (defun c:sx(/ n ss i ss1 ename elist etype);删线
158 (setq ss (ssget "i"))
159 (Berni_Start)
160
161 (princ "\n★功能：删除重复的直线、圆、圆弧.")
162 (cond
163 (ss
164 (setq n (sslength ss) i 0 ss1 ss ss (ssadd))
165 (repeat n
166 (setq ename (ssname ss1 i))
167 (setq eList (entget ename))
168 (setq eType (cdr (assoc 0 eList)))
169 (cond
170 ((or (= eType "LINE") (= eType "ARC") (= eType "CIRCLE"))
171 (setq ss (ssadd ename ss))
172 )
173 )
174 (setq i (1+ i))
175 )
176 (cond
177 ((= (sslength ss) 0)
178 (while
179 (progn
180 (setq ss (ssget '((0 . "LINE,ARC,CIRCLE"))))
181 (not ss)
182 )
183 )
184 )
185 (T T)
186 )
187 )
188 (T
189 (while
190 (progn
191 (setq ss (ssget '((0 . "LINE,ARC,CIRCLE"))))
192 (not ss)
193 )
194 )
195 )
196 )
197
198 (princ "\n--->程序进行中，请稍候...")
199 (hbzhx ss);合并
200
201 (princ "\n消除重线完成！")
202
203 (Berni_End)
204 (princ)
205 )
206
207 ;合并重线
208 (defun hbzhx(ss / precision i line_list arc_list ent obj e1 e2)
209 (grtext -2 "正在整理数据")
210
211 (setq precision 1e-8)
212 (setq i 0
213 line_list nil
214 arc_list nil
215 )
216
217 (repeat (sslength ss)
218 (setq ent (ssname ss i)
219 i (1+ i)
220 )
221 (setq obj (vlax-ename->vla-object ent))
222
223 (if (> (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) precision);曲线长度大于精度precision
224 (if (= "LINE" (cdr (assoc 0 (entget ent))))
225 (setq line_list (cons (line_data ent) line_list))
226 (setq arc_list (cons (arc_data ent) arc_list))
227 )
228 )
229 )
230
231 (setq line_list
232 (vl-sort
233 line_list
234 '(lambda (e1 e2)
235 (if (equal (car e1) (car e2) precision)
236 (if (equal (cadr e1) (cadr e2) precision)
237 (if (equal (car (caddr e1)) (car (caddr e2)) precision);起点x坐标相等
238 (< (cadr (caddr e1)) (cadr (caddr e2)));斜率、截距、起点x坐标都相同时,按起点y坐标从小到大排序
239 (< (car (caddr e1)) (car (caddr e2)));斜率和截距都相同时,按起点x坐标从小到大排序
240 )
241 (< (cadr e1) (cadr e2));斜率相同时,再按截距从小到大排序
242 )
243 (< (car e1) (car e2));先按斜率从小到大排序
244 )
245 )
246 )
247 )
248
249 ; 半径 圆心x坐标 圆心y坐标 起点角 终点角 图元名
250 (setq arc_list (vl-sort arc_list
251 '(lambda (e1 e2)
252 (if (equal (car e1) (car e2) precision);半径相等
253 (if (equal (cadr e1) (cadr e2) precision);圆心x坐标相等
254 (if (equal (caddr e1) (caddr e2) precision);圆心y坐标相等
255 (< (cadddr e1) (cadddr e2));半径、圆心x坐标、圆心y坐标均相等时,按起点角从小到大排序
256 (< (caddr e1) (caddr e2));半径、圆心x坐标相等时,按圆心y坐标从小到大排序
257 )
258 (< (cadr e1) (cadr e2));半径相等时,再按圆心x坐标从小到大排序
259 )
260 (< (car e1) (car e2));先按半径从小到大排序
261 )
262 )
263 )
264 )
265
266 (if line_list
267 (hb_line line_list precision);合并直线
268 )
269 (if arc_list
270 (progn
271 (hb_arc arc_list precision);合并圆弧
272 )
273 )
274
275 (grtext);使所有文本区域恢复为标准值
276 )
277
278
279 ;合并圆弧
280 (defun hb_arc(arc_list precision / zongshu xuhao ssunnecessary 2pi arc_a biaoji bj pc sangl eangl ent arc_b sangl1 eangl1 ent1 tmplst arc_list_item ename obj)
281 (setq zongshu (length arc_list)
282 xuhao 0
283 ssUnnecessary (ssadd)
284 2pi (* 2 pi)
285 )
286 (princ (strcat "\n共处理了" (itoa zongshu) "个圆或圆弧图元"))
287 (grtext -1 "合并圆弧")
288
289 (while (> (length arc_list) 0)
290 (cs_pross zongshu (setq xuhao (1+ xuhao)))
291 (setq arc_a (car arc_list);a弧数据表
292 arc_list (cdr arc_list)
293 biaoji T
294 bj (car arc_a)
295 pc (list (cadr arc_a) (caddr arc_a));圆心
296 sangl (cadddr arc_a)
297 eangl (nth 4 arc_a)
298 ent (last arc_a)
299 )
300 (while (and biaoji
301 (> (length arc_list) 0)
302 )
303 (setq arc_b (car arc_list))
304
305 (cond
306 ((and (equal bj (car arc_b) precision);同圆心同半径
307 (equal pc (list (cadr arc_b) (caddr arc_b)) precision)
308 )
309
310 (setq sangl1 (cadddr arc_b);b弧起点角
311 eangl1 (nth 4 arc_b);b弧终点角
312 ent1 (last arc_b)
313 )
314
315 (cond
316 ((= (get_dxf ent 0) "CIRCLE");a为圆
317 (setq tmpLst nil)
318 (foreach arc_list_item arc_list
319 (cond
320 ((and (equal bj (car arc_list_item) precision) (equal (car pc) (cadr arc_list_item) precision) (equal (cadr pc) (caddr arc_list_item) precision));同圆心等半径
321 (setq ssUnnecessary (ssadd (last arc_list_item) ssUnnecessary))
322 (cs_pross zongshu (setq xuhao (1+ xuhao)))
323 )
324 (T (setq tmpLst (append tmpLst (list arc_list_item))))
325 )
326 )
327 (setq arc_list tmpLst)
328 (setq biaoji nil);结束内圈循环
329 )
330 ((= (get_dxf ent1 0) "CIRCLE");a为弧,且b为圆
331 (setq ssUnnecessary (ssadd ent ssUnnecessary))
332 (cs_pross zongshu (setq xuhao (1+ xuhao)))
333 (setq arc_list (cdr arc_list))
334
335 (setq tmpLst nil)
336 (foreach arc_list_item arc_list
337 (cond
338 ((and (equal bj (car arc_list_item) precision) (equal (car pc) (cadr arc_list_item) precision) (equal (cadr pc) (caddr arc_list_item) precision));同圆心等半径
339 (setq ssUnnecessary (ssadd (last arc_list_item) ssUnnecessary))
340 (cs_pross zongshu (setq xuhao (1+ xuhao)))
341 )
342 (T (setq tmpLst (append tmpLst (list arc_list_item))))
343 )
344 )
345 (setq arc_list tmpLst)
346 (setq biaoji nil);结束内圈循环
347 )
348 ((and (= sangl eangl1) (= eangl sangl1));均为弧，且互补
349 (setq ename (entmakex (list '(0 . "CIRCLE") (list 10 (car pc) (cadr pc) 0) (cons 40 bj))))
350 (setq obj (Vlax-Ename->Vla-Object ename))
351 (Vlax-Put-Property obj 'Layer (cdr (assoc 8 (entget ent))) )
352 (Vlax-Put-Property obj 'Linetype (Vlax-Get (Vlax-Ename->Vla-Object ent) 'Linetype))
353 (Vlax-Put-Property obj 'LinetypeScale (Vlax-Get (Vlax-Ename->Vla-Object ent) 'LinetypeScale))
354 (Vlax-Put-Property obj 'Lineweight (Vlax-Get (Vlax-Ename->Vla-Object ent) 'Lineweight));线宽
355 (Vlax-Put-Property obj 'Color (Vlax-Get (Vlax-Ename->Vla-Object ent) 'Color))
356 (entdel ent)
357
358 (setq tmpLst nil)
359 (foreach arc_list_item arc_list
360 (cond
361 ((and (equal bj (car arc_list_item) precision) (equal (car pc) (cadr arc_list_item) precision) (equal (cadr pc) (caddr arc_list_item) precision));同圆心等半径
362 (setq ssUnnecessary (ssadd (last arc_list_item) ssUnnecessary))
363 (cs_pross zongshu (setq xuhao (1+ xuhao)))
364 )
365 (T
366 (setq tmpLst (append tmpLst (list arc_list_item)))
367 )
368 )
369 )
370 (setq arc_list tmpLst)
371 (setq biaoji nil);结束内圈循环
372 )
373 ((and (BF-onArcP sangl1 sangl eangl) (BF-onArcP eangl1 sangl eangl) (>= (+ (/ (vlax-curve-getDistAtPoint (Vlax-Ename->Vla-Object ent) (polar (list (car pc) (cadr pc) 0) sangl1 bj)) bj) (Vlax-Get (Vlax-Ename->Vla-Object ent1) 'TotalAngle )) 2pi))
374 (setq ename (entmakex (list '(0 . "CIRCLE") (list 10 (car pc) (cadr pc) 0) (cons 40 bj))))
375 (setq obj (Vlax-Ename->Vla-Object ename))
376 (Vlax-Put-Property obj 'Layer (cdr (assoc 8 (entget ent))) )
377 (Vlax-Put-Property obj 'Linetype (Vlax-Get (Vlax-Ename->Vla-Object ent) 'Linetype))
378 (Vlax-Put-Property obj 'LinetypeScale (Vlax-Get (Vlax-Ename->Vla-Object ent) 'LinetypeScale))
379 (Vlax-Put-Property obj 'Lineweight (Vlax-Get (Vlax-Ename->Vla-Object ent) 'Lineweight));线宽
380 (Vlax-Put-Property obj 'Color (Vlax-Get (Vlax-Ename->Vla-Object ent) 'Color))
381 (entdel ent)
382
383 (setq tmpLst nil)
384 (foreach arc_list_item arc_list
385 (cond
386 ((and (equal bj (car arc_list_item) precision) (equal (car pc) (cadr arc_list_item) precision) (equal (cadr pc) (caddr arc_list_item) precision));同圆心等半径
387 (setq ssUnnecessary (ssadd (last arc_list_item) ssUnnecessary))
388 (cs_pross zongshu (setq xuhao (1+ xuhao)))
389 )
390 (T (setq tmpLst (append tmpLst (list arc_list_item))))
391 )
392 )
393 (setq arc_list tmpLst)
394 (setq biaoji nil);结束内圈循环
395 )
396 ((and (BF-onArcP sangl1 sangl eangl) (BF-onArcP eangl1 sangl eangl));弧a包含弧b
397 (setq ssUnnecessary (ssadd ent1 ssUnnecessary))
398 (cs_pross zongshu (setq xuhao (1+ xuhao)))
399 (setq arc_list (cdr arc_list))
400 )
401 ((and (BF-onArcP sangl sangl1 eangl1) (BF-onArcP eangl sangl1 eangl1));弧b包含弧a
402 (Vlax-Put-Property (Vlax-Ename->Vla-Object ent) 'StartAngle sangl1)
403 (Vlax-Put-Property (Vlax-Ename->Vla-Object ent) 'EndAngle eangl1)
404 (setq sangl sangl1)
405 (setq eangl eangl1)
406 (setq ssUnnecessary (ssadd ent1 ssUnnecessary))
407 (cs_pross zongshu (setq xuhao (1+ xuhao)))
408 (setq arc_list (cdr arc_list))
409 )
410 ;;;部分重叠
411 ((or (BF-onArcP sangl1 sangl eangl) (BF-onArcP eangl1 sangl eangl));弧b、弧a部分重叠
412 (setq ssUnnecessary (ssadd ent1 ssUnnecessary))
413 (cs_pross zongshu (setq xuhao (1+ xuhao)))
414 (setq arc_list (cdr arc_list))
415 (cond
416 ((BF-onArcP sangl1 sangl eangl)
417 (Vlax-Put-Property (Vlax-Ename->Vla-Object ent) 'EndAngle eangl1)
418 (setq eangl eangl1)
419 )
420 (T
421 (Vlax-Put-Property (Vlax-Ename->Vla-Object ent) 'StartAngle sangl1)
422 (setq sangl sangl1)
423 )
424 )
425 )
426 (T (setq biaoji nil));弧a、弧b不重叠
427 );cond
428 );cond-1 同圆心同半径
429 (T (setq biaoji nil));cond-2
430 );cond
431 );while
432 );while
433
434 (if (> (sslength ssUnnecessary) 0)
435 (progn
436 (princ (strcat "，删除了" (itoa (sslength ssUnnecessary)) "个重复圆或圆弧."))
437 (command "erase" ssUnnecessary "")
438 )
439 )
440 );hb_arc
441
442
443 (defun line_data(ent / obj p1 p2 precision k b e1 e2)
444 (setq precision 1e-8)
445 (setq obj (vlax-ename->vla-object ent)
446 p1 (vlax-curve-getstartpoint obj)
447 p2 (vlax-curve-getendpoint obj)
448 )
449 (if (equal (car p1) (car p2) precision);斜率不存在
450 (setq k nil
451 b (car p1)
452 );直线x=b
453 (setq k (/ (- (cadr p2) (cadr p1))
454 (- (car p2) (car p1))
455 )
456 b (- (cadr p1) (* (car p1) k))
457 )
458 )
459
460 (setq p2 (vl-sort (list p1 p2)
461 '(lambda(e1 e2)
462 (if (equal (car e1) (car e2) precision);x坐标相等
463 (< (cadr e1) (cadr e2));x坐标相等时,再按y坐标从小到大排序
464 (< (car e1) (car e2));先按x坐标从小到大排序
465 )
466 )
467 )
468 p1 (car p2)
469 p2 (cadr p2)
470 )
471
472 (list k;斜率
473 b;截距
474 (list (car p1) (cadr p1));左下点二维坐标表
475 (list (car p2) (cadr p2));右上点二维坐标表
476 ent;图元名
477 )
478 )
479
480
481 (defun arc_data(ent / data bj pc sangl eangl 2pi)
482 (setq 2pi (* 2 pi))
483 (setq data (entget ent))
484 (setq bj (cdr (assoc 40 data)))
485 (setq pc (cdr (assoc 10 data)))
486 (setq sangl (cdr (assoc 50 data)))
487 (setq eangl (cdr (assoc 51 data)))
488 (if sangl;圆弧
489 nil
490 (setq sangl 0.0
491 eangl 2pi
492 );圆
493 )
494 ; 半径 圆心x坐标 圆心y坐标 起点角 终点角 图元名
495 (list bj (car pc) (cadr pc) sangl eangl ent)
496 )
497
498
499 ;合并直线
500 (defun hb_line(line_list precision / zongshu i xuhao line_a biaoji k b p1 p2 ent lay line_b p3 p4 p5 e1 e2 data)
501 (setq zongshu (length line_list);总数
502 i 0;计数变量
503 xuhao 0;序号
504 )
505 (princ (strcat "\n共处理了" (itoa zongshu) "个直线图元"))
506 (grtext -1 "合并直线");将文本写入到模式状态行区域
507
508 (while (> (length line_list) 0)
509 (setq xuhao (1+ xuhao))
510 (cs_pross zongshu xuhao)
511 (setq line_a (car line_list);第一条直线a的数据表
512 line_list (cdr line_list)
513 biaoji T;标记
514 k (car line_a)
515 b (cadr line_a)
516 p1 (caddr line_a)
517 p2 (cadddr line_a)
518 ent (last line_a)
519 lay (cdr (assoc 8 (entget ent)));图层
520 )
521 (while (and biaoji
522 (> (length line_list) 0)
523 )
524 (setq line_b (car line_list));第一条直线b的数据表
525 (cond
526 ((and (equal k (car line_b) precision);共线
527 (equal b (cadr line_b) precision)
528 )
529 (setq p3 (caddr line_b);左下点
530 p4 (cadddr line_b);右上点
531 p5 (vl-sort (list p1 p2 p3 p4)
532 '(lambda (e1 e2)
533 (if (equal (car e1) (car e2) precision);x坐标相等
534 (< (cadr e1) (cadr e2));x坐标相等时,按y坐标从小到大排序
535 (< (car e1) (car e2));先按x坐标从小到大排序
536 )
537 )
538 )
539 p4 (cadr p5)
540 )
541 (if (or (equal p1 p4 precision);p4与某一条直线的左下点重合
542 (equal p3 p4 precision)
543 )
544 (progn
545 (setq p1 (car p5);四个点中的左下
546 p2 (last p5);四个点中的右上
547 line_list (cdr line_list)
548 )
549 (entdel (last line_b));保留直线a,删除直线b
550 (setq xuhao (1+ xuhao))
551 (cs_pross zongshu xuhao)
552 (setq i (1+ i))
553 )
554 (setq biaoji nil)
555 )
556 );共线
557 (T (setq biaoji nil))
558 )
559 )
560
561 (setq data (entget ent)
562 data (subst (cons 10 p1) (assoc 10 data) data)
563 data (subst (cons 11 p2) (assoc 11 data) data)
564 )
565 (entmod data)
566 )
567
568 (if (> i 0)
569 (progn
570 (princ (strcat "，删除了" (itoa i) "条重复直线."))
571 )
572 )
573
574 (princ)
575 )
576
577
578 (defun cs_pross(total i / cs_Text myI);total总数,i序号
579 (setq cs_Text ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>");42个字符
580 (setq myI (fix (/ (* (strlen cs_Text) i) total));商的整数部分
581 cs_Text (substr cs_Text 1 myI)
582 )
583 (grtext -2 cs_Text)
584 )
585 ;;; *****消除重线 程序结束*****
586
587
588 ;;;name:BF-onArcP
589 ;;;desc:确定角ang是否在ang1与ang2之间
590 ;;;arg:ang1:圆弧起点角,ang2:圆弧终点角
591 ;;;return:角ang在ang1与ang2之间返回T,否则返回nil
592 ;;;example:(BF-onArcP (/ pi 2) 0 pi) 返回 T\n(BF-onArcP (/ pi 4) (/ pi 2) pi) 返回 nil
593 (defun BF-onArcP(ang ang1 ang2)
594 (cond
595 ((> ang2 ang1)
596 (>= ang2 ang ang1)
597 )
598 (T;ang2<=ang1
599 (or (<= ang ang2) (>= ang ang1))
600 )
601 )
602 )
603
604 ;;;=====================================
605 ;;;获取实体dxf组码内容
606 ;;;(get_dxf ename code)
607 (defun get_dxf (ename code / elist retVal)
608 (setq elist (entget ename))
609 (setq retVal (cdr (assoc code elist)))
610 (cond
611 (retVal)
612 (T
613 (princ "\n函数get_dxf的返回值为nil")
614 (exit)
615 )
616 )
617 retVal
618 )
619
620 ;;;初始化，读取系统变量
621 (defun Berni_Start()
622 (setq Berni_S_Lst (List (getvar "osmode");0
623 (getvar "cmdecho");1
624 (getvar "clayer");2
625 (getvar "textstyle");3
626 (getvar "cecolor");4
627 (getvar "dimstyle");5
628 (getvar "plinewid");6
629 (getvar "attdia");7
630 (getvar "PICKSTYLE");8
631 (getvar "PEDITACCEPT");9
632 (getvar "dynmode");10
633 (getvar "nomutt");11
634 );end list
635 );end setq
636 (setvar "cmdecho" 0);1
637 (command "undo" "be")
638 (setq old_error *error*)
639 (setq *error* *error*_zrw)
640 (setvar "osmode" 0);0
641 (setvar "attdia" 0);7 INSERT 命令给出命令行提示而非使用对话框用于属性值的输入
642 (setvar "PICKSTYLE" 0);8 控制编组选择和关联填充选择的使用。0 不使用编组选择和关联填充选择
643 (setvar "PEDITACCEPT" 1);9 禁止在 PEDIT 中显示“选定的对象不是多段线”提示，选定对象将自动转换为多段线。
644 (setvar "dynmode" 0);10
645 (princ)
646 )
647
648 ;;;结束时，恢复系统变量
649 (defun Berni_End()
650 (setvar "osmode" (nth 0 Berni_s_Lst))
651 (setvar "clayer" (nth 2 Berni_s_Lst))
652 (setvar "textstyle" (nth 3 Berni_s_Lst))
653 (setvar "cecolor" (nth 4 Berni_s_Lst))
654 (setvar "plinewid" (nth 6 Berni_s_Lst))
655 (setvar "attdia" (nth 7 Berni_s_Lst));控制 INSERT 命令是否使用对话框用于属性值的输入。0 给出命令行提示；1 使用对话框
656 (setvar "PICKSTYLE" (nth 8 Berni_s_Lst));控制编组选择和关联填充选择的使用。0 不使用编组选择和关联填充选择；1 使用编组选择；2 使用关联填充选择；3 使用编组选择和关联填充选择
657 (setvar "PEDITACCEPT" (nth 9 Berni_s_Lst));禁止在 PEDIT 中显示“选定的对象不是多段线”提示。 该提示后会显示“是否将其转换为多段线？”输入 y 将选定对象转换为多线段。 当该提示被禁止显示时，选定对象将自动转换
658 为多段线。0 显示提示；1 抑制提示
659 (setvar "dynmode" (nth 10 Berni_s_Lst))
660 (setvar "nomutt" (nth 11 Berni_s_Lst));禁止显示通常情况下不禁止显示的消息（即不进行消息反馈）。 显示的消息为普通模式，但在脚本、AutoLISP 例程等运行期间将禁止消息显示。0 恢复普通模式的消息反馈；1 禁止不
661 确定的消息反馈
662 (setq *error* old_error)
663 (command "undo" "e")
664 (setvar "cmdecho" (nth 1 Berni_s_Lst))
665 (princ)
666 )
667
668 ;自定义错误处理函数
669 (defun *error*_zrw(msg)
670 (princ "\n出错: ")
671 (princ msg)
672 (princ ", 程序退出! ")
673 (Berni_End)
674 )
675
676 (princ "\n增加公差程序加载完成，命令GV")
677 (princ "\n消除重合线程序加载完成，命令SX")
678
679 (vl-registry-delete "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\Yx_Zrw")
680 (princ)
浙公网安备 33010602011771号