[求助]：大家好，能教我一个程序吗？

张涛

大家好，我是一个新会员，而且是刚刚学习ＡＵＴＯＬＩＳＰ

语言。在这里我想请哪位热心的老师帮我编写一个程序。好吗？

“要求绘制一个圆锥滚子轴承“

不过要每一句都有说明！在这里先谢谢了。


真诚的希望你们的帮忙。

                                              张涛

zhynt

搞机械的朋友来帮忙啊，我是学建筑的，对机械方面一窍不通。

lijiao

最初由 张涛 发布
[B]大家好，我是一个新会员，而且是刚刚学习ＡＵＴＯＬＩＳＰ

语言。在这里我想请哪位热心的老师帮我编写一个程序。好吗？

“要求绘制一个圆锥滚子轴承“

不过要每一句都有说明！在这里先谢谢了。


真诚的... [/B]

论坛中的LSP程序多如牛毛，为什么非要“绘制一个圆锥滚子轴承”的LSP，我这儿正好有一个关于拖动的小程序，是帮网友修改的，你可以参考一下。

2. 
   
3.   [FONT=courier new]
   
4. ;;;0.01 (2003.3.31) for r2002
   
5. ;;;测试GRREAD
   
6. (defun c:t1 (/ pt1 pt2 ls line1 ts1 ds ts2 tx1 tx2 pick p ip pt p1)
   
7.   (setvar "CMDECHO" 0)
   
8.   (setq pt1 (getpoint "\please input pt1"))
   
9.   (while (= 0 (distance (setq pt2 (cadr (grread t 4 0))) pt1))
   
10.   )
    
11.   (command "line" pt1 pt2 "")
    
12.   (setq ls (entlast))
    
13.   (setq line1 (entget ls))
    
14.   (setq ts1 "  long=")
    
15.   (setq ds (rtos (distance pt1 pt2) 2 2))
    
16.   (setq ts2 (strcat ts1 ds))
    
17.   (command "text" pt2 (/ (getvar "viewsize") 40.0) "" ts2)
    
18.   (setq tx1 (entlast))
    
19.   (vla-put-color (vlax-ename->vla-object tx1) 1)
    
20.   (setq tx2 (entget tx1))
    
21.   (setq pick nil)
    
22.   (while (not pick)
    
23.     (setq p (grread t 4 0))
    
24.     (princ)
    
25.     (setq ip (car p))
    
26.     (setq pt (cadr p))
    
27.     (if        (= ip 5)
    
28. ;;;;;;;;;;;;;;确定为坐标移动
    
29.       (progn
    
30.         (setq p1 (trans pt 1 0))
    
31.         ;;坐标系转换（以防止更新数据表时出错）
    
32.         (setq line1 (subst (cons 11 p1) (assoc 11 line1) line1))
    
33.         (entmod line1)
    
34.         (setq ds (rtos (distance pt1 p1) 2 2))
    
35.         (setq ts2 (strcat ts1 ds))
    
36.         (setq tx2 (subst (cons 10 p1) (assoc 10 tx2) tx2))
    
37.         (setq tx2 (subst (cons 1 ts2) (assoc 1 tx2) tx2))
    
38.         (setq tx2 (subst (cons 40 (/ (getvar "viewsize") 40.0)) (assoc 40 tx2) tx2))
    
39.         (entmod tx2)
    
40.       )
    
41.       ;;progn
    
42.     )
    
43.     ;;if
    
44.     (setq pick (= 3 ip))
    
45. ;;;;;确定为点取坐标
    
46.   )
    
47.   ;;while
    
48.   (entdel tx1)
    
49.   (setvar "CMDECHO" 1)
    
50.   (princ)
    
51. )
    
52. 
    
53.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;0.01 (2003.3.31) for r2002<br /> ;;;测试GRREAD<br /> (defun c:t1 (/ pt1 pt2 ls line1 ts1 ds ts2 tx1 tx2 pick p ip pt p1)<br />   (setvar "CMDECHO" 0)<br />   (setq pt1 (getpoint "\please input pt1"))<br />   (while (= 0 (distance (setq pt2 (cadr (grread t 4 0))) pt1))<br />   )<br />   (command "line" pt1 pt2 "")<br />   (setq ls (entlast))<br />   (setq line1 (entget ls))<br />   (setq ts1 "  long=")<br />   (setq ds (rtos (distance pt1 pt2) 2 2))<br />   (setq ts2 (strcat ts1 ds))<br />   (command "text" pt2 (/ (getvar "viewsize") 40.0) "" ts2)<br />   (setq tx1 (entlast))<br />   (vla-put-color (vlax-ename->vla-object tx1) 1)<br />   (setq tx2 (entget tx1))<br />   (setq pick nil)<br />   (while (not pick)<br />     (setq p (grread t 4 0))<br />     (princ)<br />     (setq ip (car p))<br />     (setq pt (cadr p))<br />     (if        (= ip 5)<br /> ;;;;;;;;;;;;;;确定为坐标移动<br />       (progn<br />         (setq p1 (trans pt 1 0))<br />         ;;坐标系转换（以防止更新数据表时出错）<br />         (setq line1 (subst (cons 11 p1) (assoc 11 line1) line1))<br />         (entmod line1)<br />         (setq ds (rtos (distance pt1 p1) 2 2))<br />         (setq ts2 (strcat ts1 ds))<br />         (setq tx2 (subst (cons 10 p1) (assoc 10 tx2) tx2))<br />         (setq tx2 (subst (cons 1 ts2) (assoc 1 tx2) tx2))<br />         (setq tx2 (subst (cons 40 (/ (getvar "viewsize") 40.0)) (assoc 40 tx2) tx2))<br />         (entmod tx2)<br />       )<br />       ;;progn<br />     )<br />     ;;if<br />     (setq pick (= 3 ip))<br /> ;;;;;确定为点取坐标<br />   )<br />   ;;while<br />   (entdel tx1)<br />   (setvar "CMDECHO" 1)<br />   (princ)<br /> )<br /> <br />   [/FONT]<br />