请各位高手帮忙加上中心线

王航

请各位高手帮忙，给下面的程序加上中心线，谢谢！

(defun c:ttt (/ w p1 p2 ang )
  (setvar "cmdecho" 0)
  (setvar "osmode" 1023)
  (princ "画长圆孔")
  (if (= ctk_d nil) (setq ctk_d 13))
  (princ (strcat "\n请设定长圆孔直径 <" (rtos ctk_d 2 3) ">: "))
  (setq a (getdist))
  (if (= a nil) (setq a ctk_d))
  (setq ctk_d a)
  (setq r (/ ctk_d 2))
  (while (and
           (setq pt (getpoint "\n指定插入点："))
           (setq pta  (getpoint pt "\n指定另一点："))
          );and
    (setq ang  (angle pt pta)
       di  (distance pt pta)
       ptb  (polar pt ang r)
       pt1  (polar ptb (+ ang (/ pi 2)) r)
       pt2  (polar pt1 ang (- di (* r 2)))
       pt3  (polar ptb (+ ang (/ pi -2)) r)
       pt4  (polar pt3 ang (- di (* r 2)))
     );set
    (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")
    (command "redrawall")
    (princ "\n**继续输入**")
  );while
  (princ)
);defun

x_s_s_1

试试

2. (defun c:ttt (/ a p1 p2 ang pt pta ptt r)
   
3.   (setvar "cmdecho" 0)
   
4.   (setvar "osmode" 1023)
   
5.   (princ "画长圆孔")
   
6.   (if (= ctk_d nil) (setq ctk_d 13))
   
7.   (princ (strcat "\n请设定长圆孔直径 <" (rtos ctk_d 2 3) ">: "))
   
8.   (setq a (getdist))
   
9.   (if (= a nil) (setq a ctk_d))
   
10.   (setq ctk_d a)
    
11.   (setq r (/ ctk_d 2))
    
12.   (while (and
    
13.            (setq pt (getpoint "\n指定插入点："))
    
14.            (setq pta  (getpoint pt "\n指定另一点："))
    
15.           );and
    
16.     (setq ang  (angle pt pta)
    
17.        di  (distance pt pta)
    
18.        ptb  (polar pt ang r)
    
19.        pt1  (polar ptb (+ ang (/ pi 2)) r)
    
20.        pt2  (polar pt1 ang (- di (* r 2)))
    
21.        pt3  (polar ptb (+ ang (/ pi -2)) r)
    
22.        pt4  (polar pt3 ang (- di (* r 2)))
    
23.           ptt(mapcar '(lambda(x)(/ x 2))(mapcar '+ pt pta))
    
24.      );set
    
25.     (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")
    
26.     (command "line" (polar pt (+ ang pi) 50) (polar pta ang 50) "")
    
27.     (command "change" (entlast) "" "p" "c" 1 "")
    
28.     (command "line" (polar ptt (+ ang (/ pi 2)) (+ r 50)) (polar ptt (- ang (/ pi 2)) (+ r 50)) "")
    
29.     (command "change" (entlast) "" "p" "c" 1 "")
    
30.     (command "redrawall")
    
31.     (princ "\n**继续输入**")
    
32.   );while
    
33.   (princ)
    
34. );defun

(defun c:ttt (/ a p1 p2 ang pt pta ptt r)<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 1023)<br />   (princ "画长圆孔")<br />   (if (= ctk_d nil) (setq ctk_d 13))<br />   (princ (strcat "\n请设定长圆孔直径 <" (rtos ctk_d 2 3) ">: "))<br />   (setq a (getdist))<br />   (if (= a nil) (setq a ctk_d))<br />   (setq ctk_d a)<br />   (setq r (/ ctk_d 2))<br />   (while (and<br />            (setq pt (getpoint "\n指定插入点："))<br />            (setq pta  (getpoint pt "\n指定另一点："))<br />           );and<br />     (setq ang  (angle pt pta)<br />        di  (distance pt pta)<br />        ptb  (polar pt ang r)<br />        pt1  (polar ptb (+ ang (/ pi 2)) r)<br />        pt2  (polar pt1 ang (- di (* r 2)))<br />        pt3  (polar ptb (+ ang (/ pi -2)) r)<br />        pt4  (polar pt3 ang (- di (* r 2)))<br />           ptt(mapcar '(lambda(x)(/ x 2))(mapcar '+ pt pta))<br />      );set<br />     (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")<br />     (command "line" (polar pt (+ ang pi) 50) (polar pta ang 50) "")<br />     (command "change" (entlast) "" "p" "c" 1 "")<br />     (command "line" (polar ptt (+ ang (/ pi 2)) (+ r 50)) (polar ptt (- ang (/ pi 2)) (+ r 50)) "")<br />     (command "change" (entlast) "" "p" "c" 1 "")<br />     (command "redrawall")<br />     (princ "\n**继续输入**")<br />   );while<br />   (princ)<br /> );defun

CTC

中心线也不是这样布的吧

王航

x_s_s_1 发表于 2013-5-28 10:27
试试

1. (defun c:ttt (/ a p1 p2 ang pt pta ptt r)
   
2.   (setvar "cmdecho" 0)
   
3.   (setvar "osmode" 1023)
   
4.   (princ "画长圆孔")
   
5.   (if (= ctk_d nil) (setq ctk_d 13))
   
6.   (princ (strcat "\n请设定长圆孔直径 <" (rtos ctk_d 2 3) ">: "))
   
7.   (setq a (getdist))
   
8.   (if (= a nil) (setq a ctk_d))
   
9.   (setq ctk_d a)
   
10.   (setq r (/ ctk_d 2))
    
11.   (while (and
    
12.            (setq pt (getpoint "\n指定插入点："))
    
13.            (setq pta  (getpoint pt "\n指定另一点："))
    
14.           );and
    
15.     (setq ang  (angle pt pta)
    
16.        di  (distance pt pta)
    
17.        ptb  (polar pt ang r)
    
18.        pt1  (polar ptb (+ ang (/ pi 2)) r)
    
19.        pt2  (polar pt1 ang (- di (* r 2)))
    
20.        pt3  (polar ptb (+ ang (/ pi -2)) r)
    
21.        pt4  (polar pt3 ang (- di (* r 2)))
    
22.           ptt(mapcar '(lambda(x)(/ x 2))(mapcar '+ pt pta))
    
23.      );set
    
24.     (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")
    
25.     (command "line" (polar pt (+ ang pi) (* r 1.2)) (polar pta ang (* r 1.2)) "")
    
26.     (command "change" (entlast) "" "p" "la" "点划线" "")
    
27.     (command "line" (polar ptt (+ ang (/ pi 2)) (* r 2.2)) (polar ptt (- ang (/ pi 2)) (* r 2.2)) "")
    
28.     (command "change" (entlast) "" "p" "la" "点划线" "")
    
29.     (command "redrawall")
    
30.     (princ "\n**继续输入**")
    
31.   );while
    
32.   (princ)
    
33. );defun

(defun c:ttt (/ a p1 p2 ang pt pta ptt r)<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 1023)<br />   (princ "画长圆孔")<br />   (if (= ctk_d nil) (setq ctk_d 13))<br />   (princ (strcat "\n请设定长圆孔直径 <" (rtos ctk_d 2 3) ">: "))<br />   (setq a (getdist))<br />   (if (= a nil) (setq a ctk_d))<br />   (setq ctk_d a)<br />   (setq r (/ ctk_d 2))<br />   (while (and<br />            (setq pt (getpoint "\n指定插入点："))<br />            (setq pta  (getpoint pt "\n指定另一点："))<br />           );and<br />     (setq ang  (angle pt pta)<br />        di  (distance pt pta)<br />        ptb  (polar pt ang r)<br />        pt1  (polar ptb (+ ang (/ pi 2)) r)<br />        pt2  (polar pt1 ang (- di (* r 2)))<br />        pt3  (polar ptb (+ ang (/ pi -2)) r)<br />        pt4  (polar pt3 ang (- di (* r 2)))<br />           ptt(mapcar '(lambda(x)(/ x 2))(mapcar '+ pt pta))<br />      );set<br />     (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")<br />     (command "line" (polar pt (+ ang pi) (* r 1.2)) (polar pta ang (* r 1.2)) "")<br />     (command "change" (entlast) "" "p" "la" "点划线" "")<br />     (command "line" (polar ptt (+ ang (/ pi 2)) (* r 2.2)) (polar ptt (- ang (/ pi 2)) (* r 2.2)) "")<br />     (command "change" (entlast) "" "p" "la" "点划线" "")<br />     (command "redrawall")<br />     (princ "\n**继续输入**")<br />   );while<br />   (princ)<br /> );defun

谢谢你！这个程序我改了一下，使得中心线延伸长度为1.2倍半径，我想实现延伸长度为0.2倍半径，却怎么也实现不了，烦劳您给指点一下。
(defun c:ttt (/ a p1 p2 ang pt pta ptt r)
  (setvar "cmdecho" 0)
  (setvar "osmode" 1023)
  (princ "画长圆孔")
  (if (= ctk_d nil) (setq ctk_d 13))
  (princ (strcat "\n请设定长圆孔直径 <" (rtos ctk_d 2 3) ">: "))
  (setq a (getdist))
  (if (= a nil) (setq a ctk_d))
  (setq ctk_d a)
  (setq r (/ ctk_d 2))
  (while (and
           (setq pt (getpoint "\n指定插入点："))
           (setq pta  (getpoint pt "\n指定另一点："))
          );and
    (setq ang  (angle pt pta)
       di  (distance pt pta)
       ptb  (polar pt ang r)
       pt1  (polar ptb (+ ang (/ pi 2)) r)
       pt2  (polar pt1 ang (- di (* r 2)))
       pt3  (polar ptb (+ ang (/ pi -2)) r)
       pt4  (polar pt3 ang (- di (* r 2)))
          ptt(mapcar '(lambda(x)(/ x 2))(mapcar '+ pt pta))
     );set
    (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")
    (command "line" (polar pt (+ ang pi) (* r 1.2)) (polar pta ang (* r 1.2)) "")
    (command "change" (entlast) "" "p" "la" "点划线" "")
    (command "line" (polar ptt (+ ang (/ pi 2)) (* r 2.2)) (polar ptt (- ang (/ pi 2)) (* r 2.2)) "")
    (command "change" (entlast) "" "p" "la" "点划线" "")
    (command "redrawall")
    (princ "\n**继续输入**")
  );while
  (princ)
);defun

ucuc2003

中心线修改好了

ucuc2003

重新修改了

王航

ucuc2003 发表于 2013-5-28 14:50
重新修改了

非常感谢，我先看看，有时间向你学习一下！

ucuc2003

修改好了。

王航

ucuc2003 发表于 2013-5-28 20:23
修改好了。

非常感谢！只是，中心线的线型比例不是1，也不固定，总在变化。

成仔

支持！感谢分享