请求对坐标标注来个小改造

lucas3

首先说明的是，不需要自动坐标标注，只是对CAD自带的坐标标注做一些小改造
CAD自带的坐标标注，一次只能标一次，要不停重复按空格键才能继续标注

我的想法是，运行命令后，拾取一点可以将ＸＹ坐标都标上，可连续标注，不需按空格，
存在的问题是，标注线的长短控制，是否可设定？
标注的方向，分为左上，右上，左下，右下，是否可用按键切换？

Free-Lancer

lucas3 发表于 2014-8-15 19:58
Free-Lancer大师：您好！感谢您的帮助！与我想想的有些差异，您这个有点像自动圆坐标标注
我的想法是
...

标注当前坐标系

1. (defun c:Tt (/ tf p d px py vx vy per)
   
2.   (if (not $globledirct)
   
3.     (setq $globledirct "3")
   
4.   )
   
5.   (if (not $globledimx)
   
6.     (setq $globledimx (getvar "textsize"))
   
7.   )
   
8.   (if (not $globledimy)
   
9.     (setq $globledimy (getvar "textsize"))
   
10.   )
    
11.   (fy:begin)
    
12.   (while (progn
    
13.            (prompt (strcat "\n当前设置 X = "
    
14.                            (vl-princ-to-string $globledimx)
    
15.                            "; Y = "
    
16.                            (vl-princ-to-string $globledimy)
    
17.                            "; 第 "
    
18.                            $globledirct
    
19.                            " 象限"
    
20.                    )
    
21.            )
    
22.            (initget "X Y S" 128)
    
23.            (setq p
    
24.                   (getpoint
    
25.                     "\n拾取点或[X间隙(X)/Y间隙(Y)/设置标注象限(S)]: "
    
26.                   )
    
27.            )
    
28.            (cond
    
29.              ((or (= p "X") (= p "x"))
    
30.               (if (setq d (getdist "\n拾取X标注方向间隙: "))
    
31.                 (setq $globledimx d)
    
32.               )
    
33.               (setq tf t)
    
34.              )
    
35.              ((or (= p "Y") (= p "y"))
    
36.               (if (setq d (getdist "\n拾取Y标注方向间隙: "))
    
37.                 (setq $globledimy d)
    
38.               )
    
39.               (setq tf t)
    
40.              )
    
41.              ((or (= p "S") (= p "s"))
    
42.               (initget "1 2 3 4")
    
43.               (if (setq
    
44.                     kw (getkword "\n标注象限[(1)/(2)/(3)/(4)]: ")
    
45.                   )
    
46.                 (setq $globledirct kw)
    
47.               )
    
48.               (setq tf t)
    
49.              )
    
50.              ((= (type p) 'List) (setq tf t))
    
51.              (t (setq tf nil))
    
52.            )
    
53.            tf
    
54.          )
    
55.     (if        (= (type p) 'LIST)
    
56.       (progn
    
57.         (cond ((= $globledirct "1")
    
58.                (setq py        (polar p 0 $globledimy)
    
59.                      px        (polar p _pi2 $globledimx)
    
60.                )
    
61.               )
    
62.               ((= $globledirct "2")
    
63.                (setq px        (polar p _pi2 $globledimx)
    
64.                      py        (polar p pi $globledimy)
    
65.                )
    
66.               )
    
67.               ((= $globledirct "3")
    
68.                (setq py        (polar p pi $globledimy)
    
69.                      px        (polar p _3pi $globledimx)
    
70.                )
    
71.               )
    
72.               (t
    
73.                (setq py        (polar p 0 $globledimy)
    
74.                      px        (polar p _3pi $globledimx)
    
75.                )
    
76.               )
    
77.         )
    
78.         (setq vy  (vla-AddDimOrdinate
    
79.                     (fy:acspace)
    
80.                     (vlax-3d-point (trans p 1 0))
    
81.                     (vlax-3d-point (trans py 1 0))
    
82.                     :vlax-false
    
83.                   )
    
84.               vx  (vla-AddDimOrdinate
    
85.                     (fy:acspace)
    
86.                     (vlax-3d-point (trans p 1 0))
    
87.                     (vlax-3d-point (trans px 1 0))
    
88.                     :vlax-true
    
89.                   )
    
90.               per (vla-get-PrimaryUnitsPrecision vx)
    
91.         )
    
92.         (vla-put-TextOverride vx (rtos (car p) 2 per))
    
93.         (vla-put-TextOverride vy (rtos (cadr p) 2 per))
    
94.       )
    
95.     )
    
96.   )
    
97.   (fy:end)
    
98.   (princ)
    
99. )

(defun c:Tt (/ tf p d px py vx vy per)<br />   (if (not $globledirct)<br />     (setq $globledirct "3")<br />   )<br />   (if (not $globledimx)<br />     (setq $globledimx (getvar "textsize"))<br />   )<br />   (if (not $globledimy)<br />     (setq $globledimy (getvar "textsize"))<br />   )<br />   (fy:begin)<br />   (while (progn<br />            (prompt (strcat "\n当前设置 X = "<br />                            (vl-princ-to-string $globledimx)<br />                            "; Y = "<br />                            (vl-princ-to-string $globledimy)<br />                            "; 第 "<br />                            $globledirct<br />                            " 象限"<br />                    )<br />            )<br />            (initget "X Y S" 128)<br />            (setq p<br />                   (getpoint<br />                     "\n拾取点或[X间隙(X)/Y间隙(Y)/设置标注象限(S)]: "<br />                   )<br />            )<br />            (cond<br />              ((or (= p "X") (= p "x"))<br />               (if (setq d (getdist "\n拾取X标注方向间隙: "))<br />                 (setq $globledimx d)<br />               )<br />               (setq tf t)<br />              )<br />              ((or (= p "Y") (= p "y"))<br />               (if (setq d (getdist "\n拾取Y标注方向间隙: "))<br />                 (setq $globledimy d)<br />               )<br />               (setq tf t)<br />              )<br />              ((or (= p "S") (= p "s"))<br />               (initget "1 2 3 4")<br />               (if (setq<br />                     kw (getkword "\n标注象限[(1)/(2)/(3)/(4)]: ")<br />                   )<br />                 (setq $globledirct kw)<br />               )<br />               (setq tf t)<br />              )<br />              ((= (type p) 'List) (setq tf t))<br />              (t (setq tf nil))<br />            )<br />            tf<br />          )<br />     (if        (= (type p) 'LIST)<br />       (progn<br />         (cond ((= $globledirct "1")<br />                (setq py        (polar p 0 $globledimy)<br />                      px        (polar p _pi2 $globledimx)<br />                )<br />               )<br />               ((= $globledirct "2")<br />                (setq px        (polar p _pi2 $globledimx)<br />                      py        (polar p pi $globledimy)<br />                )<br />               )<br />               ((= $globledirct "3")<br />                (setq py        (polar p pi $globledimy)<br />                      px        (polar p _3pi $globledimx)<br />                )<br />               )<br />               (t<br />                (setq py        (polar p 0 $globledimy)<br />                      px        (polar p _3pi $globledimx)<br />                )<br />               )<br />         )<br />         (setq vy  (vla-AddDimOrdinate<br />                     (fy:acspace)<br />                     (vlax-3d-point (trans p 1 0))<br />                     (vlax-3d-point (trans py 1 0))<br />                     :vlax-false<br />                   )<br />               vx  (vla-AddDimOrdinate<br />                     (fy:acspace)<br />                     (vlax-3d-point (trans p 1 0))<br />                     (vlax-3d-point (trans px 1 0))<br />                     :vlax-true<br />                   )<br />               per (vla-get-PrimaryUnitsPrecision vx)<br />         )<br />         (vla-put-TextOverride vx (rtos (car p) 2 per))<br />         (vla-put-TextOverride vy (rtos (cadr p) 2 per))<br />       )<br />     )<br />   )<br />   (fy:end)<br />   (princ)<br /> )

Free-Lancer

下载签名下的 lib.vlx , 用到了几个常量定义

1. (defun c:tt (/ p ss px px1 py py1 vx vy per kw)
   
2.   (fy:begin)
   
3.   (initget "1 2 3 4" 128)
   
4.   (if (not $globlekw)
   
5.     (setq $globlekw "3")
   
6.   )
   
7.   (setq
   
8.     kw (getkword
   
9.          (strcat "\n[右上(1)/左上(2)/左下(3)/右下(4)]<" $globlekw ">: ")
   
10.        )
    
11.   )
    
12.   (if (or (not kw) (= kw ""))
    
13.     (setq kw $globlekw)
    
14.     (setq $globlekw kw)
    
15.   )
    
16.   (if (and (setq p (getpoint "\nBase Point: "))
    
17.            (setq ss (ssget '((0 . "CIRCLE"))))
    
18.            (setq p (trans p 1 0))
    
19. 
    
20.       )
    
21.     (vlax-for circle (fy:cset)
    
22.       (cond
    
23.         ((= kw "1")
    
24.          (setq py  (vlax-curve-getpointatparam circle 0)
    
25.                py1 (polar py 0 (getvar "textsize"))
    
26.                px  (vlax-curve-getpointatparam circle _pi2)
    
27.                px1 (polar px _pi2 (getvar "textsize"))
    
28.          )
    
29.         )
    
30.         ((= kw "2")
    
31.          (setq px  (vlax-curve-getpointatparam circle _pi2)
    
32.                px1 (polar px _pi2 (getvar "textsize"))
    
33.                py  (vlax-curve-getpointatparam circle pi)
    
34.                py1 (polar py pi (getvar "textsize"))
    
35.          )
    
36.         )
    
37.         ((= kw "3")
    
38.          (setq py  (vlax-curve-getpointatparam circle pi)
    
39.                py1 (polar py pi (getvar "textsize"))
    
40.                px  (vlax-curve-getpointatparam circle _3pi)
    
41.                px1 (polar px _3pi (getvar "textsize"))
    
42.          )
    
43.         )
    
44.         (t
    
45.          (setq py  (vlax-curve-getpointatparam circle 0)
    
46.                py1 (polar py 0 (getvar "textsize"))
    
47.                px  (vlax-curve-getpointatparam circle _3pi)
    
48.                px1 (polar px _3pi (getvar "textsize"))
    
49.          )
    
50.         )
    
51.       )
    
52. 
    
53.       (setq vy        (vla-AddDimOrdinate
    
54.                   (fy:acspace)
    
55.                   (vlax-3d-point py)
    
56.                   (vlax-3d-point py1)
    
57.                   :vlax-false
    
58.                 )
    
59.             vx        (vla-AddDimOrdinate
    
60.                   (fy:acspace)
    
61.                   (vlax-3d-point px)
    
62.                   (vlax-3d-point px1)
    
63.                   :vlax-true
    
64.                 )
    
65.             per        (vla-get-PrimaryUnitsPrecision vx)
    
66.       )
    
67.       (vla-put-TextOverride vx (rtos (- (car px) (car p)) 2 per))
    
68.       (vla-put-TextOverride
    
69.         vy
    
70.         (rtos (- (cadr py) (cadr p)) 2 per)
    
71.       )
    
72.     )
    
73.   )
    
74.   (fy:end)
    
75.   (princ)
    
76. )

(defun c:tt (/ p ss px px1 py py1 vx vy per kw)<br />   (fy:begin)<br />   (initget "1 2 3 4" 128)<br />   (if (not $globlekw)<br />     (setq $globlekw "3")<br />   )<br />   (setq<br />     kw (getkword<br />          (strcat "\n[右上(1)/左上(2)/左下(3)/右下(4)]<" $globlekw ">: ")<br />        )<br />   )<br />   (if (or (not kw) (= kw ""))<br />     (setq kw $globlekw)<br />     (setq $globlekw kw)<br />   )<br />   (if (and (setq p (getpoint "\nBase Point: "))<br />            (setq ss (ssget '((0 . "CIRCLE"))))<br />            (setq p (trans p 1 0))<br /> <br />       )<br />     (vlax-for circle (fy:cset)<br />       (cond<br />         ((= kw "1")<br />          (setq py  (vlax-curve-getpointatparam circle 0)<br />                py1 (polar py 0 (getvar "textsize"))<br />                px  (vlax-curve-getpointatparam circle _pi2)<br />                px1 (polar px _pi2 (getvar "textsize"))<br />          )<br />         )<br />         ((= kw "2")<br />          (setq px  (vlax-curve-getpointatparam circle _pi2)<br />                px1 (polar px _pi2 (getvar "textsize"))<br />                py  (vlax-curve-getpointatparam circle pi)<br />                py1 (polar py pi (getvar "textsize"))<br />          )<br />         )<br />         ((= kw "3")<br />          (setq py  (vlax-curve-getpointatparam circle pi)<br />                py1 (polar py pi (getvar "textsize"))<br />                px  (vlax-curve-getpointatparam circle _3pi)<br />                px1 (polar px _3pi (getvar "textsize"))<br />          )<br />         )<br />         (t<br />          (setq py  (vlax-curve-getpointatparam circle 0)<br />                py1 (polar py 0 (getvar "textsize"))<br />                px  (vlax-curve-getpointatparam circle _3pi)<br />                px1 (polar px _3pi (getvar "textsize"))<br />          )<br />         )<br />       )<br /> <br />       (setq vy        (vla-AddDimOrdinate<br />                   (fy:acspace)<br />                   (vlax-3d-point py)<br />                   (vlax-3d-point py1)<br />                   :vlax-false<br />                 )<br />             vx        (vla-AddDimOrdinate<br />                   (fy:acspace)<br />                   (vlax-3d-point px)<br />                   (vlax-3d-point px1)<br />                   :vlax-true<br />                 )<br />             per        (vla-get-PrimaryUnitsPrecision vx)<br />       )<br />       (vla-put-TextOverride vx (rtos (- (car px) (car p)) 2 per))<br />       (vla-put-TextOverride<br />         vy<br />         (rtos (- (cadr py) (cadr p)) 2 per)<br />       )<br />     )<br />   )<br />   (fy:end)<br />   (princ)<br /> )

lucas3

Free-Lancer 发表于 2014-8-15 17:30
下载签名下的 lib.vlx , 用到了几个常量定义

Free-Lancer大师：您好！感谢您的帮助！与我想想的有些差异，您这个有点像自动圆坐标标注
我的想法是
１.不用选择基准点，基准点首先我会先定义好
２.不要选择对象，因为我标注的不会仅仅只是圆，只需要拾取点就行了，
以上两点跟DIMORDINATE没有区别

DIMORDINATE不能连续标注，标注一个坐标（Ｘ或Ｙ）后就结束了，需空格或回车再次调用，我的想法是拾取一点，同时标注Ｘ与Ｙ座标，
拾取下一点继续这样标注，中间不用按空格或回车。

lucas3

Free-Lancer 发表于 2014-8-15 16:03
标注当前坐标系

大师，非常好！谢谢！
只是为什么用您那个《检查坐标标注的原点 》的代码来检测，全部变色了，原点正确也变色，而用dimordinate标注出的，检测就没有问题

Free-Lancer

命令标注的自动关联了 UCS ，VLA 只标注 WCS 点，文字用的是 替代，再找找有什么区别

lucas3

Free-Lancer 发表于 2014-8-15 22:41
命令标注的自动关联了 UCS ，VLA 只标注 WCS 点，文字用的是 替代，再找找有什么区别

明白了，谢谢大师了！那那个检查程序不能用来检查这个了。

Free-Lancer

lucas3 发表于 2014-8-15 23:45
明白了，谢谢大师了！那那个检查程序不能用来检查这个了。

这个实体实在麻烦，这样就 Ok 了

1. (defun c:Tt (/ tf p d px py vx vy  dim_updata)
   
2.   (defun dim_updata (dim / e el)
   
3.     (setq e  (vlax-vla-object->ename dim)
   
4.           el (entget e)
   
5.     )
   
6.     (entmod
   
7.       (subst (cons 10 (trans '(0 0 0) 1 0)) (assoc 10 el) el)
   
8.     )
   
9.   )
   
10.   (if (not $globledirct)
    
11.     (setq $globledirct "3")
    
12.   )
    
13.   (if (not $globledimx)
    
14.     (setq $globledimx (getvar "textsize"))
    
15.   )
    
16.   (if (not $globledimy)
    
17.     (setq $globledimy (getvar "textsize"))
    
18.   )
    
19.   (fy:begin)
    
20.   (while (progn
    
21.            (prompt (strcat "\n当前设置 X = "
    
22.                            (vl-princ-to-string $globledimx)
    
23.                            "; Y = "
    
24.                            (vl-princ-to-string $globledimy)
    
25.                            "; 第 "
    
26.                            $globledirct
    
27.                            " 象限"
    
28.                    )
    
29.            )
    
30.            (initget "X Y S" 128)
    
31.            (setq p
    
32.                   (getpoint
    
33.                     "\n拾取点或[X间隙(X)/Y间隙(Y)/设置标注象限(S)]: "
    
34.                   )
    
35.            )
    
36.            (cond
    
37.              ((or (= p "X") (= p "x"))
    
38.               (if (setq d (getdist "\n拾取X标注方向间隙: "))
    
39.                 (setq $globledimx d)
    
40.               )
    
41.               (setq tf t)
    
42.              )
    
43.              ((or (= p "Y") (= p "y"))
    
44.               (if (setq d (getdist "\n拾取Y标注方向间隙: "))
    
45.                 (setq $globledimy d)
    
46.               )
    
47.               (setq tf t)
    
48.              )
    
49.              ((or (= p "S") (= p "s"))
    
50.               (initget "1 2 3 4")
    
51.               (if (setq
    
52.                     kw (getkword "\n标注象限[(1)/(2)/(3)/(4)]: ")
    
53.                   )
    
54.                 (setq $globledirct kw)
    
55.               )
    
56.               (setq tf t)
    
57.              )
    
58.              ((= (type p) 'List) (setq tf t))
    
59.              (t (setq tf nil))
    
60.            )
    
61.            tf
    
62.          )
    
63.     (if        (= (type p) 'LIST)
    
64.       (progn
    
65.         (cond ((= $globledirct "1")
    
66.                (setq py        (polar p 0 $globledimy)
    
67.                      px        (polar p _pi2 $globledimx)
    
68.                )
    
69.               )
    
70.               ((= $globledirct "2")
    
71.                (setq px        (polar p _pi2 $globledimx)
    
72.                      py        (polar p pi $globledimy)
    
73.                )
    
74.               )
    
75.               ((= $globledirct "3")
    
76.                (setq py        (polar p pi $globledimy)
    
77.                      px        (polar p _3pi $globledimx)
    
78.                )
    
79.               )
    
80.               (t
    
81.                (setq py        (polar p 0 $globledimy)
    
82.                      px        (polar p _3pi $globledimx)
    
83.                )
    
84.               )
    
85.         )
    
86.         (setq vy  (vla-AddDimOrdinate
    
87.                     (fy:acspace)
    
88.                     (vlax-3d-point (trans p 1 0))
    
89.                     (vlax-3d-point (trans py 1 0))
    
90.                     :vlax-false
    
91.                   )
    
92.               vx  (vla-AddDimOrdinate
    
93.                     (fy:acspace)
    
94.                     (vlax-3d-point (trans p 1 0))
    
95.                     (vlax-3d-point (trans px 1 0))
    
96.                     :vlax-true
    
97.                   )
    
98.         )
    
99.         (dim_updata vy)
    
100.         (dim_updata vx)
     
101.       )
     
102.     )
     
103.   )
     
104.   (fy:end)
     
105.   (princ)
     
106. )

(defun c:Tt (/ tf p d px py vx vy  dim_updata)<br />   (defun dim_updata (dim / e el)<br />     (setq e  (vlax-vla-object->ename dim)<br />           el (entget e)<br />     )<br />     (entmod<br />       (subst (cons 10 (trans '(0 0 0) 1 0)) (assoc 10 el) el)<br />     )<br />   )<br />   (if (not $globledirct)<br />     (setq $globledirct "3")<br />   )<br />   (if (not $globledimx)<br />     (setq $globledimx (getvar "textsize"))<br />   )<br />   (if (not $globledimy)<br />     (setq $globledimy (getvar "textsize"))<br />   )<br />   (fy:begin)<br />   (while (progn<br />            (prompt (strcat "\n当前设置 X = "<br />                            (vl-princ-to-string $globledimx)<br />                            "; Y = "<br />                            (vl-princ-to-string $globledimy)<br />                            "; 第 "<br />                            $globledirct<br />                            " 象限"<br />                    )<br />            )<br />            (initget "X Y S" 128)<br />            (setq p<br />                   (getpoint<br />                     "\n拾取点或[X间隙(X)/Y间隙(Y)/设置标注象限(S)]: "<br />                   )<br />            )<br />            (cond<br />              ((or (= p "X") (= p "x"))<br />               (if (setq d (getdist "\n拾取X标注方向间隙: "))<br />                 (setq $globledimx d)<br />               )<br />               (setq tf t)<br />              )<br />              ((or (= p "Y") (= p "y"))<br />               (if (setq d (getdist "\n拾取Y标注方向间隙: "))<br />                 (setq $globledimy d)<br />               )<br />               (setq tf t)<br />              )<br />              ((or (= p "S") (= p "s"))<br />               (initget "1 2 3 4")<br />               (if (setq<br />                     kw (getkword "\n标注象限[(1)/(2)/(3)/(4)]: ")<br />                   )<br />                 (setq $globledirct kw)<br />               )<br />               (setq tf t)<br />              )<br />              ((= (type p) 'List) (setq tf t))<br />              (t (setq tf nil))<br />            )<br />            tf<br />          )<br />     (if        (= (type p) 'LIST)<br />       (progn<br />         (cond ((= $globledirct "1")<br />                (setq py        (polar p 0 $globledimy)<br />                      px        (polar p _pi2 $globledimx)<br />                )<br />               )<br />               ((= $globledirct "2")<br />                (setq px        (polar p _pi2 $globledimx)<br />                      py        (polar p pi $globledimy)<br />                )<br />               )<br />               ((= $globledirct "3")<br />                (setq py        (polar p pi $globledimy)<br />                      px        (polar p _3pi $globledimx)<br />                )<br />               )<br />               (t<br />                (setq py        (polar p 0 $globledimy)<br />                      px        (polar p _3pi $globledimx)<br />                )<br />               )<br />         )<br />         (setq vy  (vla-AddDimOrdinate<br />                     (fy:acspace)<br />                     (vlax-3d-point (trans p 1 0))<br />                     (vlax-3d-point (trans py 1 0))<br />                     :vlax-false<br />                   )<br />               vx  (vla-AddDimOrdinate<br />                     (fy:acspace)<br />                     (vlax-3d-point (trans p 1 0))<br />                     (vlax-3d-point (trans px 1 0))<br />                     :vlax-true<br />                   )<br />         )<br />         (dim_updata vy)<br />         (dim_updata vx)<br />       )<br />     )<br />   )<br />   (fy:end)<br />   (princ)<br /> )

csharp

组码 10 是坐标原点(WCS)