画长形孔

726613

图一



图二

    根据图一选取两个圆孔，应如何编写程序实现图二效果，请高手们指点

前生

刘炎华 发表于 2020-8-2 18:11
哪位高手辛苦修改下，选取两点作为圆弧中心，感谢！

没明白你的意思？

刘炎华

现在选的两点成了象限点，如果作为圆弧的圆心（实际工作上用时会好些），谢谢！

小小的人

非常感谢各位大神的分享  学习了  谢谢

ZZXXQQ

2. (defun c:tt ()
   
3. (setvar "CMDECHO" 0)
   
4. (if (setq ss (ssget '((0 . "CIRCLE"))))
   
5.   (if (= (sslength ss) 2) (progn
   
6.    (setq ent1 (entget(ssname ss 0))
   
7.          pc1 (cdr(assoc 10 ent1))
   
8.          r1 (cdr(assoc 40 ent1))
   
9.          ent2 (entget(ssname ss 1))
   
10.          pc2 (cdr(assoc 10 ent2))
    
11.          r2 (cdr(assoc 40 ent2)))
    
12.   (if (equal r1 r2 1e-5) (progn
    
13.    (setq ang (angle pc1 pc2)
    
14.          p1 (polar pc1 (+ (/ pi 2) ang) r1)
    
15.          p2 (polar pc1 (+ (/ pi -2) ang) r1)
    
16.          p3 (polar pc2 (+ (/ pi 2) ang) r1)
    
17.          p4 (polar pc2 (+ (/ pi -2) ang) r1))
    
18.    (command "_.PLINE" "non" p1 "non" p3 "A" "non" p4 "L" "non" p2 "A" "C")
    
19.    (command "_.ERASE" ss "")
    
20.   ))
    
21. ))
    
22. )
    
23. (setvar "CMDECHO" 1)
    
24. (princ)
    
25. )
    

(defun c:tt ()<br /> (setvar "CMDECHO" 0)<br /> (if (setq ss (ssget '((0 . "CIRCLE"))))<br />   (if (= (sslength ss) 2) (progn<br />    (setq ent1 (entget(ssname ss 0))<br />          pc1 (cdr(assoc 10 ent1))<br />          r1 (cdr(assoc 40 ent1))<br />          ent2 (entget(ssname ss 1))<br />          pc2 (cdr(assoc 10 ent2))<br />          r2 (cdr(assoc 40 ent2)))<br />   (if (equal r1 r2 1e-5) (progn<br />    (setq ang (angle pc1 pc2)<br />          p1 (polar pc1 (+ (/ pi 2) ang) r1)<br />          p2 (polar pc1 (+ (/ pi -2) ang) r1)<br />          p3 (polar pc2 (+ (/ pi 2) ang) r1)<br />          p4 (polar pc2 (+ (/ pi -2) ang) r1))<br />    (command "_.PLINE" "non" p1 "non" p3 "A" "non" p4 "L" "non" p2 "A" "C")<br />    (command "_.ERASE" ss "")<br />   ))<br /> ))<br /> )<br /> (setvar "CMDECHO" 1)<br /> (princ)<br /> )<br />

726613

ZZXXQQ 发表于 2013-5-22 22:32

提示：tt
选择对象: 找到 1 个
选择对象: 找到 1 个，总计 2 个
选择对象:  ; 错误: no function definition: STRLENG

请问这是什么意思呢

仲文玉

(command "_.PLINE" p1 p3 "A" p4 "L" p2 "A" "C")
---> (command "_.PLINE" "non" p1 "non" p3 "A" "non" p4 "L" "non" p2 "A" "CL")
(if (= (strleng ss) 2) ---->(if (= (sslength ss) 2)

仲文玉

感觉楼主自己不尝试写，光顾着索取程序，其实我明白你要的是埋件图，有必要这样麻烦吗？做个块就得了。这种小程序自己编，遇到问题提出来，你才有长进。自己折腾很折腾！
给你以前我瞎写的

2. (defun c:tt ()
   
3.   (setvar "CMDECHO" 0)
   
4.   (if (and (setq r (getdist "\n半径 :"))
   
5.      (setq pt (getpoint "\n插入点 :"))
   
6.      (setq pta (getpoint pt "\n另一点 :"))
   
7.       )
   
8.     (progn
   
9.       (setq ang  (angle pt pta)
   
10.       di  (distance pt pta)
    
11.       ptb  (polar pt ang r)
    
12.       pt1  (polar ptb (+ ang (/ pi 2)) r)
    
13.       pt2  (polar pt1 ang (- di (* r 2)))
    
14.       pt3  (polar ptb (+ ang (/ pi -2)) r)
    
15.       pt4  (polar pt3 ang (- di (* r 2)))
    
16.       )
    
17.       (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")
    
18.     )
    
19.   )
    
20.   (setvar "CMDECHO" 1)
    
21.   (princ)
    
22. )

(defun c:tt ()<br />   (setvar "CMDECHO" 0)<br />   (if (and (setq r (getdist "\n半径 :"))<br />      (setq pt (getpoint "\n插入点 :"))<br />      (setq pta (getpoint pt "\n另一点 :"))<br />       )<br />     (progn<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 />       )<br />       (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")<br />     )<br />   )<br />   (setvar "CMDECHO" 1)<br />   (princ)<br /> )

ucuc2003

楼上说的很对，我也得好好反思下，多多自己操作练习，好好学习天天向上

ucuc2003

(defun c:CTK ()
   (setvar "CMDECHO" 0)
   (if (= ctk_d nil) (setq ctk_d 6))
   (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)
    (if (and
          (setq pt (getpoint "\n插入点 :"))
          (setq pta (getpoint pt "\n另一点 :"))
        )
     (progn
       (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)))
       )
       (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")
     )
   )
   (setvar "CMDECHO" 1)
   (princ)
)

ucuc2003

2. <img src="http://bbs.mjtd.com/forum.php?mod=attachment&aid=NzU4Nzh8ZTI5NWZjNDV8MTM2OTgwMjE5NXwzNTM2OTN8MTAxNjUz&noupdate=yes" border="0">;;;;画长条孔CTK
   
3. ;;;;源码明经仲文玉，修改ucuc2003
   
4. (defun c:CTK (/ w p1 p2 ang )
   
5.   (setvar "cmdecho" 0)
   
6.   (setvar "osmode" 1023)
   
7.   (princ "画长条孔")
   
8. 
   
9.   (if (= ctk_d nil) (setq ctk_d 13))
   
10.   (princ (strcat "\n请设定长条孔直径 <" (rtos ctk_d 2 3) ">: "))
    
11.   (setq a (getdist))
    
12.   (if (= a nil) (setq a ctk_d))
    
13.   (setq ctk_d a)
    
14.   (setq r (/ ctk_d 2))
    
15. 
    
16.   (while (and
    
17.            (setq pt (getpoint "\n指定插入点："))
    
18.            (setq pta  (getpoint pt "\n指定另一点："))
    
19.           );and
    
20.     (setq ang  (angle pt pta)
    
21.        di  (distance pt pta)
    
22.        ptb  (polar pt ang r)
    
23.        pt1  (polar ptb (+ ang (/ pi 2)) r)
    
24.        pt2  (polar pt1 ang (- di (* r 2)))
    
25.        pt3  (polar ptb (+ ang (/ pi -2)) r)
    
26.        pt4  (polar pt3 ang (- di (* r 2)))
    
27.      );set
    
28.     (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")
    
29.     (command "redrawall")
    
30.     (princ "\n**继续输入**")
    
31.   );while
    
32.   (princ)
    
33. );defun
    
34. 
    
35. 
    
36. <img src="http://bbs.mjtd.com/forum.php?mod=attachment&aid=NzU4Nzh8ZTI5NWZjNDV8MTM2OTgwMjE5NXwzNTM2OTN8MTAxNjUz&noupdate=yes" border="0">

<img src="http://bbs.mjtd.com/forum.php?mod=attachment&aid=NzU4Nzh8ZTI5NWZjNDV8MTM2OTgwMjE5NXwzNTM2OTN8MTAxNjUz&noupdate=yes" border="0">;;;;画长条孔CTK <br /> ;;;;源码明经仲文玉，修改ucuc2003<br /> (defun c:CTK (/ w p1 p2 ang )<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 1023)<br />   (princ "画长条孔")<br /> <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 /> <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 />      );set<br />     (command "_.PLINE" "non" pt1 "non" pt2 "A" "non" pt4 "L" "non" pt3 "A" "CL")<br />     (command "redrawall")<br />     (princ "\n**继续输入**")<br />   );while<br />   (princ)<br /> );defun<br /> <br /> <br /> <img src="http://bbs.mjtd.com/forum.php?mod=attachment&aid=NzU4Nzh8ZTI5NWZjNDV8MTM2OTgwMjE5NXwzNTM2OTN8MTAxNjUz&noupdate=yes" border="0">

王航

ucuc2003 发表于 2013-5-25 10:37

能否加上中心线？

王航

王航 发表于 2013-5-27 16:44
能否加上中心线？

能否加上中心线，如图？