求改通过选择对象来识别图层的与设置字高

flytoday

；；梁线层名为11-Y；中心线层名为5；标注的梁宽层为当前层。
(vl-load-com)
(defun x_ssn (ss / n lst)
  (repeat (setq N (sslength ss))
    (setq LST (cons (ssname SS (setq N (1- N))) LST))
  )
)
(defun t_mak (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)
  (entmake (list '(0 . "text")
     '(100 . "AcDbEntity")
     (cons 8 l_n)
     '(100 . "AcDbText")
     (cons 10 t_10)
     (cons 1 t_t)
     (cons 40 t_h)
     (cons 41 t_w)
     (cons 7 t_st)
     (cons 72 t_72)
     (cons 11 t_11)
     (cons 50 t_50)
     (cons 73 t_73)
     ) ;_ 结束list
  ) ;_ 结束entmake
) ;_ 结束defun
(defun ch_dxf (en num ch / old_num new_num ent)
  (if (setq ent      (entget en)
      new_num (cons num ch)
      old_num (assoc num ent)
      )
    (entmod (subst new_num old_num ent))
    (entmod (reverse (cons new_num (reverse ent))))
  )
)
(defun beam_w (en lay / ent pt1 pt2 mid_pt ang n ss dist)
;;;  (setq en (car(entsel)) lay "11-Y")
  (setq ent (entget en))
  (setq  pt1 (cdr (assoc 10 ent))
  pt2 (cdr (assoc 11 ent))
  )
  (setq mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2))
  (setq ang (angle pt1 pt2))
  (setq n 0)
  (while
    (= nil
       (setq ss
        (ssget "f"
         (list (polar mid_pt (+ ang (/ pi 2)) (+ 76 (* n 25)))
         (polar mid_pt (+ ang (/ pi -2)) (+ 76 (* n 25)))
         )
         (list '(0 . "line") (cons 8 lay))
        )
       )
    )
     (setq n (1+ n))
  )
  (setq  dist (*  2
    (distance mid_pt
        (vlax-curve-getClosestPointTo
          (vlax-ename->vla-object (ssname ss 0))
          mid_pt
        )
    )
       )
  )
  (t_mak "0"
   '(0 0 0)
   mid_pt
   (strcat "梁宽" (rtos dist))
   ang
   1
   0
   250
   0.75
   "standard"
  )
  dist
)
(defun m_dela (m_list / x m_list1)
  (setq m_list1 nil)
  (mapcar '(lambda (x)
       (if (not (member x m_list1))
         (setq m_list1 (cons x m_list1))
       )
     )
    m_list
  )
  (setq m_list (reverse m_list1))
)
(defun c:test1 (/ ss1 ss2 lst1 lst2 n)
(setq ss1 (ssget '((0 . "line") (8 . "5"))))
  (setq ss2 (ssget "X" '((0 . "line") (8 . "11-Y"))))
  (mapcar '(lambda (x) (ch_dxf x 6 "continuous")) (x_ssn ss2))
  (setq  lst1 (mapcar '(lambda (x) (list (rtos (beam_w x "11-Y")) x))
         (x_ssn ss1)
       )
  )
  (setq
    lst2 (m_dela
     (mapcar '(lambda (x) (rtos (beam_w x "11-Y"))) (x_ssn ss1))
   )
  )
  (setq n 0)
  (while (< n (length lst2))
    (mapcar '(lambda (x)
         (if (member (nth n lst2) x)
     (vla-put-color (vlax-ename->vla-object (cadr x)) (1+ n))
     t
         )
       )
      lst1
    )
    (setq n (1+ n))
  )
  (mapcar '(lambda (x) (ch_dxf x 6 "DASH")) (x_ssn ss2))
  (princ)
)

x_s_s_1

使用前先将虚线变为实线，我将那部分注释掉了，要加那部分处理的话，原有的代码是不够的，要考虑考虑

2. (vl-load-com)
   
3. (defun x_ssn (ss / n lst)
   
4.   (repeat (setq N (sslength ss))
   
5.     (setq LST (cons (ssname SS (setq N (1- N))) LST))
   
6.   )
   
7. )
   
8. (defun t_mak (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)
   
9.   (entmake (list '(0 . "text")
   
10.                  '(100 . "AcDbEntity")
    
11.                  (cons 8 l_n)
    
12.                  '(100 . "AcDbText")
    
13.                  (cons 10 t_10)
    
14.                  (cons 1 t_t)
    
15.                  (cons 40 t_h)
    
16.                  (cons 41 t_w)
    
17.                  (cons 7 t_st)
    
18.                  (cons 72 t_72)
    
19.                  (cons 11 t_11)
    
20.                  (cons 50 t_50)
    
21.                  (cons 73 t_73)
    
22.            ) ;_ 结束list
    
23.   ) ;_ 结束entmake
    
24. ) ;_ 结束defun
    
25. (defun ch_dxf (en num ch / old_num new_num ent)
    
26.   (if (setq ent            (entget en)
    
27.             new_num (cons num ch)
    
28.             old_num (assoc num ent)
    
29.       )
    
30.     (entmod (subst new_num old_num ent))
    
31.     (entmod (reverse (cons new_num (reverse ent))))
    
32.   )
    
33. )
    
34. (defun beam_wt (en lay t_h / ent pt1 pt2 mid_pt ang n ss dist)
    
35. ;;;  (setq en (car(entsel)) lay "11-Y")
    
36.   (setq ent (entget en))
    
37.   (setq        pt1 (cdr (assoc 10 ent))
    
38.         pt2 (cdr (assoc 11 ent))
    
39.   )
    
40.   (setq mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2))
    
41.   (setq ang (angle pt1 pt2))
    
42.   (setq n 0)
    
43.   (while
    
44.     (= nil
    
45.        (setq ss
    
46.               (ssget "f"
    
47.                      (list (polar mid_pt (+ ang (/ pi 2)) (+ 76 (* n 25)))
    
48.                            (polar mid_pt (+ ang (/ pi -2)) (+ 76 (* n 25)))
    
49.                      )
    
50.                      (list '(0 . "line") (cons 8 lay))
    
51.               )
    
52.        )
    
53.     )
    
54.      (setq n (1+ n))
    
55.   )
    
56.   (setq        dist (*        2
    
57.                 (distance mid_pt
    
58.                           (vlax-curve-getClosestPointTo
    
59.                             (vlax-ename->vla-object (ssname ss 0))
    
60.                             mid_pt
    
61.                           )
    
62.                 )
    
63.              )
    
64.   )
    
65.   (t_mak "0"
    
66.          '(0 0 0)
    
67.          mid_pt
    
68.          (strcat "梁宽" (rtos dist))
    
69.          ang
    
70.          1
    
71.          0
    
72.          t_h
    
73.          0.75
    
74.          "standard"
    
75.   )
    
76.   dist
    
77. )
    
78. (defun beam_w (en lay / ent pt1 pt2 mid_pt ang n ss)
    
79.   (setq ent (entget en))
    
80.   (setq        pt1 (cdr (assoc 10 ent))
    
81.         pt2 (cdr (assoc 11 ent))
    
82.   )
    
83.   (setq mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2))
    
84.   (setq ang (angle pt1 pt2))
    
85.   (setq n 0)
    
86.   (while
    
87.     (= nil
    
88.        (setq ss
    
89.               (ssget "f"
    
90.                      (list (polar mid_pt (+ ang (/ pi 2)) (+ 76 (* n 25)))
    
91.                            (polar mid_pt (+ ang (/ pi -2)) (+ 76 (* n 25)))
    
92.                      )
    
93.                      (list '(0 . "line") (cons 8 lay))
    
94.               )
    
95.        )
    
96.     )
    
97.      (setq n (1+ n))
    
98.   )
    
99. (*        2
    
100.                 (distance mid_pt
     
101.                           (vlax-curve-getClosestPointTo
     
102.                             (vlax-ename->vla-object (ssname ss 0))
     
103.                             mid_pt
     
104.                           )
     
105.                 )
     
106.              )
     
107. )
     
108. (defun m_dela (m_list / x m_list1)
     
109.   (setq m_list1 nil)
     
110.   (mapcar '(lambda (x)
     
111.              (if (not (member x m_list1))
     
112.                (setq m_list1 (cons x m_list1))
     
113.              )
     
114.            )
     
115.           m_list
     
116.   )
     
117.   (setq m_list (reverse m_list1))
     
118. )
     
119. (defun c:test1 (/ ss1 ss2 lst1 lst2 n lay1 lay2 t_h)
     
120.   (setq lay1 (cdr(assoc 8 (entget(car(entsel "\n拾取中心线层："))))))
     
121.   (setq lay2 (cdr(assoc 8 (entget(car(entsel "\n拾取梁线层："))))))
     
122.   (setq t_h (getreal "\n输入字高："))
     
123.   (setq ss1 (ssget (list '(0 . "line") (cons 8 lay1))))
     
124. ;;;  (setq ss2 (ssget "X" '((0 . "line") (8 . "11-Y"))))
     
125. ;;;  (mapcar '(lambda (x) (ch_dxf x 6 "continuous")) (x_ssn ss2))
     
126.   (setq        lst1 (mapcar '(lambda (x) (list (rtos (beam_wt x lay2 t_h)) x))
     
127.                      (x_ssn ss1)
     
128.              )
     
129.   )
     
130.   (setq
     
131.     lst2 (m_dela
     
132.            (mapcar '(lambda (x) (rtos (beam_w x lay2))) (x_ssn ss1))
     
133.          )
     
134.   )
     
135.   (setq n 0)
     
136.   (while (< n (length lst2))
     
137.     (mapcar '(lambda (x)
     
138.                (if (member (nth n lst2) x)
     
139.                  (vla-put-color (vlax-ename->vla-object (cadr x)) (1+ n))
     
140.                  t
     
141.                )
     
142.              )
     
143.             lst1
     
144.     )
     
145.     (setq n (1+ n))
     
146.   )
     
147. ;;;  (mapcar '(lambda (x) (ch_dxf x 6 "DASH")) (x_ssn ss2))
     
148.   (princ)
     
149. )
     

(vl-load-com)<br /> (defun x_ssn (ss / n lst)<br />   (repeat (setq N (sslength ss))<br />     (setq LST (cons (ssname SS (setq N (1- N))) LST))<br />   )<br /> )<br /> (defun t_mak (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)<br />   (entmake (list '(0 . "text")<br />                  '(100 . "AcDbEntity")<br />                  (cons 8 l_n)<br />                  '(100 . "AcDbText")<br />                  (cons 10 t_10)<br />                  (cons 1 t_t)<br />                  (cons 40 t_h)<br />                  (cons 41 t_w)<br />                  (cons 7 t_st)<br />                  (cons 72 t_72)<br />                  (cons 11 t_11)<br />                  (cons 50 t_50)<br />                  (cons 73 t_73)<br />            ) ;_ 结束list<br />   ) ;_ 结束entmake<br /> ) ;_ 结束defun<br /> (defun ch_dxf (en num ch / old_num new_num ent)<br />   (if (setq ent            (entget en)<br />             new_num (cons num ch)<br />             old_num (assoc num ent)<br />       )<br />     (entmod (subst new_num old_num ent))<br />     (entmod (reverse (cons new_num (reverse ent))))<br />   )<br /> )<br /> (defun beam_wt (en lay t_h / ent pt1 pt2 mid_pt ang n ss dist)<br /> ;;;  (setq en (car(entsel)) lay "11-Y")<br />   (setq ent (entget en))<br />   (setq        pt1 (cdr (assoc 10 ent))<br />         pt2 (cdr (assoc 11 ent))<br />   )<br />   (setq mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2))<br />   (setq ang (angle pt1 pt2))<br />   (setq n 0)<br />   (while<br />     (= nil<br />        (setq ss<br />               (ssget "f"<br />                      (list (polar mid_pt (+ ang (/ pi 2)) (+ 76 (* n 25)))<br />                            (polar mid_pt (+ ang (/ pi -2)) (+ 76 (* n 25)))<br />                      )<br />                      (list '(0 . "line") (cons 8 lay))<br />               )<br />        )<br />     )<br />      (setq n (1+ n))<br />   )<br />   (setq        dist (*        2<br />                 (distance mid_pt<br />                           (vlax-curve-getClosestPointTo<br />                             (vlax-ename->vla-object (ssname ss 0))<br />                             mid_pt<br />                           )<br />                 )<br />              )<br />   )<br />   (t_mak "0"<br />          '(0 0 0)<br />          mid_pt<br />          (strcat "梁宽" (rtos dist))<br />          ang<br />          1<br />          0<br />          t_h<br />          0.75<br />          "standard"<br />   )<br />   dist<br /> )<br /> (defun beam_w (en lay / ent pt1 pt2 mid_pt ang n ss)<br />   (setq ent (entget en))<br />   (setq        pt1 (cdr (assoc 10 ent))<br />         pt2 (cdr (assoc 11 ent))<br />   )<br />   (setq mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2))<br />   (setq ang (angle pt1 pt2))<br />   (setq n 0)<br />   (while<br />     (= nil<br />        (setq ss<br />               (ssget "f"<br />                      (list (polar mid_pt (+ ang (/ pi 2)) (+ 76 (* n 25)))<br />                            (polar mid_pt (+ ang (/ pi -2)) (+ 76 (* n 25)))<br />                      )<br />                      (list '(0 . "line") (cons 8 lay))<br />               )<br />        )<br />     )<br />      (setq n (1+ n))<br />   )<br /> (*        2<br />                 (distance mid_pt<br />                           (vlax-curve-getClosestPointTo<br />                             (vlax-ename->vla-object (ssname ss 0))<br />                             mid_pt<br />                           )<br />                 )<br />              )<br /> )<br /> (defun m_dela (m_list / x m_list1)<br />   (setq m_list1 nil)<br />   (mapcar '(lambda (x)<br />              (if (not (member x m_list1))<br />                (setq m_list1 (cons x m_list1))<br />              )<br />            )<br />           m_list<br />   )<br />   (setq m_list (reverse m_list1))<br /> )<br /> (defun c:test1 (/ ss1 ss2 lst1 lst2 n lay1 lay2 t_h)<br />   (setq lay1 (cdr(assoc 8 (entget(car(entsel "\n拾取中心线层："))))))<br />   (setq lay2 (cdr(assoc 8 (entget(car(entsel "\n拾取梁线层："))))))<br />   (setq t_h (getreal "\n输入字高："))<br />   (setq ss1 (ssget (list '(0 . "line") (cons 8 lay1))))<br /> ;;;  (setq ss2 (ssget "X" '((0 . "line") (8 . "11-Y"))))<br /> ;;;  (mapcar '(lambda (x) (ch_dxf x 6 "continuous")) (x_ssn ss2))<br />   (setq        lst1 (mapcar '(lambda (x) (list (rtos (beam_wt x lay2 t_h)) x))<br />                      (x_ssn ss1)<br />              )<br />   )<br />   (setq<br />     lst2 (m_dela<br />            (mapcar '(lambda (x) (rtos (beam_w x lay2))) (x_ssn ss1))<br />          )<br />   )<br />   (setq n 0)<br />   (while (< n (length lst2))<br />     (mapcar '(lambda (x)<br />                (if (member (nth n lst2) x)<br />                  (vla-put-color (vlax-ename->vla-object (cadr x)) (1+ n))<br />                  t<br />                )<br />              )<br />             lst1<br />     )<br />     (setq n (1+ n))<br />   )<br /> ;;;  (mapcar '(lambda (x) (ch_dxf x 6 "DASH")) (x_ssn ss2))<br />   (princ)<br /> )<br />

flytoday

求路过的大师改下通过选择对象来识别图层。。并进行设置标注字高。。~

谢谢~

革天明

留位，难度好像不大

xiabin68

看看，，，，，，，

wowan1314

到哪都是有钱人的天下。 楼主省心又省力呀。

zzc83

感谢的热心帮助

zzc83

感谢的xss1热心帮助