[下载]：圆及两条直线的中心线的命令

十个太阳

我觉得还可以，不收爱心币的。

十个太阳

中心线画法。
command：zxx

yuer0103

呵呵，有点小意思。不错啊！

xyp1964

中心线－－支持CIRCLE、ARC、LINE、ELLIPSE

2. [FONT=courier new]
   
3. (load "xyp_lib")
   
4. ;|加载通用函数(可在签名栏直接下载)
   
5. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
6. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
7. ★1·在acad.lsp中增加(load"xyp_lib")
   
8. ■2·在每个程序内增加(load"xyp_lib")
   
9. ■3·在command下，输入(load"xyp_lib")
   
10. ■4·在菜单.mnl中增加(load"xyp_lib")
    
11. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
    
12. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
13. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
14. |;
    
15. 
    
16. ;;;中心线－－支持CIRCLE、ARC、LINE、ELLIPSE
    
17. (defun c:test ()
    
18.   (CMDLA0)
    
19.   (setq        s1    (car (entsel "\n选择实体 : "))
    
20.         etype (xyp-get-Dxf 0 s1)
    
21.   )
    
22.   (mkla "ZXX" 1)
    
23.   (cond        ((or (= etype "CIRCLE") (= etype "ARC"))
    
24.          (setq rad (xyp-get-Dxf 40 s1))
    
25.          (setvar "DIMCEN" rad)
    
26.          (command "dim1" "cen" (list s1 '(0 0)))
    
27.         )
    
28.         ((= etype "LINE")
    
29.          (setq s2     (car (entsel "\n选择LINE线 : "))
    
30.                etype2 (xyp-get-Dxf 0 s2)
    
31.          )
    
32.          (while        (/= etype2 "LINE")
    
33.            (setq s2        (car (entsel "\n选择LINE线 : "))
    
34.                  etype2        (xyp-get-Dxf 0 s2)
    
35.            )
    
36.          )
    
37.          (setq pt10 (xyp-get-MinMaxPoint s1 1)
    
38.                pt11 (xyp-get-MinMaxPoint s1 0)
    
39.                pt20 (xyp-get-MinMaxPoint s2 1)
    
40.                pt21 (xyp-get-MinMaxPoint s2 0)
    
41.                pt   (inters pt10 pt11 pt20 pt21 nil)
    
42.                ang1 (angle pt10 pt11)
    
43.                ang2 (angle pt20 pt21)
    
44.          )
    
45.          (if (> ang1 ang2)
    
46.            (setq ang (+ (/ (- ang1 ang2) 2) ang2))
    
47.            (setq ang (+ (/ (- ang2 ang1) 2) ang1))
    
48.          )
    
49.          (setq pt1 (polar pt ang 1000)
    
50.                pta (inters pt10 pt20 pt pt1 nil)
    
51.                ptb (inters pt11 pt21 pt pt1 nil)
    
52.          )
    
53.          (command "line" pta ptb "")
    
54.         )
    
55.         ((= etype "ELLIPSE")
    
56.          (setq pt10 (xyp-get-Dxf 10 s1)
    
57.                l1   (abs (CAR (xyp-get-Dxf 11 s1)))
    
58.                l2   (* l1 (xyp-get-Dxf 40 s1))
    
59.          )
    
60.          (command "LINE" (polar pt10 pi l1) (polar pt10 0 l1) "")
    
61.          (command "LINE"
    
62.                   (polar pt10 (* pi 0.5) l2)
    
63.                   (polar pt10 (* pi 1.5) l2)
    
64.                   ""
    
65.          )
    
66.         )
    
67.         ;;待续
    
68.         (t (princ "\暂不支持此类实体!"))
    
69.   )
    
70.   (CMDLA1)
    
71. )
    
72. [/FONT]

[FONT=courier new]<br /> (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]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> |;<br /> <br /> ;;;中心线－－支持CIRCLE、ARC、LINE、ELLIPSE<br /> (defun c:test ()<br />   (CMDLA0)<br />   (setq        s1    (car (entsel "\n选择实体 : "))<br />         etype (xyp-get-Dxf 0 s1)<br />   )<br />   (mkla "ZXX" 1)<br />   (cond        ((or (= etype "CIRCLE") (= etype "ARC"))<br />          (setq rad (xyp-get-Dxf 40 s1))<br />          (setvar "DIMCEN" rad)<br />          (command "dim1" "cen" (list s1 '(0 0)))<br />         )<br />         ((= etype "LINE")<br />          (setq s2     (car (entsel "\n选择LINE线 : "))<br />                etype2 (xyp-get-Dxf 0 s2)<br />          )<br />          (while        (/= etype2 "LINE")<br />            (setq s2        (car (entsel "\n选择LINE线 : "))<br />                  etype2        (xyp-get-Dxf 0 s2)<br />            )<br />          )<br />          (setq pt10 (xyp-get-MinMaxPoint s1 1)<br />                pt11 (xyp-get-MinMaxPoint s1 0)<br />                pt20 (xyp-get-MinMaxPoint s2 1)<br />                pt21 (xyp-get-MinMaxPoint s2 0)<br />                pt   (inters pt10 pt11 pt20 pt21 nil)<br />                ang1 (angle pt10 pt11)<br />                ang2 (angle pt20 pt21)<br />          )<br />          (if (> ang1 ang2)<br />            (setq ang (+ (/ (- ang1 ang2) 2) ang2))<br />            (setq ang (+ (/ (- ang2 ang1) 2) ang1))<br />          )<br />          (setq pt1 (polar pt ang 1000)<br />                pta (inters pt10 pt20 pt pt1 nil)<br />                ptb (inters pt11 pt21 pt pt1 nil)<br />          )<br />          (command "line" pta ptb "")<br />         )<br />         ((= etype "ELLIPSE")<br />          (setq pt10 (xyp-get-Dxf 10 s1)<br />                l1   (abs (CAR (xyp-get-Dxf 11 s1)))<br />                l2   (* l1 (xyp-get-Dxf 40 s1))<br />          )<br />          (command "LINE" (polar pt10 pi l1) (polar pt10 0 l1) "")<br />          (command "LINE"<br />                   (polar pt10 (* pi 0.5) l2)<br />                   (polar pt10 (* pi 1.5) l2)<br />                   ""<br />          )<br />         )<br />         ;;待续<br />         (t (princ "\暂不支持此类实体!"))<br />   )<br />   (CMDLA1)<br /> )<br /> [/FONT]

hcgou

好东西，顶一下。