【希望高手帮我弄一个自动生成标注的工具】

fire9527

根据直线生成标注，最重要的是标注要跟直线端点关联，具体要求详截图或者附件，希望有明经的高手帮我实现，祝下一个节日更快乐！   （本来要发布悬赏的，第一个帖子弄错了，请辛劳的管理员删掉，谢谢！）

edata

1. ;快速标注
   
2. (defun c:tt(/ bak_lay dimx_com dimx_lst dimy_com dimy_lst p1 p2 p3 ss sspt ss_lst x)
   
3.   (if(and (setq ss(ssget '((0 . "line")(8 . "图层1"))))(> (sslength ss) 1))
   
4.     (progn
   
5.       (setvar 'cmdecho 0)
   
6.       (setq bak_lay(getvar 'clayer))
   
7.       (setvar 'clayer "dim")
   
8.       (setq ss_lst(sk_ss->lst ss))
   
9.       (mapcar 'sk_line_ch_ang ss_lst)
   
10.       (setq sspt(mapcar '(lambda (x)(cons (sk_dxf x 10) x)) ss_lst))      
    
11.       (setq ss_lst(vl-sort ss_lst '(lambda(e1 e2)(if (equal (cadr (sk_dxf e1 10))(cadr (sk_dxf e2 10)) 1e-8)(< (car (sk_dxf e1 10))(car (sk_dxf e2 10)))(< (cadr (sk_dxf e1 10))(cadr (sk_dxf e2 10)))))))      
    
12.       (setq dimx_lst(mapcar '(lambda (x)(list (sk_dxf x 10) (sk_dxf x 11))) ss_lst))
    
13.       (setq dimy_lst(mapcar '(lambda (x)(list (sk_dxf x 11) (sk_dxf x 10))) ss_lst))
    
14.       (setq dimx_com(sk_com3 dimx_lst))
    
15.       (setq dimy_com(sk_com3 dimy_lst))
    
16.       (mapcar '(lambda (x)
    
17.       (setq p1 (car(car x))
    
18.             p2 (car(cadr x))
    
19.             p3 (polar p1 (angle (cadar x) p1 ) 1200))            
    
20.       (vl-cmdf "_.DIMALIGNED" "_end" p1 "_end" p2 "_non" p3)
    
21.                  )
    
22.               dimx_com)
    
23.       (mapcar '(lambda (x)
    
24.       (setq p1 (car(car x))
    
25.             p2 (car(cadr x))
    
26.             p3 (polar p1 (angle (cadar x) p1 ) 1200))            
    
27.       (vl-cmdf "_.DIMALIGNED" "_end" p1 "_end" p2 "_non" p3)
    
28.                  )
    
29.               dimy_com)
    
30.       (and bak_lay (setvar 'clayer bak_lay))
    
31.       (setvar 'cmdecho 1)
    
32.       )
    
33.     )
    
34.   (princ)
    
35.   )
    
36. ;; 直线格式化xyp
    
37. (defun sk_line_ch_ang (en / ang p1 p2 elist)
    
38.   (setq p1  (sk_dxf en 10 )
    
39.         p2  (sk_dxf en 11 )
    
40.         ang (angle p1 p2)
    
41.         elist(entget en)
    
42.   )
    
43.   (if (or (equal ang pi 1e-3)
    
44.           (and (>= ang pi)
    
45.                (not (equal ang (* 2 pi) 1e-3))
    
46.           )
    
47.       )
    
48.     (progn      
    
49.       (setq elist(subst (cons 10 p2)(assoc 10 elist) elist)
    
50.             elist(subst (cons 11 p1)(assoc 11 elist) elist))
    
51.       (entmod elist)
    
52.       )
    
53.     )
    
54.   en
    
55.   )
    
56. ;;选择集转表
    
57. (defun sk_ss->lst (SS)
    
58.   (vl-remove-if-not '(lambda(X)(= (type X) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
    
59. )
    
60. ;;组合函数3表中相邻元素组成新表
    
61. (defun sk_com3(lst)
    
62.   (if(cdr lst)
    
63.     (append (list(list (car lst)(cadr lst)))(sk_com3 (cdr lst)) )
    
64.     )
    
65.   )
    
66. ;;;组码值提取(sk_dxf 图元名 组码)
    
67. (defun sk_dxf(en code)
    
68.     (if(and(=(type en) 'ENAME)(= (type code) 'INT))
    
69.       (cdr(assoc code (entget en))))
    
70.   )
    

;快速标注<br /> (defun c:tt(/ bak_lay dimx_com dimx_lst dimy_com dimy_lst p1 p2 p3 ss sspt ss_lst x)<br />   (if(and (setq ss(ssget '((0 . "line")(8 . "图层1"))))(> (sslength ss) 1))<br />     (progn<br />       (setvar 'cmdecho 0)<br />       (setq bak_lay(getvar 'clayer))<br />       (setvar 'clayer "dim")<br />       (setq ss_lst(sk_ss->lst ss))<br />       (mapcar 'sk_line_ch_ang ss_lst)<br />       (setq sspt(mapcar '(lambda (x)(cons (sk_dxf x 10) x)) ss_lst))      <br />       (setq ss_lst(vl-sort ss_lst '(lambda(e1 e2)(if (equal (cadr (sk_dxf e1 10))(cadr (sk_dxf e2 10)) 1e-8)(< (car (sk_dxf e1 10))(car (sk_dxf e2 10)))(< (cadr (sk_dxf e1 10))(cadr (sk_dxf e2 10)))))))      <br />       (setq dimx_lst(mapcar '(lambda (x)(list (sk_dxf x 10) (sk_dxf x 11))) ss_lst))<br />       (setq dimy_lst(mapcar '(lambda (x)(list (sk_dxf x 11) (sk_dxf x 10))) ss_lst))<br />       (setq dimx_com(sk_com3 dimx_lst))<br />       (setq dimy_com(sk_com3 dimy_lst))<br />       (mapcar '(lambda (x)<br />       (setq p1 (car(car x))<br />             p2 (car(cadr x))<br />             p3 (polar p1 (angle (cadar x) p1 ) 1200))            <br />       (vl-cmdf "_.DIMALIGNED" "_end" p1 "_end" p2 "_non" p3)<br />                  )<br />               dimx_com)<br />       (mapcar '(lambda (x)<br />       (setq p1 (car(car x))<br />             p2 (car(cadr x))<br />             p3 (polar p1 (angle (cadar x) p1 ) 1200))            <br />       (vl-cmdf "_.DIMALIGNED" "_end" p1 "_end" p2 "_non" p3)<br />                  )<br />               dimy_com)<br />       (and bak_lay (setvar 'clayer bak_lay))<br />       (setvar 'cmdecho 1)<br />       )<br />     )<br />   (princ)<br />   )<br /> ;; 直线格式化xyp<br /> (defun sk_line_ch_ang (en / ang p1 p2 elist)<br />   (setq p1  (sk_dxf en 10 )<br />         p2  (sk_dxf en 11 )<br />         ang (angle p1 p2)<br />         elist(entget en)<br />   )<br />   (if (or (equal ang pi 1e-3)<br />           (and (>= ang pi)<br />                (not (equal ang (* 2 pi) 1e-3))<br />           )<br />       )<br />     (progn      <br />       (setq elist(subst (cons 10 p2)(assoc 10 elist) elist)<br />             elist(subst (cons 11 p1)(assoc 11 elist) elist))<br />       (entmod elist)<br />       )<br />     )<br />   en<br />   )<br /> ;;选择集转表<br /> (defun sk_ss->lst (SS)<br />   (vl-remove-if-not '(lambda(X)(= (type X) 'ENAME)) (mapcar 'cadr (ssnamex SS)))<br /> )<br /> ;;组合函数3表中相邻元素组成新表<br /> (defun sk_com3(lst)<br />   (if(cdr lst)<br />     (append (list(list (car lst)(cadr lst)))(sk_com3 (cdr lst)) )<br />     )<br />   )<br /> ;;;组码值提取(sk_dxf 图元名 组码)<br /> (defun sk_dxf(en code)<br />     (if(and(=(type en) 'ENAME)(= (type code) 'INT))<br />       (cdr(assoc code (entget en))))<br />   )<br />

fire9527

edata 发表于 2015-8-21 15:38

老大的反应真是无敌的快速，高效完美！小弟拜谢！