[求助]：高手帮我看看坐标标注程序

eobser

以前在2002可以啊，现在在2004里就不行了
？？？？？？？？？？？？？？？？？？？
??(defun c:e_ptxy ()
?? (setvar "cmdecho" 0)
?? (setvar "plinewid" 0)
?? (if (= nil (setq th (getreal "\n输入文字高度<5>:")))
?? (setq th 5.0)
?? )
?? (while (setq pt (getpoint "\n选取座标点:"))
?? (setq ptx (cadr pt))
?? (setq pty (car pt))
?? (setq pt2 (getpoint pt "\n选取导出线位置:"))
?? (setq chr_x (strcat "x=" (rtos ptx 2 3)))
?? (setq chr_y (strcat "y=" (rtos pty 2 3)))
?? (command "point" pt)
?? (setq ang (angle pt pt2))
?? (if (and (> ang (/ pi 2)) (< ang (* pi 1.5)))
?? (setq ang2 pi)
?? (setq ang2 0.0)
?? )
?? (setq pt3 (polar pt2 ang2 (* th 8.0)))
?? (setq p21 (car pt2))
?? (setq p22 (cadr pt2))
?? (setq p31 (car pt3))
?? (setq p32 (cadr pt3))
?? (setq p41 (/ (+ p21 p31) 2))
?? (setq p42 (/ (+ p22 p32) 2))
?? (setq pt4 (list p41 p42 0))
?? (command "pline" pt pt2 pt3 "")
?? (command "text" "bc" pt4 th "" chr_x )
?? (command "text" "tc" pt4 th "" chr_y )
?? )
?? (princ)
??)

xyp1964

没啥问题：

2. [FONT=courier new](defun c:test ()
   
3.   (setvar "cmdecho" 0)
   
4.   (setvar "plinewid" 0)
   
5.   (if (= nil (setq th (getreal "\n输入文字高度<300>:")))
   
6.     (setq th 300)
   
7.   )
   
8.   (while (setq pt (getpoint "\n选取座标点:"))
   
9.     (setq ptx        (cadr pt)
   
10.           pty        (car pt)
    
11.           pt2        (getpoint pt "\n选取导出线位置:")
    
12.           chr_x        (strcat "x=" (rtos ptx 2 3))
    
13.           chr_y        (strcat "y=" (rtos pty 2 3))
    
14.     )
    
15.     (command "point" pt)
    
16.     (setq ang (angle pt pt2))
    
17.     (if        (and (> ang (/ pi 2)) (< ang (* pi 1.5)))
    
18.       (setq ang2 pi)
    
19.       (setq ang2 0.0)
    
20.     )
    
21.     (setq pt3 (polar pt2 ang2 (* th 8.0))
    
22.           p21 (car pt2)
    
23.           p22 (cadr pt2)
    
24.           p31 (car pt3)
    
25.           p32 (cadr pt3)
    
26.           p41 (/ (+ p21 p31) 2)
    
27.           p42 (/ (+ p22 p32) 2)
    
28.           pt4 (list p41 p42 0)
    
29.     )
    
30.     (command "pline" pt pt2 pt3 "")
    
31.     (command "text" "bc" (polar pt4 (* pi 0.5)100) th "" chr_x)
    
32.     (command "text" "tc" (polar pt4 (* pi 1.5)100) th "" chr_y)
    
33.   )
    
34.   (princ)
    
35. )[/FONT]

[FONT=courier new](defun c:test ()<br />   (setvar "cmdecho" 0)<br />   (setvar "plinewid" 0)<br />   (if (= nil (setq th (getreal "\n输入文字高度<300>:")))<br />     (setq th 300)<br />   )<br />   (while (setq pt (getpoint "\n选取座标点:"))<br />     (setq ptx        (cadr pt)<br />           pty        (car pt)<br />           pt2        (getpoint pt "\n选取导出线位置:")<br />           chr_x        (strcat "x=" (rtos ptx 2 3))<br />           chr_y        (strcat "y=" (rtos pty 2 3))<br />     )<br />     (command "point" pt)<br />     (setq ang (angle pt pt2))<br />     (if        (and (> ang (/ pi 2)) (< ang (* pi 1.5)))<br />       (setq ang2 pi)<br />       (setq ang2 0.0)<br />     )<br />     (setq pt3 (polar pt2 ang2 (* th 8.0))<br />           p21 (car pt2)<br />           p22 (cadr pt2)<br />           p31 (car pt3)<br />           p32 (cadr pt3)<br />           p41 (/ (+ p21 p31) 2)<br />           p42 (/ (+ p22 p32) 2)<br />           pt4 (list p41 p42 0)<br />     )<br />     (command "pline" pt pt2 pt3 "")<br />     (command "text" "bc" (polar pt4 (* pi 0.5)100) th "" chr_x)<br />     (command "text" "tc" (polar pt4 (* pi 1.5)100) th "" chr_y)<br />   )<br />   (princ)<br /> )[/FONT]

可以试试签名栏下的“坐标标注”程序。

eobser

谢谢斑竹
试试看

zzyong00

有问题，用默认的字高5时，就会出错，而自已输入一字高，如3，标出的来的字高还是5