求完善下代码.(画线并自动标注功能) (源码来自73.)

鱼与熊掌

edata 发表于 2014-6-2 00:03
当前样式不要用替代。
替代需要更改扩展数据的组码。
或者通过vla方式更改标注数据。

嗯 OK.`````````````````````````

edata

1. (defun c:ts (/ p q pt en obj)
   
2. ;(setvar'osmode 16384)
   
3.   (setq os_bak(getvar 'cmdecho))
   
4.   (setvar 'cmdecho 0)
   
5.   (setq p (getpoint "\n指定起点"))
   
6.   (while p
   
7.     (if        p
   
8.       (progn
   
9.         (command "pline" "_non" p)
   
10.         (while (setq q        (getpoint p "下一点")
    
11.                      pt        (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))
    
12.                )
    
13.           (command "_non" q)
    
14.           (setq en (entmakex
    
15.             (list '(0 . "DIMENSION")
    
16.                   '(100 . "AcDbEntity")
    
17.                   '(100 . "AcDbDimension")
    
18.                   (cons        10
    
19.                         (polar p
    
20.                                (+ (* 0.5 pi) (if (and        (< (/ Pi 2) (angle p q))
    
21.                                         (> (* 1.5 pi) (angle p q))
    
22.                                    )
    
23.                                  (angle q p)
    
24.                                  (angle p q)
    
25.                                ))
    
26.                                (* 6 (getvar "dimscale"))
    
27.                         )
    
28.                   )
    
29.                   '(70 . 33)
    
30.                   '(1 . "")
    
31.                   '(100 . "AcDbAlignedDimension")
    
32.                   (cons 13 (polar q
    
33.                                 (+ (* 0.5 pi) (if (and        (< (/ Pi 2) (angle p q))
    
34.                                         (> (* 1.5 pi) (angle p q))
    
35.                                    )
    
36.                                  (angle q p)
    
37.                                  (angle p q)
    
38.                                ))
    
39.                                (* 3 (getvar "dimscale"))
    
40.                         ))
    
41.                   (cons 14 (polar p
    
42.                                (+ (* 0.5 pi) (if (and        (< (/ Pi 2) (angle p q))
    
43.                                         (> (* 1.5 pi) (angle p q))
    
44.                                    )
    
45.                                  (angle q p)
    
46.                                  (angle p q)
    
47.                                ))
    
48.                                (* 3 (getvar "dimscale"))
    
49.                         ))
    
50.             )
    
51.           )
    
52.                 obj(vlax-ename->vla-object en))
    
53.           (vla-put-ScaleFactor obj (getvar "dimscale"))
    
54.           (entmake (list '(0 . "TEXT")
    
55.                          (cons 10 pt)
    
56.                          (cons 40 1)
    
57.                          (cons 1 (rtos (distance p q) 2 2))
    
58.                          (cons 50
    
59.                                (if (and        (< (/ Pi 2) (angle p q))
    
60.                                         (> (* 1.5 pi) (angle p q))
    
61.                                    )
    
62.                                  (angle q p)
    
63.                                  (angle p q)
    
64.                                )
    
65.                          )
    
66.                          ;(cons 7 "city")
    
67.                          (cons 72 1)
    
68.                          (cons 73 1)
    
69.                          (cons 40 (* 2 (getvar "dimscale")))
    
70.                          (cons 11 pt)
    
71.                    )
    
72.           )
    
73.           (setq p q)
    
74.         )
    
75.         (if (>(getvar 'CMDACTIVE) 0) (command ""))
    
76.         (setq p (getpoint "\n指定起点"))
    
77.       )
    
78.       ;(setvar 'osmode (- (getvar osmode) 16384))
    
79.     )
    
80.   )
    
81.   (if (>(getvar 'CMDACTIVE) 0) (command ""))
    
82.   (if os_bak(setvar 'cmdecho os_bak))
    
83.   (princ)
    
84. )

(defun c:ts (/ p q pt en obj)<br /> ;(setvar'osmode 16384)<br />   (setq os_bak(getvar 'cmdecho))<br />   (setvar 'cmdecho 0)<br />   (setq p (getpoint "\n指定起点"))<br />   (while p<br />     (if        p<br />       (progn<br />         (command "pline" "_non" p)<br />         (while (setq q        (getpoint p "下一点")<br />                      pt        (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))<br />                )<br />           (command "_non" q)<br />           (setq en (entmakex<br />             (list '(0 . "DIMENSION")<br />                   '(100 . "AcDbEntity")<br />                   '(100 . "AcDbDimension")<br />                   (cons        10<br />                         (polar p<br />                                (+ (* 0.5 pi) (if (and        (< (/ Pi 2) (angle p q))<br />                                         (> (* 1.5 pi) (angle p q))<br />                                    )<br />                                  (angle q p)<br />                                  (angle p q)<br />                                ))<br />                                (* 6 (getvar "dimscale"))<br />                         )<br />                   )<br />                   '(70 . 33)<br />                   '(1 . "")<br />                   '(100 . "AcDbAlignedDimension")<br />                   (cons 13 (polar q<br />                                 (+ (* 0.5 pi) (if (and        (< (/ Pi 2) (angle p q))<br />                                         (> (* 1.5 pi) (angle p q))<br />                                    )<br />                                  (angle q p)<br />                                  (angle p q)<br />                                ))<br />                                (* 3 (getvar "dimscale"))<br />                         ))<br />                   (cons 14 (polar p<br />                                (+ (* 0.5 pi) (if (and        (< (/ Pi 2) (angle p q))<br />                                         (> (* 1.5 pi) (angle p q))<br />                                    )<br />                                  (angle q p)<br />                                  (angle p q)<br />                                ))<br />                                (* 3 (getvar "dimscale"))<br />                         ))<br />             )<br />           )<br />                 obj(vlax-ename->vla-object en))<br />           (vla-put-ScaleFactor obj (getvar "dimscale"))<br />           (entmake (list '(0 . "TEXT")<br />                          (cons 10 pt)<br />                          (cons 40 1)<br />                          (cons 1 (rtos (distance p q) 2 2))<br />                          (cons 50<br />                                (if (and        (< (/ Pi 2) (angle p q))<br />                                         (> (* 1.5 pi) (angle p q))<br />                                    )<br />                                  (angle q p)<br />                                  (angle p q)<br />                                )<br />                          )<br />                          ;(cons 7 "city")<br />                          (cons 72 1)<br />                          (cons 73 1)<br />                          (cons 40 (* 2 (getvar "dimscale")))<br />                          (cons 11 pt)<br />                    )<br />           )<br />           (setq p q)<br />         )<br />         (if (>(getvar 'CMDACTIVE) 0) (command ""))<br />         (setq p (getpoint "\n指定起点"))<br />       )<br />       ;(setvar 'osmode (- (getvar osmode) 16384))<br />     )<br />   )<br />   (if (>(getvar 'CMDACTIVE) 0) (command ""))<br />   (if os_bak(setvar 'cmdecho os_bak))<br />   (princ)<br /> )

reyun

(defun c:tts(/ p q pt)
          ;(setvar'osmode 16384)
          (setq  p (getpoint"指定起点"))
          (while p
            (if p
                    (progn
                                   (command "pline" p)
                                  (while (setq q (getpoint p"下一点") pt (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q)) pt (polar pt (+ (angle p q)1.5708) (* 3 (getvar "dimscale"))))
                                    (command q)
                                    (entmake
                                            (list
                                                    '(0 . "TEXT")
                                                    '(100 . "AcDbEntity")
                                                    '(100 . "AcDbText")
                                                    (cons 10 pt)
                                                    (cons 40 (* 2 (getvar "dimscale")))
                                                    (cons 1 (rtos (distance p q) 2 2))
                                                          (cons 50 (if (and (<(/ Pi 2)(angle p q))(>(* 1.5 pi)(angle p q)))(angle q p)(angle p q)))
                                                          (cons 7 "HZTXT");改了文字样式，自己改回去。
                                                          (cons 72 1)
                                                          (cons 73 1)
                                                          ;(cons 40 (* 2 (getvar "dimscale")))
                                                          (cons 11 pt)
                                                  )
                                          )
                                    (setq p q)
                            )
                                  (command "")
                                  (setq p(getpoint"指定起点"))
                          )
                      (setvar'osmode(-(getvar osmode)16384))
              )
    )
          (princ)
)
不知这是不是你所想要的。

鱼与熊掌

edata 发表于 2014-6-2 00:11

Perfect 端午节快乐  dal标注命令的第三个点命令参数哪里调的   

鱼与熊掌

reyun 发表于 2014-6-2 00:17
(defun c:tts(/ p q pt)
          ;(setvar'osmode 16384)
          (setq  p (getpoint"指定起点"))

不错 谢谢帮忙

鱼与熊掌

edata 发表于 2014-6-2 00:11

我已经知道了`.`~ 谢谢帮忙

香田里浪人

edata 发表于 2014-6-1 23:32
仅供参考，

程序不错，可是标注有2个，如果只要其中一个，就是带箭头那组数据不要显示，如何修改，请您告诉我，谢谢！

鱼与熊掌

香田里浪人 发表于 2014-6-2 10:44
程序不错，可是标注有2个，如果只要其中一个，就是带箭头那组数据不要显示，如何修改，请您告诉我，谢谢！ ...

2. (defun c:`d (/ p q pt en obj)
   
3. ;(setvar'osmode 16384)
   
4. ;by e版主
   
5.   (setq os_bak(getvar 'cmdecho))
   
6.   (setvar 'cmdecho 0)
   
7.   (setq p (getpoint "\n指定起点"))
   
8.   (while p
   
9.     (if        p
   
10.       (progn
    
11.         (command "pline" "_non" p)
    
12.         (while (setq q        (getpoint p "下一点")
    
13.                      pt        (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))
    
14.                )
    
15.           (command "_non" q)
    
16.           (entmake (list '(0 . "TEXT")
    
17.                          (cons 10 pt)
    
18.                          (cons 40 1)
    
19.                          (cons 1 (rtos (distance p q) 2 2))
    
20.                          (cons 50
    
21.                                (if (and        (< (/ Pi 2) (angle p q))
    
22.                                         (> (* 1.5 pi) (angle p q))
    
23.                                    )
    
24.                                  (angle q p)
    
25.                                  (angle p q)
    
26.                                )
    
27.                          )
    
28.                          (cons 7 "city")
    
29.                          (cons 72 1)
    
30.                          (cons 73 1)
    
31.                          (cons 40 (* 2 (getvar "dimscale")))
    
32.                          (cons 11 pt)
    
33.                    )
    
34.           )
    
35.           (setq p q)
    
36.         )
    
37.         (if (>(getvar 'CMDACTIVE) 0) (command ""))
    
38.         (setq p (getpoint "\n指定起点"))
    
39.       )
    
40.       ;(setvar 'osmode (- (getvar osmode) 16384))
    
41.     )
    
42.   )
    
43.   (if (>(getvar 'CMDACTIVE) 0) (command ""))
    
44.   (if os_bak(setvar 'cmdecho os_bak))
    
45.   (princ)
    
46. )
    
47. 
    

(defun c:`d (/ p q pt en obj)<br /> ;(setvar'osmode 16384)<br /> ;by e版主<br />   (setq os_bak(getvar 'cmdecho))<br />   (setvar 'cmdecho 0)<br />   (setq p (getpoint "\n指定起点"))<br />   (while p<br />     (if        p<br />       (progn<br />         (command "pline" "_non" p)<br />         (while (setq q        (getpoint p "下一点")<br />                      pt        (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))<br />                )<br />           (command "_non" q)<br />           (entmake (list '(0 . "TEXT")<br />                          (cons 10 pt)<br />                          (cons 40 1)<br />                          (cons 1 (rtos (distance p q) 2 2))<br />                          (cons 50<br />                                (if (and        (< (/ Pi 2) (angle p q))<br />                                         (> (* 1.5 pi) (angle p q))<br />                                    )<br />                                  (angle q p)<br />                                  (angle p q)<br />                                )<br />                          )<br />                          (cons 7 "city")<br />                          (cons 72 1)<br />                          (cons 73 1)<br />                          (cons 40 (* 2 (getvar "dimscale")))<br />                          (cons 11 pt)<br />                    )<br />           )<br />           (setq p q)<br />         )<br />         (if (>(getvar 'CMDACTIVE) 0) (command ""))<br />         (setq p (getpoint "\n指定起点"))<br />       )<br />       ;(setvar 'osmode (- (getvar osmode) 16384))<br />     )<br />   )<br />   (if (>(getvar 'CMDACTIVE) 0) (command ""))<br />   (if os_bak(setvar 'cmdecho os_bak))<br />   (princ)<br /> )<br /> <br />

香田里浪人

鱼与熊掌君，谢谢你答复，

鱼与熊掌

香田里浪人 发表于 2014-6-2 14:36
鱼与熊掌君，谢谢你答复，

不客气`~~~~~~~~~