大师求助，为何直线没有在标注下，而是在标注线上？

ferious

2. 
   
3. (defun c:bzl(/   ss      ssh     ssv     i        ent    rate
   
4.         pt      dim     n        dimstyle        ssdimstyle
   
5.         ssdimstyle      hz0     hzqj   hz      hb      pt2x
   
6.         pt1x    pt1y    pt2y    pt1     pt2
   
7.        )
   
8.   (setvar "cmdecho" 0)
   
9.   (princ "\n选择标注集合")
   
10.   (setq ss (ssget '((0 . "DIMENSION"))))
    
11.   (setq ssh (ssadd))
    
12.   (setq ssv (ssadd))
    
13.   (setq i 0)
    
14.   (repeat (sslength ss)
    
15.         
    
16.          
    
17.     (setq ent (ssname ss i))
    
18.     (if  (= 0 (cdr (assoc 50 (entget ent))));cdr对点对列表操作掐头，cadr有问题
    
19.       (setq ssh (ssadd ent ssh))
    
20.       (setq ssv (ssadd ent ssv))
    
21.     )
    
22.     (setq i (1+ i))
    
23.     (princ (sslength ssh))
    
24.     (princ "\n")
    
25.     (princ (sslength ssv))
    
26.     (prin1)
    
27.   );end repeat;选择集分开为横竖
    
28.   
    
29.   (setq i 0)
    
30.   (setq rate 0.2);0.2为和有问题？
    
31. 
    
32.   (repeat (sslength ssh)
    
33.     (setq ent (ssname ssh i))
    
34.     (setq pt (cdr (assoc 10 (entget ent))))
    
35.     (setq dim (cdr (assoc 42 (entget ent))))
    
36.     (setq n (1+ (fix (/ (log dim) (log 10)))))
    
37.     (setq dimstyle (cdr (assoc 3 (entget ent))))
    
38.     (setq ssdimstyle (tblobjname "DIMSTYLE" dimstyle))
    
39.           ;标注样式名反选标注样式
    
40.     (setq hz0 (cdr (assoc 140 (entget ssdimstyle)))) ;标注样式文字高度
    
41. 
    
42. 
    
43.     (setq hzqj (cdr (assoc 40 (entget ssdimstyle))))
    
44.           ;全局比例为1返回空值
    
45.     (if  (= nil hzqj)
    
46.       (setq hzqj 1)
    
47.     )
    
48. 
    
49.     (setq hz (* hzqj hz0))
    
50.     (setq hb (* hz n))
    
51.     (setq pt2x (- (car pt) (abs (* 0.5 (- hb dim)))))
    
52.    
    
53.     (setq pt1x (- pt2x hb))
    
54.     (setq gaodu (* hz rate))
    
55.     (setq pt1y (- (cadr pt) (* hz rate)))
    
56.     (setq pt2y pt1y)
    
57.     (setq pt1 (list pt1x pt1y (caddr pt) ))
    
58.     (setq pt2 (list pt2x pt2y (caddr pt) ))
    
59.     ;(command "circle" pt1 6)
    
60.     (command "line" pt1 pt2 "")
    
61.     (setq i (1+ i))
    
62.   );end repeat
    
63. 
    
64.   (prin1)
    
65. )
    
66. 
    
67. 
    
68. 
    
69. 
    
70. 
    
71. 
    
72. 
    
73. 
    
74. 
    

<br /> (defun c:bzl(/   ss      ssh     ssv     i        ent    rate<br />         pt      dim     n        dimstyle        ssdimstyle<br />         ssdimstyle      hz0     hzqj   hz      hb      pt2x<br />         pt1x    pt1y    pt2y    pt1     pt2<br />        )<br />   (setvar "cmdecho" 0)<br />   (princ "\n选择标注集合")<br />   (setq ss (ssget '((0 . "DIMENSION"))))<br />   (setq ssh (ssadd))<br />   (setq ssv (ssadd))<br />   (setq i 0)<br />   (repeat (sslength ss)<br />         <br />           <br />     (setq ent (ssname ss i))<br />     (if  (= 0 (cdr (assoc 50 (entget ent))));cdr对点对列表操作掐头，cadr有问题<br />       (setq ssh (ssadd ent ssh))<br />       (setq ssv (ssadd ent ssv))<br />     )<br />     (setq i (1+ i))<br />     (princ (sslength ssh))<br />     (princ "\n")<br />     (princ (sslength ssv))<br />     (prin1)<br />   );end repeat;选择集分开为横竖<br />   <br />   (setq i 0)<br />   (setq rate 0.2);0.2为和有问题？<br /> <br />   (repeat (sslength ssh)<br />     (setq ent (ssname ssh i))<br />     (setq pt (cdr (assoc 10 (entget ent))))<br />     (setq dim (cdr (assoc 42 (entget ent))))<br />     (setq n (1+ (fix (/ (log dim) (log 10)))))<br />     (setq dimstyle (cdr (assoc 3 (entget ent))))<br />     (setq ssdimstyle (tblobjname "DIMSTYLE" dimstyle))<br />           ;标注样式名反选标注样式<br />     (setq hz0 (cdr (assoc 140 (entget ssdimstyle)))) ;标注样式文字高度<br /> <br /> <br />     (setq hzqj (cdr (assoc 40 (entget ssdimstyle))))<br />           ;全局比例为1返回空值<br />     (if  (= nil hzqj)<br />       (setq hzqj 1)<br />     )<br /> <br />     (setq hz (* hzqj hz0))<br />     (setq hb (* hz n))<br />     (setq pt2x (- (car pt) (abs (* 0.5 (- hb dim)))))<br />     <br />     (setq pt1x (- pt2x hb))<br />     (setq gaodu (* hz rate))<br />     (setq pt1y (- (cadr pt) (* hz rate)))<br />     (setq pt2y pt1y)<br />     (setq pt1 (list pt1x pt1y (caddr pt) ))<br />     (setq pt2 (list pt2x pt2y (caddr pt) ))<br />     ;(command "circle" pt1 6)<br />     (command "line" pt1 pt2 "")<br />     (setq i (1+ i))<br />   );end repeat<br /> <br />   (prin1)<br /> )<br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br />

飞雪神光

1. (defun c:ddr (/ bili crpt en get-dxf huajuxing l lm-entmake-layer lm-entmake-pline lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg)
   
2.   (defun get-dxf(en n)
   
3.     (if (not (listp en)) (setq en (entget en)))
   
4.     (cdr (assoc n en))
   
5.   )
   
6.   (defun ss-enlst (ss / enlst)
   
7.     (cond
   
8.       ((= (type ss) 'PICKSET)
   
9.         (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
   
10.       )
    
11.       ((= (type ss) 'LIST)
    
12.         (setq enlst (ssadd))
    
13.         (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
    
14.       )
    
15.     )
    
16.   )
    
17.   (defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W)
    
18.     (Defun mxv (m v)
    
19.       (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
    
20.     )
    
21.     (setq enx (entget obj))
    
22.     (if (null off)
    
23.       (setq off 0.0)
    
24.     )
    
25.     (if
    
26.       (setq l
    
27.         (cond
    
28.           ((= "TEXT" (cdr (assoc 0 enx)))
    
29.             (setq b (cdr (assoc 10 enx))
    
30.               r (cdr (assoc 50 enx))
    
31.               l (textbox enx)
    
32.             )
    
33.             (list
    
34.               (list (- (caar l) offh) (- (cadar l) offs))
    
35.               (list (+ (caadr l) offh) (- (cadar l) offs))
    
36.               (list (+ (caadr l) offh) (+ (cadadr l) offs))
    
37.               (list (- (caar l) offh) (+ (cadadr l) offs))
    
38.             )
    
39.           )
    
40.           ((= "MTEXT" (cdr (assoc 0 enx)))
    
41.             (setq n (cdr (assoc 210 enx))
    
42.               b (trans (cdr (assoc 10 enx)) 0 n)
    
43.               r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
    
44.               w (cdr (assoc 42 enx))
    
45.               h (cdr (assoc 43 enx))
    
46.               j (cdr (assoc 71 enx))
    
47.               o (list
    
48.                   (cond
    
49.                     ((member j '(2 5 8)) (/ w -2.0))
    
50.                     ((member j '(3 6 9)) (- w))
    
51.                     (0.0)
    
52.                   )
    
53.                   (cond
    
54.                     ((member j '(1 2 3)) (- h))
    
55.                     ((member j '(4 5 6)) (/ h -2.0))
    
56.                     (0.0)
    
57.                   )
    
58.                 )
    
59.             )
    
60.             (list
    
61.               (list (- (car o) offh) (- (cadr o) offs))
    
62.               (list (+ (car o) w offh) (- (cadr o) offs))
    
63.               (list (+ (car o) w offh) (+ (cadr o) h offs))
    
64.               (list (- (car o) offh) (+ (cadr o) h offs))
    
65.             )
    
66.           )
    
67.         )
    
68.       )
    
69.       ((lambda (m)
    
70.          (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
    
71.        )
    
72.         (list
    
73.           (list (cos r) (sin (- r)) 0.0)
    
74.           (list (sin r) (cos r) 0.0)
    
75.           '(0.0 0.0 1.0)
    
76.         )
    
77.       )
    
78.     )
    
79.   )
    
80.   (defun lm-entmake-pline (pldata / a s1 ptlst bihe co tc h)
    
81.     (mapcar'set '(ptlst bihe co tc) pldata)
    
82.     (or co (setq co 256))
    
83.     (or tc (setq tc (getvar "clayer")))
    
84.     (entmake (append (list
    
85.                        '(0 . "LWPOLYLINE")
    
86.                        '(100 . "AcDbEntity")
    
87.                        '(100 . "AcDbPolyline")
    
88.                        (cons 62 co)
    
89.                        (cons 8 tc)
    
90.                        (cons 90 (length ptlst))
    
91.                        (cons 70 (if bihe 1 0))
    
92.                        (cons 38 (if (setq h(nth 2 (car ptlst))) h 0))
    
93.                      )
    
94.                (mapcar '(lambda (a) (cons 10 a)) ptlst))
    
95.     )
    
96.     (entlast)
    
97.   )
    
98.   (defun lm-entmake-layer(datalst)
    
99.     (mapcar'set '(tc co) datalst)
    
100.     (or co (setq co 256))
     
101.     (or tc (setq tc (getvar "clayer")))
     
102.     (entmake (list '(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")(cons 2 tc)(cons 62 co)'(70 . 0)'(6 . "CONTINUOUS")))
     
103.   )
     
104.   (princ "\n选择标注集合")
     
105.   (setvar "cmdecho" 0)
     
106.   (if(null(tblsearch "layer" "DGWT-REV"))
     
107.     (lm-entmake-layer (list "DGWT-REV" 4))
     
108.   )
     
109.   (setq ss (ssget '((0 . "DIMENSION"))))
     
110.   (foreach bzty (ss-enlst ss)
     
111.     (setq obj (vlax-ename->vla-object bzty))
     
112.     (setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的匿名图元块的文字图元名
     
113.     (while (setq en(entnext en))  ;一直循环找到该匿名块中成员是文字为止
     
114.       (setq tylx (get-dxf en 0))
     
115.       (if (wcmatch tylx "*TEXT")
     
116.         (progn
     
117.           (setq zg(get-dxf en 40))
     
118.           (setq pts (lm-getmtextbox1 en (* zg 0.7)  (* zg 0.7)))
     
119.           (lm-entmake-pline (list pts t nil nil))
     
120.           (setq L (*  0.3 zg))
     
121.           (setq huajuxing (entlast))
     
122.           (command "revcloud" "S" "N" "a" L L "o" huajuxing "")
     
123.           (vla-put-Layer (vlax-ename->vla-object (entlast)) "DGWT-REV")
     
124.         )
     
125.       )
     
126.     )
     
127.   )
     
128.   (princ)
     
129. )

(defun c:ddr (/ bili crpt en get-dxf huajuxing l lm-entmake-layer lm-entmake-pline lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg)<br />   (defun get-dxf(en n)<br />     (if (not (listp en)) (setq en (entget en)))<br />     (cdr (assoc n en))<br />   )<br />   (defun ss-enlst (ss / enlst)<br />     (cond<br />       ((= (type ss) 'PICKSET)<br />         (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))<br />       )<br />       ((= (type ss) 'LIST)<br />         (setq enlst (ssadd))<br />         (last (mapcar '(lambda (x) (ssadd x enlst)) ss))<br />       )<br />     )<br />   )<br />   (defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W)<br />     (Defun mxv (m v)<br />       (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)<br />     )<br />     (setq enx (entget obj))<br />     (if (null off)<br />       (setq off 0.0)<br />     )<br />     (if<br />       (setq l<br />         (cond<br />           ((= "TEXT" (cdr (assoc 0 enx)))<br />             (setq b (cdr (assoc 10 enx))<br />               r (cdr (assoc 50 enx))<br />               l (textbox enx)<br />             )<br />             (list<br />               (list (- (caar l) offh) (- (cadar l) offs))<br />               (list (+ (caadr l) offh) (- (cadar l) offs))<br />               (list (+ (caadr l) offh) (+ (cadadr l) offs))<br />               (list (- (caar l) offh) (+ (cadadr l) offs))<br />             )<br />           )<br />           ((= "MTEXT" (cdr (assoc 0 enx)))<br />             (setq n (cdr (assoc 210 enx))<br />               b (trans (cdr (assoc 10 enx)) 0 n)<br />               r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))<br />               w (cdr (assoc 42 enx))<br />               h (cdr (assoc 43 enx))<br />               j (cdr (assoc 71 enx))<br />               o (list<br />                   (cond<br />                     ((member j '(2 5 8)) (/ w -2.0))<br />                     ((member j '(3 6 9)) (- w))<br />                     (0.0)<br />                   )<br />                   (cond<br />                     ((member j '(1 2 3)) (- h))<br />                     ((member j '(4 5 6)) (/ h -2.0))<br />                     (0.0)<br />                   )<br />                 )<br />             )<br />             (list<br />               (list (- (car o) offh) (- (cadr o) offs))<br />               (list (+ (car o) w offh) (- (cadr o) offs))<br />               (list (+ (car o) w offh) (+ (cadr o) h offs))<br />               (list (- (car o) offh) (+ (cadr o) h offs))<br />             )<br />           )<br />         )<br />       )<br />       ((lambda (m)<br />          (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)<br />        )<br />         (list<br />           (list (cos r) (sin (- r)) 0.0)<br />           (list (sin r) (cos r) 0.0)<br />           '(0.0 0.0 1.0)<br />         )<br />       )<br />     )<br />   )<br />   (defun lm-entmake-pline (pldata / a s1 ptlst bihe co tc h)<br />     (mapcar'set '(ptlst bihe co tc) pldata)<br />     (or co (setq co 256))<br />     (or tc (setq tc (getvar "clayer")))<br />     (entmake (append (list <br />                        '(0 . "LWPOLYLINE")<br />                        '(100 . "AcDbEntity")<br />                        '(100 . "AcDbPolyline")<br />                        (cons 62 co)<br />                        (cons 8 tc)<br />                        (cons 90 (length ptlst))<br />                        (cons 70 (if bihe 1 0))<br />                        (cons 38 (if (setq h(nth 2 (car ptlst))) h 0))<br />                      )<br />                (mapcar '(lambda (a) (cons 10 a)) ptlst))<br />     )<br />     (entlast)<br />   )<br />   (defun lm-entmake-layer(datalst)<br />     (mapcar'set '(tc co) datalst)<br />     (or co (setq co 256))<br />     (or tc (setq tc (getvar "clayer")))<br />     (entmake (list '(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")(cons 2 tc)(cons 62 co)'(70 . 0)'(6 . "CONTINUOUS")))<br />   )<br />   (princ "\n选择标注集合")<br />   (setvar "cmdecho" 0)<br />   (if(null(tblsearch "layer" "DGWT-REV"))<br />     (lm-entmake-layer (list "DGWT-REV" 4))<br />   )<br />   (setq ss (ssget '((0 . "DIMENSION"))))<br />   (foreach bzty (ss-enlst ss)<br />     (setq obj (vlax-ename->vla-object bzty))<br />     (setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的匿名图元块的文字图元名<br />     (while (setq en(entnext en))  ;一直循环找到该匿名块中成员是文字为止<br />       (setq tylx (get-dxf en 0))<br />       (if (wcmatch tylx "*TEXT")<br />         (progn<br />           (setq zg(get-dxf en 40))<br />           (setq pts (lm-getmtextbox1 en (* zg 0.7)  (* zg 0.7)))<br />           (lm-entmake-pline (list pts t nil nil))<br />           (setq L (*  0.3 zg))<br />           (setq huajuxing (entlast))<br />           (command "revcloud" "S" "N" "a" L L "o" huajuxing "")<br />           (vla-put-Layer (vlax-ename->vla-object (entlast)) "DGWT-REV")<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

飞雪神光

1. (defun c:bzl (/ bili crpt en get-dxf lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg)
   
2.         (defun get-dxf(en n)
   
3.                 (if (not (listp en)) (setq en (entget en)))
   
4.                 (cdr (assoc n en))
   
5.         )
   
6.         (defun ss-enlst (ss / enlst)
   
7.                 (cond
   
8.                         ((= (type ss) 'PICKSET)
   
9.                                 (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
   
10.                         )
    
11.                         ((= (type ss) 'LIST)
    
12.                                 (setq enlst (ssadd))
    
13.                                 (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
    
14.                         )
    
15.                 )
    
16.         )
    
17.         (defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W)
    
18.                 (Defun mxv (m v)
    
19.                         (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
    
20.                 )
    
21.                 (setq enx (entget obj))
    
22.                 (if (null off)
    
23.                         (setq off 0.0)
    
24.                 )
    
25.                 (if
    
26.                         (setq l
    
27.                                 (cond
    
28.                                         ((= "TEXT" (cdr (assoc 0 enx)))
    
29.                                                 (setq b (cdr (assoc 10 enx))
    
30.                                                         r (cdr (assoc 50 enx))
    
31.                                                         l (textbox enx)
    
32.                                                 )
    
33.                                                 (list
    
34.                                                         (list (- (caar l) offh) (- (cadar l) offs))
    
35.                                                         (list (+ (caadr l) offh) (- (cadar l) offs))
    
36.                                                         (list (+ (caadr l) offh) (+ (cadadr l) offs))
    
37.                                                         (list (- (caar l) offh) (+ (cadadr l) offs))
    
38.                                                 )
    
39.                                         )
    
40.                                         ((= "MTEXT" (cdr (assoc 0 enx)))
    
41.                                                 (setq n (cdr (assoc 210 enx))
    
42.                                                         b (trans (cdr (assoc 10 enx)) 0 n)
    
43.                                                         r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
    
44.                                                         w (cdr (assoc 42 enx))
    
45.                                                         h (cdr (assoc 43 enx))
    
46.                                                         j (cdr (assoc 71 enx))
    
47.                                                         o (list
    
48.                                                                         (cond
    
49.                                                                                 ((member j '(2 5 8)) (/ w -2.0))
    
50.                                                                                 ((member j '(3 6 9)) (- w))
    
51.                                                                                 (0.0)
    
52.                                                                         )
    
53.                                                                         (cond
    
54.                                                                                 ((member j '(1 2 3)) (- h))
    
55.                                                                                 ((member j '(4 5 6)) (/ h -2.0))
    
56.                                                                                 (0.0)
    
57.                                                                         )
    
58.                                                                 )
    
59.                                                 )
    
60.                                                 (list
    
61.                                                         (list (- (car o) offh) (- (cadr o) offs))
    
62.                                                         (list (+ (car o) w offh) (- (cadr o) offs))
    
63.                                                         (list (+ (car o) w offh) (+ (cadr o) h offs))
    
64.                                                         (list (- (car o) offh) (+ (cadr o) h offs))
    
65.                                                 )
    
66.                                         )
    
67.                                 )
    
68.                         )
    
69.                         ((lambda (m)
    
70.                                  (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
    
71.                          )
    
72.                                 (list
    
73.                                         (list (cos r) (sin (- r)) 0.0)
    
74.                                         (list (sin r) (cos r) 0.0)
    
75.                                         '(0.0 0.0 1.0)
    
76.                                 )
    
77.                         )
    
78.                 )
    
79.         )
    
80.   (princ "\n选择标注集合")
    
81.   (setq ss (ssget '((0 . "DIMENSION"))))
    
82.   (foreach bzty (ss-enlst ss)
    
83.                 (setq obj (vlax-ename->vla-object bzty))
    
84.                 (setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的图元名
    
85.                 (setq crpt(get-dxf bzty 11))
    
86.                 (setq tc(get-dxf bzty 8))
    
87.                 (setq bili(vla-get-ScaleFactor obj))
    
88.                 ;(if(= (vla-get-ObjectName obj) "AcDbRotatedDimension")
    
89.                 (while (setq en(entnext en))
    
90.                         (setq tylx (get-dxf en 0))
    
91.                         (if (wcmatch tylx "*TEXT")
    
92.                                 (progn
    
93.                                         (setq zg(get-dxf en 40))
    
94.                                         (setq pts (lm-getmtextbox1 en 0 (* zg 0.15)))
    
95.                                         (entmake (list '(0 . "line")(cons 62 1)(cons 8 "0")(cons 10 (car pts))(cons 11 (cadr pts))))
    
96.                                 )
    
97.                         )
    
98.                 )
    
99.                 ;)
    
100.         )
     
101.         (princ)
     
102. )

(defun c:bzl (/ bili crpt en get-dxf lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg)<br />         (defun get-dxf(en n)<br />                 (if (not (listp en)) (setq en (entget en)))<br />                 (cdr (assoc n en))<br />         )<br />         (defun ss-enlst (ss / enlst)<br />                 (cond<br />                         ((= (type ss) 'PICKSET)<br />                                 (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))<br />                         )<br />                         ((= (type ss) 'LIST)<br />                                 (setq enlst (ssadd))<br />                                 (last (mapcar '(lambda (x) (ssadd x enlst)) ss))<br />                         )<br />                 )<br />         )<br />         (defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W)<br />                 (Defun mxv (m v)<br />                         (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)<br />                 )<br />                 (setq enx (entget obj))<br />                 (if (null off)<br />                         (setq off 0.0)<br />                 )<br />                 (if<br />                         (setq l<br />                                 (cond<br />                                         ((= "TEXT" (cdr (assoc 0 enx)))<br />                                                 (setq b (cdr (assoc 10 enx))<br />                                                         r (cdr (assoc 50 enx))<br />                                                         l (textbox enx)<br />                                                 )<br />                                                 (list<br />                                                         (list (- (caar l) offh) (- (cadar l) offs))<br />                                                         (list (+ (caadr l) offh) (- (cadar l) offs))<br />                                                         (list (+ (caadr l) offh) (+ (cadadr l) offs))<br />                                                         (list (- (caar l) offh) (+ (cadadr l) offs))<br />                                                 )<br />                                         )<br />                                         ((= "MTEXT" (cdr (assoc 0 enx)))<br />                                                 (setq n (cdr (assoc 210 enx))<br />                                                         b (trans (cdr (assoc 10 enx)) 0 n)<br />                                                         r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))<br />                                                         w (cdr (assoc 42 enx))<br />                                                         h (cdr (assoc 43 enx))<br />                                                         j (cdr (assoc 71 enx))<br />                                                         o (list<br />                                                                         (cond<br />                                                                                 ((member j '(2 5 8)) (/ w -2.0))<br />                                                                                 ((member j '(3 6 9)) (- w))<br />                                                                                 (0.0)<br />                                                                         )<br />                                                                         (cond<br />                                                                                 ((member j '(1 2 3)) (- h))<br />                                                                                 ((member j '(4 5 6)) (/ h -2.0))<br />                                                                                 (0.0)<br />                                                                         )<br />                                                                 )<br />                                                 )<br />                                                 (list<br />                                                         (list (- (car o) offh) (- (cadr o) offs))<br />                                                         (list (+ (car o) w offh) (- (cadr o) offs))<br />                                                         (list (+ (car o) w offh) (+ (cadr o) h offs))<br />                                                         (list (- (car o) offh) (+ (cadr o) h offs))<br />                                                 )<br />                                         )<br />                                 )<br />                         )<br />                         ((lambda (m)<br />                                  (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)<br />                          )<br />                                 (list<br />                                         (list (cos r) (sin (- r)) 0.0)<br />                                         (list (sin r) (cos r) 0.0)<br />                                         '(0.0 0.0 1.0)<br />                                 )<br />                         )<br />                 )<br />         )<br />   (princ "\n选择标注集合")<br />   (setq ss (ssget '((0 . "DIMENSION"))))<br />   (foreach bzty (ss-enlst ss)<br />                 (setq obj (vlax-ename->vla-object bzty))<br />                 (setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的图元名<br />                 (setq crpt(get-dxf bzty 11))<br />                 (setq tc(get-dxf bzty 8))<br />                 (setq bili(vla-get-ScaleFactor obj))<br />                 ;(if(= (vla-get-ObjectName obj) "AcDbRotatedDimension")<br />                 (while (setq en(entnext en))<br />                         (setq tylx (get-dxf en 0))<br />                         (if (wcmatch tylx "*TEXT")<br />                                 (progn<br />                                         (setq zg(get-dxf en 40))<br />                                         (setq pts (lm-getmtextbox1 en 0 (* zg 0.15)))<br />                                         (entmake (list '(0 . "line")(cons 62 1)(cons 8 "0")(cons 10 (car pts))(cons 11 (cadr pts))))<br />                                 )<br />                         )<br />                 )<br />                 ;)<br />         )<br />         (princ)<br /> )

ferious

飞雪前辈，请问这个标注外框的函数，返回的是？现在想要再标注文字周边划方框，帮忙指导一下

2. (defun c:ddr (/ bili crpt en get-dxf lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg  huajuxing  L)
   
3.         (defun get-dxf(en n)
   
4.                 (if (not (listp en)) (setq en (entget en)))
   
5.                 (cdr (assoc n en))
   
6.         )
   
7.         (defun ss-enlst (ss / enlst)
   
8.                 (cond
   
9.                         ((= (type ss) 'PICKSET)
   
10.                                 (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
    
11.                         )
    
12.                         ((= (type ss) 'LIST)
    
13.                                 (setq enlst (ssadd))
    
14.                                 (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
    
15.                         )
    
16.                 )
    
17.         )
    
18.         (defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W)
    
19.                 (Defun mxv (m v)
    
20.                         (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
    
21.                 )
    
22.                 (setq enx (entget obj))
    
23.                 (if (null off)
    
24.                         (setq off 0.0)
    
25.                 )
    
26.                 (if
    
27.                         (setq l
    
28.                                 (cond
    
29.                                         ((= "TEXT" (cdr (assoc 0 enx)))
    
30.                                                 (setq b (cdr (assoc 10 enx))
    
31.                                                         r (cdr (assoc 50 enx))
    
32.                                                         l (textbox enx)
    
33.                                                 )
    
34.                                                 (list
    
35.                                                         (list (- (caar l) offh) (- (cadar l) offs))
    
36.                                                         (list (+ (caadr l) offh) (- (cadar l) offs))
    
37.                                                         (list (+ (caadr l) offh) (+ (cadadr l) offs))
    
38.                                                         (list (- (caar l) offh) (+ (cadadr l) offs))
    
39.                                                 )
    
40.                                         )
    
41.                                         ((= "MTEXT" (cdr (assoc 0 enx)))
    
42.                                                 (setq n (cdr (assoc 210 enx))
    
43.                                                         b (trans (cdr (assoc 10 enx)) 0 n)
    
44.                                                         r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
    
45.                                                         w (cdr (assoc 42 enx))
    
46.                                                         h (cdr (assoc 43 enx))
    
47.                                                         j (cdr (assoc 71 enx))
    
48.                                                         o (list
    
49.                                                                         (cond
    
50.                                                                                 ((member j '(2 5 8)) (/ w -2.0))
    
51.                                                                                 ((member j '(3 6 9)) (- w))
    
52.                                                                                 (0.0)
    
53.                                                                         )
    
54.                                                                         (cond
    
55.                                                                                 ((member j '(1 2 3)) (- h))
    
56.                                                                                 ((member j '(4 5 6)) (/ h -2.0))
    
57.                                                                                 (0.0)
    
58.                                                                         )
    
59.                                                                 )
    
60.                                                 )
    
61.                                                 (list
    
62.                                                         (list (- (car o) offh) (- (cadr o) offs))
    
63.                                                         (list (+ (car o) w offh) (- (cadr o) offs))
    
64.                                                         (list (+ (car o) w offh) (+ (cadr o) h offs))
    
65.                                                         (list (- (car o) offh) (+ (cadr o) h offs))
    
66.                                                 )
    
67.                                         )
    
68.                                 )
    
69.                         )
    
70.                         ((lambda (m)
    
71.                                  (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
    
72.                          )
    
73.                                 (list
    
74.                                         (list (cos r) (sin (- r)) 0.0)
    
75.                                         (list (sin r) (cos r) 0.0)
    
76.                                         '(0.0 0.0 1.0)
    
77.                                 )
    
78.                         )
    
79.                 )
    
80.         )
    
81.   (princ "\n选择标注集合")
    
82.   (setq ss (ssget '((0 . "DIMENSION"))))
    
83. (setq oldlayer (getvar "clayer"))
    
84.    (command "layer"   "m"   "DGWT-REV"     "c" "4" ""    ""    "")
    
85.   ;(setq bzty (nth 0 (ss-enlst ss)))
    
86.   (foreach bzty (ss-enlst ss)
    
87.                 (setq obj (vlax-ename->vla-object bzty))
    
88.                 (setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的匿名图元块的文字图元名
    
89.                 (setq crpt(get-dxf bzty 11))  ;标注文字的中点（在 OCS 中）
    
90.                 (setq tc(get-dxf bzty 8))
    
91.                 (setq bili(vla-get-ScaleFactor obj))
    
92.                 ;(if(= (vla-get-ObjectName obj) "AcDbRotatedDimension")
    
93. 
    
94.    
    
95.                 (while (setq en(entnext en))  ;一直循环找到该匿名块中成员是文字为止
    
96.                         (setq tylx (get-dxf en 0))
    
97. 
    
98.       
    
99.                         (if (wcmatch tylx "*TEXT")
    
100.                                 (progn
     
101.                                         (setq zg(get-dxf en 40))
     
102.                                         (setq pts (lm-getmtextbox1 en (* zg 0.5)  (* zg 0.5)))
     
103. 
     
104.                                        ;(entmake (list '(0 . "line")(cons 62 240)(cons 10 (car pts))(cons 11 (cadr pts))))
     
105.                     (command "pline"   (nth 0 pts)   (nth 1 pts)   (nth 2 pts)   (nth 3 pts)  "c"    ""   ""  "" )
     
106.           (setq huajuxing   (entlast) )
     
107.                     (setq L (*  0.3 zg))
     
108.           (command "offset"   (* 0.2 zg)     (entlast)   (polar (car pts)   (* (/ 270.0 180.0 ) 3.1415)    (* 0.2 zg)    )   "")
     
109.    ;;;  偏移方向根据生成矩形的角点,pt1,pt2定，本程序pt2为右上角点，pt1为左下角点，所以为pt2外围方向
     
110.                        (command "revcloud"  "S" "N" "a" L L "o" (entlast) "")
     
111.                                          (COMMAND "CHANGE"  (entlast)  "" "PROPERTIES" "la" "DGWT-REV"      "")
     
112.                                           (command "_erase"  huajuxing "" )
     
113. 
     
114.                                 )
     
115.         
     
116.                         )
     
117. 
     
118.       
     
119.                 )
     
120.                
     
121.         )
     
122.         (princ)
     
123. )

(defun c:ddr (/ bili crpt en get-dxf lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg  huajuxing  L)<br />         (defun get-dxf(en n)<br />                 (if (not (listp en)) (setq en (entget en)))<br />                 (cdr (assoc n en))<br />         )<br />         (defun ss-enlst (ss / enlst)<br />                 (cond<br />                         ((= (type ss) 'PICKSET)<br />                                 (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))<br />                         )<br />                         ((= (type ss) 'LIST)<br />                                 (setq enlst (ssadd))<br />                                 (last (mapcar '(lambda (x) (ssadd x enlst)) ss))<br />                         )<br />                 )<br />         )<br />         (defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W)<br />                 (Defun mxv (m v)<br />                         (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)<br />                 )<br />                 (setq enx (entget obj))<br />                 (if (null off)<br />                         (setq off 0.0)<br />                 )<br />                 (if<br />                         (setq l<br />                                 (cond<br />                                         ((= "TEXT" (cdr (assoc 0 enx)))<br />                                                 (setq b (cdr (assoc 10 enx))<br />                                                         r (cdr (assoc 50 enx))<br />                                                         l (textbox enx)<br />                                                 )<br />                                                 (list<br />                                                         (list (- (caar l) offh) (- (cadar l) offs))<br />                                                         (list (+ (caadr l) offh) (- (cadar l) offs))<br />                                                         (list (+ (caadr l) offh) (+ (cadadr l) offs))<br />                                                         (list (- (caar l) offh) (+ (cadadr l) offs))<br />                                                 )<br />                                         )<br />                                         ((= "MTEXT" (cdr (assoc 0 enx)))<br />                                                 (setq n (cdr (assoc 210 enx))<br />                                                         b (trans (cdr (assoc 10 enx)) 0 n)<br />                                                         r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))<br />                                                         w (cdr (assoc 42 enx))<br />                                                         h (cdr (assoc 43 enx))<br />                                                         j (cdr (assoc 71 enx))<br />                                                         o (list<br />                                                                         (cond<br />                                                                                 ((member j '(2 5 8)) (/ w -2.0))<br />                                                                                 ((member j '(3 6 9)) (- w))<br />                                                                                 (0.0)<br />                                                                         )<br />                                                                         (cond<br />                                                                                 ((member j '(1 2 3)) (- h))<br />                                                                                 ((member j '(4 5 6)) (/ h -2.0))<br />                                                                                 (0.0)<br />                                                                         )<br />                                                                 )<br />                                                 )<br />                                                 (list<br />                                                         (list (- (car o) offh) (- (cadr o) offs))<br />                                                         (list (+ (car o) w offh) (- (cadr o) offs))<br />                                                         (list (+ (car o) w offh) (+ (cadr o) h offs))<br />                                                         (list (- (car o) offh) (+ (cadr o) h offs))<br />                                                 )<br />                                         )<br />                                 )<br />                         )<br />                         ((lambda (m)<br />                                  (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)<br />                          )<br />                                 (list<br />                                         (list (cos r) (sin (- r)) 0.0)<br />                                         (list (sin r) (cos r) 0.0)<br />                                         '(0.0 0.0 1.0)<br />                                 )<br />                         )<br />                 )<br />         )<br />   (princ "\n选择标注集合")<br />   (setq ss (ssget '((0 . "DIMENSION"))))<br /> (setq oldlayer (getvar "clayer"))<br />    (command "layer"   "m"   "DGWT-REV"     "c" "4" ""    ""    "")<br />   ;(setq bzty (nth 0 (ss-enlst ss)))<br />   (foreach bzty (ss-enlst ss)<br />                 (setq obj (vlax-ename->vla-object bzty))<br />                 (setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的匿名图元块的文字图元名<br />                 (setq crpt(get-dxf bzty 11))  ;标注文字的中点（在 OCS 中）<br />                 (setq tc(get-dxf bzty 8))<br />                 (setq bili(vla-get-ScaleFactor obj))<br />                 ;(if(= (vla-get-ObjectName obj) "AcDbRotatedDimension")<br /> <br />     <br />                 (while (setq en(entnext en))  ;一直循环找到该匿名块中成员是文字为止<br />                         (setq tylx (get-dxf en 0))<br /> <br />       <br />                         (if (wcmatch tylx "*TEXT")<br />                                 (progn<br />                                         (setq zg(get-dxf en 40))<br />                                         (setq pts (lm-getmtextbox1 en (* zg 0.5)  (* zg 0.5)))<br /> <br />                                        ;(entmake (list '(0 . "line")(cons 62 240)(cons 10 (car pts))(cons 11 (cadr pts))))<br />                     (command "pline"   (nth 0 pts)   (nth 1 pts)   (nth 2 pts)   (nth 3 pts)  "c"    ""   ""  "" )<br />           (setq huajuxing   (entlast) )<br />                     (setq L (*  0.3 zg))<br />           (command "offset"   (* 0.2 zg)     (entlast)   (polar (car pts)   (* (/ 270.0 180.0 ) 3.1415)    (* 0.2 zg)    )   "")<br />    ;;;  偏移方向根据生成矩形的角点,pt1,pt2定，本程序pt2为右上角点，pt1为左下角点，所以为pt2外围方向<br />                        (command "revcloud"  "S" "N" "a" L L "o" (entlast) "")<br />                                          (COMMAND "CHANGE"  (entlast)  "" "PROPERTIES" "la" "DGWT-REV"      "")<br />                                           (command "_erase"  huajuxing "" )<br /> <br />                                 )<br />         <br />                         )<br /> <br />       <br />                 )<br />                <br />         )<br />         (princ)<br /> )

飞雪神光

是在下边呢

ferious

我的是这样的效果，不知为何y方向未有赋值还是？
能否指出我的错误？看了好久不知哪里错了

ferious

飞雪神光 发表于 2024-1-5 20:24

飞雪前辈，这里看着比较蒙，能否指点一下返回值是什么？

飞雪神光

(set 'co 1) = (setq co 1)注意set的变量是有个 ' 的
单行多行返回值是一样的 标注中的文字就是多行的

ferious

飞雪神光 发表于 2024-1-5 22:38
(set 'co 1) = (setq co 1)注意set的变量是有个 ' 的
单行多行返回值是一样的 标注中的文字就是多行的

是的，我i昂知道是返回四个点的坐标吗？为何多行还要再次处理？

飞雪神光

并没有再次处理 就是求得多行文字的包围框