[求助][LISP]，菜鸟请各位高手帮编一个标Y值的程序，先谢谢您了

mmmjjj

为表达清楚：设定小写yn为第n点在当前坐标下的真实y值，大写Yn为欲标注的第n点的Y值。欲求程序如下：
点取第1点，自动标注Y1值为0.000
点取第2点，标注其Y2值等于(y2-y1)/10
点取第3点，标注其Y3值等于(y3-y1)/10
点取第4点，标注其Y4值等于(y4-y1)/10
以此类推
请注意：标注的Yn值直接在点取选点处显示数值，不用带其它符号，数值取三位小数点，数值的文字方向为90度（与Y轴平行），字高为2.5（或取当前CAD默认字高）。
以上不知小弟表述清楚了没有，小弟没接触过lisp，恳请各位高手帮忙编写，在下谢谢您了！

meflying

注意画斜杠注释部分说明

2. 
   
3. ;直接点取要标注的点,右键结束
   
4. 
   
5. (defun MakeText(pt1 str h / ptInsert TextDxf)
   
6.   (setq TextDxf '(
   
7.              (0 . "MTEXT")
   
8.              (100 . "AcDbEntity")             ; 需要所有 R12 之后版本的图元
   
9.              (100 . "AcDbMText")                ; 将图元标记为 MTEXT
   
10.              )
    
11.   )
    
12.   (setq TextDxf (append TextDxf (list
    
13.                                   (cons 10 pt1)
    
14.                                   (cons 1 str)
    
15.                                   (cons 40 h)
    
16.                                   (cons 50  (/ pi 2))
    
17.                                 )
    
18.                 )
    
19.   )
    
20.   (entmake TextDxf)
    
21.   (princ)
    
22. )
    
23. (defun err(msg)
    
24.   (princ msg)
    
25.   (setq *error* errtmp)
    
26.   (setvar "dimzin" zin)
    
27.   (princ)
    
28. )
    
29. (defun C:dimy( / i pt y1 y)
    
30.   (setq errtmp *error*)
    
31.   (setq *error* err)
    
32.   (setq zin (getvar "dimzin"))
    
33.   (setvar "dimzin" 1)
    
34.   (setq i 1)
    
35.   (setq y1 nil)
    
36.   (while (setq pt (getpoint (strcat "\n点取第" (itoa i) "点:")))
    
37.     (if (not y1)
    
38.       (progn
    
39.         (setq y1 (cadr pt))
    
40.         (setq y 0)
    
41.       )
    
42.       (setq y (/ (- (cadr pt) y1) 10.0))
    
43.     )
    
44.     (MakeText (list;///////////////////////////此处供修改标注点位置////////////////////////
    
45.                 (+ (car pt) 0);正数表示沿x正方向移,否则就是负方向//////////////////////////
    
46.                 (+ (cadr pt) 0);正数表示沿x正方向移,否则就是负方向/////////////////////////
    
47.               );///////////////////////////此处供修改标注点位置////////////////////////////
    
48.               (rtos y 2 3)
    
49.               2.5
    
50.              )
    
51.     (setq i (1+ i))
    
52.   )
    
53.   (setq *error* errtmp)
    
54.   (setvar "dimzin" zin)
    
55. )
    

<br /> ;直接点取要标注的点,右键结束<br /> <br /> (defun MakeText(pt1 str h / ptInsert TextDxf)<br />   (setq TextDxf '(<br />              (0 . "MTEXT")<br />              (100 . "AcDbEntity")             ; 需要所有 R12 之后版本的图元<br />              (100 . "AcDbMText")                ; 将图元标记为 MTEXT<br />              )<br />   )<br />   (setq TextDxf (append TextDxf (list<br />                                   (cons 10 pt1)<br />                                   (cons 1 str)<br />                                   (cons 40 h)<br />                                   (cons 50  (/ pi 2))<br />                                 )<br />                 )<br />   )<br />   (entmake TextDxf)<br />   (princ)<br /> )<br /> (defun err(msg)<br />   (princ msg)<br />   (setq *error* errtmp)<br />   (setvar "dimzin" zin)<br />   (princ)<br /> )<br /> (defun C:dimy( / i pt y1 y)<br />   (setq errtmp *error*)<br />   (setq *error* err)<br />   (setq zin (getvar "dimzin"))<br />   (setvar "dimzin" 1)<br />   (setq i 1)<br />   (setq y1 nil)<br />   (while (setq pt (getpoint (strcat "\n点取第" (itoa i) "点:")))<br />     (if (not y1)<br />       (progn<br />         (setq y1 (cadr pt))<br />         (setq y 0)<br />       )<br />       (setq y (/ (- (cadr pt) y1) 10.0))<br />     )<br />     (MakeText (list;///////////////////////////此处供修改标注点位置////////////////////////<br />                 (+ (car pt) 0);正数表示沿x正方向移,否则就是负方向//////////////////////////<br />                 (+ (cadr pt) 0);正数表示沿x正方向移,否则就是负方向/////////////////////////<br />               );///////////////////////////此处供修改标注点位置////////////////////////////<br />               (rtos y 2 3)<br />               2.5<br />              )<br />     (setq i (1+ i))<br />   )<br />   (setq *error* errtmp)<br />   (setvar "dimzin" zin)<br /> )<br />

mmmjjj

非常感谢好心的meflying版主！非常好用，偶期望的功能全能实现，并且版主还很周到的给出了让我通过修改正负数值来修改标注位置的功能，真是非常感谢！

BDYCAD

不知你應用在什麼地方呢?

mmmjjj

BDYCAD发表于2004-1-11 10:03:00不知你應用在什麼地方呢?

标注管线标高:)
各位版主及其他高手，我想在保持meflying超级版主编写的程序基础上，请各位大侠帮我新增一个功能：
获取第n点的Y值后，再另点取任一点以将该第n点的Y值标在这另点的位置上。
－－－巨贪的菜鸟谢谢各位好心的高手！

meflying

你的意思是不是取点的位置和标注点的位置不同，而且没什么规律是吗？
这样改：
选位置时，如果直接点右件或回车，则在取点位置标注

2. 
   
3.                                         ;直接点取要标注的点,右键结束
   
4. 
   
5. (defun MakeText        (pt1 str h / ptInsert TextDxf)
   
6.   (setq        TextDxf        '(
   
7.                   (0 . "MTEXT")
   
8.                   (100 . "AcDbEntity")        ; 需要所有 R12 之后版本的图元
   
9.                   (100 . "AcDbMText")        ; 将图元标记为 MTEXT
   
10.                  )
    
11.   )
    
12.   (setq        TextDxf        (append        TextDxf
    
13.                         (list
    
14.                           (cons 10 pt1)
    
15.                           (cons 1 str)
    
16.                           (cons 40 h)
    
17.                           (cons 50 (/ pi 2))
    
18.                         )
    
19.                 )
    
20.   )
    
21.   (entmake TextDxf)
    
22.   (princ)
    
23. )
    
24. (defun err (msg)
    
25.   (princ msg)
    
26.   (setq *error* errtmp)
    
27.   (setvar "dimzin" zin)
    
28.   (princ)
    
29. )
    
30. (defun C:dimy (/ i pt pt2 y1 y)
    
31.   (setq errtmp *error*)
    
32.   (setq *error* err)
    
33.   (setq zin (getvar "dimzin"))
    
34.   (setvar "dimzin" 1)
    
35.   (setq i 1)
    
36.   (setq y1 nil)
    
37.   (while (setq pt (getpoint (strcat "\n点取第" (itoa i) "点:")))
    
38.     (if        (not y1)
    
39.       (progn
    
40.         (setq y1 (cadr pt))
    
41.         (setq y 0)
    
42.       )
    
43.       (setq y (/ (- (cadr pt) y1) 10.0))
    
44.     )
    
45.     (setq pt2 (getpoint "\n选择标注位置:"))
    
46.     (if (not pt2) (setq pt2 pt))
    
47.     (MakeText (list                        ;///////////////////////////此处供修改标注点位置////////////////////////
    
48.                 (+ (car pt2) 0)                ;正数表示沿x正方向移,否则就是负方向//////////////////////////
    
49.                 (+ (cadr pt2) 0)                ;正数表示沿x正方向移,否则就是负方向/////////////////////////
    
50.               )                                ;///////////////////////////此处供修改标注点位置////////////////////////////
    
51.               (rtos y 2 3)
    
52.               2.5
    
53.     )
    
54.     (setq i (1+ i))
    
55.   )
    
56.   (setq *error* errtmp)
    
57.   (setvar "dimzin" zin)
    
58.   (princ)
    
59. )
    
60. 
    
61. 
    

<br />                                         ;直接点取要标注的点,右键结束<br /> <br /> (defun MakeText        (pt1 str h / ptInsert TextDxf)<br />   (setq        TextDxf        '(<br />                   (0 . "MTEXT")<br />                   (100 . "AcDbEntity")        ; 需要所有 R12 之后版本的图元<br />                   (100 . "AcDbMText")        ; 将图元标记为 MTEXT<br />                  )<br />   )<br />   (setq        TextDxf        (append        TextDxf<br />                         (list<br />                           (cons 10 pt1)<br />                           (cons 1 str)<br />                           (cons 40 h)<br />                           (cons 50 (/ pi 2))<br />                         )<br />                 )<br />   )<br />   (entmake TextDxf)<br />   (princ)<br /> )<br /> (defun err (msg)<br />   (princ msg)<br />   (setq *error* errtmp)<br />   (setvar "dimzin" zin)<br />   (princ)<br /> )<br /> (defun C:dimy (/ i pt pt2 y1 y)<br />   (setq errtmp *error*)<br />   (setq *error* err)<br />   (setq zin (getvar "dimzin"))<br />   (setvar "dimzin" 1)<br />   (setq i 1)<br />   (setq y1 nil)<br />   (while (setq pt (getpoint (strcat "\n点取第" (itoa i) "点:")))<br />     (if        (not y1)<br />       (progn<br />         (setq y1 (cadr pt))<br />         (setq y 0)<br />       )<br />       (setq y (/ (- (cadr pt) y1) 10.0))<br />     )<br />     (setq pt2 (getpoint "\n选择标注位置:"))<br />     (if (not pt2) (setq pt2 pt))<br />     (MakeText (list                        ;///////////////////////////此处供修改标注点位置////////////////////////<br />                 (+ (car pt2) 0)                ;正数表示沿x正方向移,否则就是负方向//////////////////////////<br />                 (+ (cadr pt2) 0)                ;正数表示沿x正方向移,否则就是负方向/////////////////////////<br />               )                                ;///////////////////////////此处供修改标注点位置////////////////////////////<br />               (rtos y 2 3)<br />               2.5<br />     )<br />     (setq i (1+ i))<br />   )<br />   (setq *error* errtmp)<br />   (setvar "dimzin" zin)<br />   (princ)<br /> )<br /> <br /> <br />

mmmjjj

再次感谢好心的meflying版主（90度鞠躬）！
我试了一下，正是这样，非常好用！再次深表感谢！