怎么完善 序号球 程序

lengxiaxi

   程序是一个标序号球的LSP，目前问题是：设置半径增大时，球标内文字没有一起变大
                                    

以下源码：

(defun c:xh ()
   (setvar "cmdecho" 0)   ;命令回显
  (setq tx (getint "\n起始数字:"))
   (if (= tx nil)(setq tx 1))
   (setq yq (getdist "\n序号球直径:"))
   (if (= yq nil)(setq yq 5))
   (while
     (setq os (getvar "osmode"))  ;系统变量
     (setq po (getpoint "\n引线起点:"))
      (setvar "osmode" 0)  ;设置系统变量
     (command "line" po pause "")
      (setq pt (cadr (grread pause)))
      (setq ang (angle po pt))
      (command "circle" "2p" pt (polar pt ang yq) "")
      (setq cir entlast)
      (setq cirdata (cdr (assoc 10 (entget (cir)))))
      (command "text" "j" "m" cirdata "" "" tx "")
      (setq tx (1+ tx))
      (setvar "osmode" os)
   )
)

如何修改？？

wzg356

2. (defun c:xh ( / os tx yq po pt ang cir cirdata )
   
3.         (setq os (getvar "osmode"))  ;系统变量   
   
4.    (setvar "cmdecho" 0)   ;命令回显
   
5.   (setq tx (getint "\n 序号起始数字(1):"))
   
6.    (if (= tx nil)(setq tx 1))
   
7.    (setq yq (getdist "\n序号球直径(5):"))
   
8.    (if (= yq nil)(setq yq 5))
   
9.    (while (setq po (getpoint "\n引线起点:"))
   
10.      (command "line" po pause "")
    
11.       (setq pt (cadr (grread pause)))
    
12.       (setq ang (angle po pt))
    
13.       (command "circle" "2p" pt (polar pt ang yq))
    
14.       (setq cir entlast)
    
15.       (setq cirdata (cdr (assoc 10 (entget (cir)))))
    
16.       (command "text" "j" "m" cirdata "" "" tx)
    
17.       (setq tx (1+ tx))
    
18.    )   
    
19.    (setvar "osmode" os)
    
20.    (princ)
    
21. )

(defun c:xh ( / os tx yq po pt ang cir cirdata )<br />         (setq os (getvar "osmode"))  ;系统变量    <br />    (setvar "cmdecho" 0)   ;命令回显<br />   (setq tx (getint "\n 序号起始数字(1):"))<br />    (if (= tx nil)(setq tx 1))<br />    (setq yq (getdist "\n序号球直径(5):"))<br />    (if (= yq nil)(setq yq 5)) <br />    (while (setq po (getpoint "\n引线起点:"))<br />      (command "line" po pause "")<br />       (setq pt (cadr (grread pause)))<br />       (setq ang (angle po pt))<br />       (command "circle" "2p" pt (polar pt ang yq))<br />       (setq cir entlast)<br />       (setq cirdata (cdr (assoc 10 (entget (cir)))))<br />       (command "text" "j" "m" cirdata "" "" tx)<br />       (setq tx (1+ tx))<br />    )   <br />    (setvar "osmode" os)<br />    (princ)<br /> )

chenbh2

很好,谢谢!

lengxiaxi

wzg356 发表于 2014-11-18 23:25

不行，没有效果，直径变化时 ，文字依然没有变化

ZZXXQQ

2. (defun c:xh ( / os tx yq high po pc)
   
3.   (setq os (getvar "osmode"))  ;系统变量   
   
4.   (setvar "cmdecho" 0)   ;命令回显
   
5.   (setq tx (getint "\n 序号起始数字(1):"))
   
6.   (if (= tx nil)(setq tx 1))
   
7.   (setq yq (getdist "\n序号球直径(5):"))
   
8.   (if (= yq nil)(setq yq 5))
   
9.         (setq high (* yq 1.5))
   
10.   (while (and (setq po (getpoint "\n引线起点: "))
    
11.               (setq pc (getpoint po "\n引线终点: ")))
    
12.    (setq pe (polar pc (angle pc po) yq))
    
13.    (command "line" po pe "" "circle" pc yq)
    
14.    (command "text" "m" pc high "" (itoa tx))
    
15.    (setq tx (1+ tx))
    
16.   )
    
17.   (setvar "osmode" os)
    
18.   (setvar "CMDECHO" 1)
    
19.   (princ)
    
20. )

(defun c:xh ( / os tx yq high po pc)<br />   (setq os (getvar "osmode"))  ;系统变量    <br />   (setvar "cmdecho" 0)   ;命令回显<br />   (setq tx (getint "\n 序号起始数字(1):"))<br />   (if (= tx nil)(setq tx 1))<br />   (setq yq (getdist "\n序号球直径(5):"))<br />   (if (= yq nil)(setq yq 5))<br />         (setq high (* yq 1.5))<br />   (while (and (setq po (getpoint "\n引线起点: "))<br />               (setq pc (getpoint po "\n引线终点: ")))<br />    (setq pe (polar pc (angle pc po) yq))<br />    (command "line" po pe "" "circle" pc yq)<br />    (command "text" "m" pc high "" (itoa tx))<br />    (setq tx (1+ tx))<br />   )<br />   (setvar "osmode" os)<br />   (setvar "CMDECHO" 1)<br />   (princ)<br /> )

lengxiaxi

ZZXXQQ 发表于 2014-11-19 21:31

命令: ; 错误: 输入的列表有缺陷   不能正常运行 运行环境 autocad 2004

lengxiaxi

lengxiaxi 发表于 2014-11-20 22:09
命令: ; 错误: 输入的列表有缺陷   不能正常运行 运行环境 autocad 2004

改的很棒！已达到预期效果！谢谢Z版！

Z版如果有空的话，能否帮忙看看我的另外一个帖子 http://bbs.mjtd.com/thread-112101-3-1.html 有热心人回复晓东有个类似的lsp，但是我试了下，应该是需要加载晓东api的，您能帮我写个独立的lsp吗？我想很多做钣金的人也需要这样一个lsp提高绘图速度。

highflybird2014

lengxiaxi 发表于 2014-11-21 19:49
改的很棒！已达到预期效果！谢谢Z版！

Z版如果有空的话，能否帮忙看看我的另外一个帖子 http://bbs.mj ...

人心不足蛇吞象啊！

lengxiaxi

highflybird2014 发表于 2014-11-21 20:36
人心不足蛇吞象啊！

我这个‘不足’，不为金钱，不为名利，只为画好图，您说这过分不？

lengxiaxi

lengxiaxi 发表于 2014-11-22 10:15
我这个‘不足’，不为金钱，不为名利，只为画好图，您说这过分不？

亲，我的帖子多数是请人修改的，不单单是来求写的。

   另外一点，明经最大的特点就是分享精神！ 我虽然只能提供不完美的源码，但是经过大家的帮助后，变得完善，然后可以给更多的人搜索到，并下载应用，你说这不也是一个好事吗？并不是所有的欲望都是不好的，求知与分享不也是一种欲望吗？与其在这里评论是与非，不如把这点时间留出来多帮助下别人。对吗?