[求助]：路过朋友进来帮忙改一下

zxcvbnm-cad

帮忙把下面的程序改一下
1、把圆改成直线
2、左键为继续，右键改成结束

[php](defun c:text()
  (vl-load-com)
  (setq h (* (getvar "dimscale")(getvar "dimtxt"))
        r h
       sn 1)
  (while sn
    (setq p0 (getpoint "\n指定插入点:"))
    (setq loop t)
    (command "CIRCLE" p0 r)
    (setq ceo (vlax-ename->vla-object (entlast)))
    (vl-cmdf "text" "j" "m" p0 h 0 (itoa sn) "")
    (setq teo (vlax-ename->vla-object (entlast)))
    (command "leader" p0 (polar p0 (/ pi 4) 0.1)  "" "" "n")
    (setq le (entlast))
    (setq leo (vlax-ename->vla-object le))
    (setq p1 (vlax-curve-getstartpoint le))
    (while loop
      (setq p (grread T))
      (setq k (car p)
            p (cadr p))
      (if (= k 3)(setq loop nil))
      (vla-put-center ceo (vlax-3d-point p))
      (vla-put-textalignmentpoint teo (vlax-3d-point p))
      (vla-update ceo)
    (setq sl (vlax-make-safearray vlax-vbdouble '(0 . 5)))
       (setq sa (vlax-safearray-fill sl (append p1 (polar p (angle p p1) r))))
       (vla-put-coordinates leo sa)
    )
    (setq sn (1+ sn))
    (setq ct (getstring "\n继续<N>?"))
    (if (= (strcase ct) "N")(setq sn nil))
  )
)[/php]

xyp1964

太复杂，没法改，重新写了一个：

2. [FONT=courier new](load "xyp_lib")
   
3. ;|加载通用函数(可在签名栏直接下载)
   
4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
5. 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
   
6. 1.在acad.lsp中增加(load"xyp_lib")
   
7. 2.在每个程序内增加(load"xyp_lib")
   
8. 3.在command下，输入(load"xyp_lib")
   
9. 4.在菜单.mnl中增加(load"xyp_lib")
   
10. 5.将xyp_lib.vlx文件直接拽到cad屏幕
    
11. [COLOR=red] ★通用函数下载地址：[/COLOR][url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]|;
    
12. 
    
13. ;;;引线标注
    
14. (defun c:test ()
    
15.   (CMDLASC0)
    
16.   (jzhz)
    
17.   (mkla"引线标注"3)
    
18.   (setvar "dimasz" (* sc 300))
    
19.   (setvar "DIMTXT" (* sc 300))
    
20.   (setvar"DIMTXSTY""宋体")
    
21.   (setq i 0)
    
22.   (while (setq pt1 (getpoint "\n起点<退出> : "))
    
23.     (if        (setq pt2 (getpoint pt1 "\n标注点<退出> : "))
    
24.       (progn
    
25.         (setq i (1+ i))
    
26.         (command "leader" pt1 pt2 "" (rtos i 2 0) "")
    
27.       )
    
28.     )
    
29.   )
    
30.   (CMDLA1)
    
31. )[/FONT]

[FONT=courier new](load "xyp_lib")<br /> ;|加载通用函数(可在签名栏直接下载)<br /> 如果已经下载xyp_lib并放到搜索路径下可以不再下载!<br /> 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：<br /> 1.在acad.lsp中增加(load"xyp_lib")<br /> 2.在每个程序内增加(load"xyp_lib")<br /> 3.在command下，输入(load"xyp_lib")<br /> 4.在菜单.mnl中增加(load"xyp_lib")<br /> 5.将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR][url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]|; <br /> <br /> ;;;引线标注<br /> (defun c:test ()<br />   (CMDLASC0)<br />   (jzhz)<br />   (mkla"引线标注"3)<br />   (setvar "dimasz" (* sc 300))<br />   (setvar "DIMTXT" (* sc 300))<br />   (setvar"DIMTXSTY""宋体")<br />   (setq i 0)<br />   (while (setq pt1 (getpoint "\n起点<退出> : "))<br />     (if        (setq pt2 (getpoint pt1 "\n标注点<退出> : "))<br />       (progn<br />         (setq i (1+ i))<br />         (command "leader" pt1 pt2 "" (rtos i 2 0) "")<br />       )<br />     )<br />   )<br />   (CMDLA1)<br /> )[/FONT]

zxcvbnm-cad

xyp谢谢
帮忙再改一下
1 增加输入字高的选项
2 文字离线再高点

xyp1964

密技：命令 bl 可以改变出图比例以控制字高！

2. [FONT=courier new](defun c:test ()
   
3.   (CMDLASC0)
   
4.   (jzhz)
   
5.   (mkla "引线标注" 3)
   
6.   (setvar "DIMBLK" ".")
   
7.   (setvar "dimasz" (* sc 300))
   
8.   (setvar "DIMTXT" (* sc 300))
   
9.   (setvar "DIMGAP" (* sc 150))
   
10.   (setvar "DIMTXSTY" "宋体")
    
11.   (setq i 0)
    
12.   (while (setq pt1 (getpoint "\n起点<退出> : "))
    
13.     (if        (setq pt2 (getpoint pt1 "\n标注点<退出> : "))
    
14.       (progn
    
15.         (setq i (1+ i))
    
16.         (command "leader" pt1 pt2 "" (rtos i 2 0) "")
    
17.       )
    
18.     )
    
19.   )
    
20.   (CMDLA1)
    
21. )[/FONT]

[FONT=courier new](defun c:test ()<br />   (CMDLASC0)<br />   (jzhz)<br />   (mkla "引线标注" 3)<br />   (setvar "DIMBLK" ".")<br />   (setvar "dimasz" (* sc 300))<br />   (setvar "DIMTXT" (* sc 300))<br />   (setvar "DIMGAP" (* sc 150))<br />   (setvar "DIMTXSTY" "宋体")<br />   (setq i 0)<br />   (while (setq pt1 (getpoint "\n起点<退出> : "))<br />     (if        (setq pt2 (getpoint pt1 "\n标注点<退出> : "))<br />       (progn<br />         (setq i (1+ i))<br />         (command "leader" pt1 pt2 "" (rtos i 2 0) "")<br />       )<br />     )<br />   )<br />   (CMDLA1)<br /> )[/FONT]

zxcvbnm-cad

斑竹
程序好象不稳定有时好用有时不能用
帮忙再看一看

xyp1964

最初由 zxcvbnm-cad 发布
[B]斑竹
程序好象不稳定有时好用有时不能用
帮忙再看一看 [/B]

把问题说清楚，偶可不是神仙……

zxcvbnm-cad

前几天用的好好的
不知怎么这两天不能用了
命令行提示:
命令: test
错误: no function definition: CMDLASC0

xyp1964

最初由 zxcvbnm-cad 发布
[B]前几天用的好好的
不知怎么这两天不能用了
命令行提示:
命令: test
错误: no function definition: CMDLASC0 [/B]

重新下载“通用函数”！