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

鱼与熊掌

搞了一天,没什么进展.来求改善.
73哥的代码,画线并标注text文字.
但是有时候会丢失一个东西,比如说点画着画着就发现少了一条线.
丢失了点.文字标出来了.情况是出现在我用点画之后,忽然使用输入20 然后就没了.

少了个点.
除了优化代码之外.
希望可以改个版本,编程自动dli.并且向外偏移3*(标注比例)的值.  也就是 (getvar "dimscale")

2. (defun c:ts(/ p q pt)
   
3.   ;(setvar'osmode 16384)
   
4.   (setq  p(getpoint"指定起点"))
   
5.   (while p
   
6.     (if p(progn
   
7.    (command "pline" p)
   
8.   (while(setq q(getpoint p"下一点")pt(mapcar'(lambda(x)(* x 0.5))(mapcar'+ p q)))
   
9.     (command q)
   
10.     (entmake(list '(0 . "TEXT")(cons 10 pt)(cons 40 1)(cons 1(rtos(distance p q)2 2))
    
11.   (cons 50 (if(and (<(/ Pi 2)(angle p q))(>(* 1.5 pi)(angle p q)))(angle q p)(angle p q)))
    
12.   (cons 7 "city")(cons 72 1)(cons 73 1)(cons 40 (* 2 (getvar "dimscale")))(cons 11 pt)))
    
13.     (setq p q))
    
14.   (command "")
    
15.   (setq p(getpoint"指定起点")))
    
16.       (setvar'osmode(-(getvar osmode)16384))))
    
17.   (princ))

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

鱼与熊掌

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

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

香田里浪人

;;根据鱼与熊掌君提供的程序，添加两点：1保留小数位数时如果位数不足可以补零2自定义字高
(defun c:tts (/ p q pt en obj)
;(setvar'osmode 16384)
(setvar"dimzin"0);;保留小数位数时如果位数不足可以补零
(setq TextHeight (getdist "\n请输入文字高度:"))
  (setq os_bak(getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (setq p (getpoint "\n指定起点"))
  (while p
    (if        p
      (progn
        (command "pline" "_non" p)
        (while (setq q        (getpoint p "下一点")
                     pt        (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))
               )
          (command "_non" q)
          (entmake (list '(0 . "TEXT")
                         (cons 10 pt)
                         (cons 40 1)
                         (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 8 "标注")
                         (cons 7 "BG_ST")
                         (cons 62 3)                        
                         (cons 72 1)
                         (cons 73 1)
                         (cons 40 TextHeight)
                         (cons 41 0.7)
                         (cons 11 pt)
                   )
          )
          (setq p q)
        )
        (if (>(getvar 'CMDACTIVE) 0) (command ""))
        (setq p (getpoint "\n指定起点"))
      )
      ;(setvar 'osmode (- (getvar osmode) 16384))
    )
  )
  (if (>(getvar 'CMDACTIVE) 0) (command ""))
  (if os_bak(setvar 'cmdecho os_bak))
  (princ)
)

ZJKUSO

CAD2006试了，没显示标注

鱼与熊掌

2. (defun c:d` ( / p q pt )
   
3.     ;(setvar'osmode 16384)
   
4.     (setq  p (getpoint"指定起点"))
   
5.    
   
6.      (while p      
   
7.            (if p(progn
   
8.            (command "line" p)
   
9.         ( while(setq q(getpoint p "下一点"))
   
10.              (command q "")
    
11.                      
    
12.              (setq ang (angle p q))
    
13.              (setq pt (polar p (+ ang (* 0.5 pi)) (* 5 (getvar "dimscale"))))
    
14.              (command "DIMALIGNED" p q pt)
    
15.         
    
16.              (command "line" q)
    
17. 
    
18.              (setq p q))    ;对换坐标
    
19.         ))
    
20.            (command "")
    
21.            (setq p(getpoint"指定起点"))
    
22.       )
    
23.    (princ)
    
24. )

(defun c:d` ( / p q pt )<br />     ;(setvar'osmode 16384)<br />     (setq  p (getpoint"指定起点"))<br />     <br />      (while p      <br />            (if p(progn<br />            (command "line" p)<br />         ( while(setq q(getpoint p "下一点"))<br />              (command q "")<br />                      <br />              (setq ang (angle p q))<br />              (setq pt (polar p (+ ang (* 0.5 pi)) (* 5 (getvar "dimscale"))))<br />              (command "DIMALIGNED" p q pt)<br />         <br />              (command "line" q)<br /> <br />              (setq p q))    ;对换坐标<br />         ))<br />            (command "")<br />            (setq p(getpoint"指定起点"))<br />       )<br />    (princ)<br /> )

鱼与熊掌

getpoint                       `````````

edata

仅供参考，

1. (defun c:ts (/ p q pt)
   
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.           (entmake
    
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.           (entmake (list '(0 . "TEXT")
    
53.                          (cons 10 pt)
    
54.                          (cons 40 1)
    
55.                          (cons 1 (rtos (distance p q) 2 2))
    
56.                          (cons 50
    
57.                                (if (and        (< (/ Pi 2) (angle p q))
    
58.                                         (> (* 1.5 pi) (angle p q))
    
59.                                    )
    
60.                                  (angle q p)
    
61.                                  (angle p q)
    
62.                                )
    
63.                          )
    
64.                          ;(cons 7 "city")
    
65.                          (cons 72 1)
    
66.                          (cons 73 1)
    
67.                          (cons 40 (* 2 (getvar "dimscale")))
    
68.                          (cons 11 pt)
    
69.                    )
    
70.           )
    
71.           (setq p q)
    
72.         )
    
73.         (if (>(getvar 'CMDACTIVE) 0) (command ""))
    
74.         (setq p (getpoint "\n指定起点"))
    
75.       )
    
76.       ;(setvar 'osmode (- (getvar osmode) 16384))
    
77.     )
    
78.   )
    
79.   (if (>(getvar 'CMDACTIVE) 0) (command ""))
    
80.   (if os_bak(setvar 'cmdecho os_bak))
    
81.   (princ)
    
82. )

(defun c:ts (/ p q pt)<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 />           (entmake<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 />           (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 /> )

鱼与熊掌

好像捕捉变量关了就好了   擦.关贴

鱼与熊掌

(defun c:d` ( / p q pt )
    ;(setvar'osmode 16384)
     (setq o_os (getvar "osmode"))
     (setvar "osmode" 1)
    (setq  p (getpoint"指定起点"))
    (setvar "osmode" 0)
     (while p      
           (if p(progn
           (command "line" p)
        ( while(setq q(getpoint p))
             (command q "")
                     
             ;(setq ang (angle p q))
             (setq ang (if(and (<(/ Pi 2)(angle p q))(>(* 1.5 pi)(angle p q)))(angle q p)(angle p q)))
             (setq pt (polar p (+ ang (* 0.5 pi)) (* 5 (getvar "dimscale"))))
             (command "DIMALIGNED" p q pt)
             (setq ang nil)
             (command "line" q)

             (setq p q))    ;对换坐标
        ))
           (command "")
           (setq p(getpoint"指定起点"))
      )
    (setvar "osmode" o_os)
   (princ)
)

鱼与熊掌

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

标注样式没跟上,要用当前标注样式~
要改哪里

edata

不关捕捉会对command函数执行时，造成错误图形或程序执行失败，因此大多数是关了点。
如果command函数调用的命令很少的话，可以采用"non"来临时关闭捕捉，而整个系统的osmode不需要修改。即使程序出错，也不影响使用。
其二，关闭捕捉的方式，建议采用 + - 16384 方式 。这样即使程序出错，按F3或点击osnap也可以直接开启捕捉模式，而不是将所有捕捉类型关闭。可以在论坛搜索到。

鱼与熊掌

edata 发表于 2014-6-1 23:58
不关捕捉会对command函数执行时，造成错误图形或程序执行失败，因此大多数是关了点。
如果command函数调用 ...

那你上面贴的代码能不能把标注改成当前样式呢, 就是我的全局比例那边已经改了    字应该更大才是  标注样式没有更上 距离拉长了`.`

edata

鱼与熊掌 发表于 2014-6-1 23:55
标注样式没跟上,要用当前标注样式~
要改哪里

当前样式不要用替代。
替代需要更改扩展数据的组码。
或者通过vla方式更改标注数据。
该程序中间禁止任何command函数，切记。