[编程申请]：绘制长圆孔的程序

duzeman · 发表于 2003-5-16 11:21:11

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

请按图中所示编程实现长圆孔的绘制过程

eachy · 发表于 2003-5-17 18:18:22

(defun c:test (/ pcen ra len p1 p2 p3 p4 p5 p6 pmid)
(xdrx_begin)
(xdrx_ucson)
(xdrx_sysvar_push "osmode")
(setq pcen (getpoint "\n中心点: ")
ra (getdist pcen "\n圆半径: ")
len (getdist pcen "\n长度: ")
)
(if (and pcen ra len )
(progn
(setq pmid (polar pcen (- (/ pi 2)) ra)
p1 (polar pmid pi (/ len 2))
p2 (polar p1 0. len)
p3 (polar pcen 0 (+ ra (/ len 2)))
p4 (polar p2 (/ pi 2) (* 2 ra))
p5 (polar p1 (/ pi 2) (* 2 ra))
p6 (polar pcen pi (+ ra (/ len 2)))
)
(if (> len (* 2 ra))
(progn
(command ".pline" pmid p2 "a" "s" p3 p4 "l" p5 "a" "s" p6 p1 "l"
"c")
(command ".rotate" (entlast) "" pcen pause)))
)
)
(xdrx_sysvar_pop)
(xdrx_ucsoff)
(xdrx_end)
(princ)
)

(defun c:test (/ pcen ra len p1 p2 p3 p4 p5 p6 pmid) 
  (xdrx_begin) 
  (xdrx_ucson) 
  (xdrx_sysvar_push "osmode") 
  (setq        pcen (getpoint "\n中心点: ") 
        ra   (getdist pcen "\n圆半径: ") 
        len  (getdist pcen "\n长  度: ") 
  ) 
  (if (and pcen ra len ) 
    (progn 
      (setq pmid (polar pcen (- (/ pi 2)) ra) 
            p1         (polar pmid pi (/ len 2)) 
            p2         (polar p1 0. len) 
            p3         (polar pcen 0 (+ ra (/ len 2))) 
            p4         (polar p2 (/ pi 2) (* 2 ra)) 
            p5         (polar p1 (/ pi 2) (* 2 ra)) 
            p6         (polar pcen pi (+ ra (/ len 2))) 
      ) 
      (if (> len (* 2 ra)) 
        (progn 
        (command ".pline"        pmid p2        "a" "s"        p3 p4 "l" p5 "a" "s" p6        p1 "l" 
               "c") 
        (command ".rotate" (entlast) "" pcen pause))) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_ucsoff) 
  (xdrx_end) 
  (princ) 
)

aeo · 发表于 2003-5-18 00:57:26

还要len>2*ra

eachy · 发表于 2003-5-18 08:42:02

最初由 aeo 发布
[B]还要len>2*ra [/B]

谢谢，已修改。

lsjjm · 发表于 2003-5-18 12:12:18

用的mirror的程序:

(defun c:test ()
(setq pc (getpoint "\nCenter Point:")
r (getdist pc "\nInput Raiuds:")
l (getdist pc "\nInput Length:"))
(if (<= l (* 2 r))
(prompt "the Length is too short!")
(progn
(setq p1 (polar pc (/ pi 2) r)
p2 (polar p1 pi (- (/ l 2.0) r))
p3 (polar p2 (* 1.5 pi)(* 2 r))
p4 (list (car p1)(cadr p3)))
(vl-cmdf "pline" p1 p2 "a" "r" r p3 "l" p4 "" "mirror" "l" "" p1 p4 "")
);p
);if
);defun

虽然是临时写的程序，还是将各变量作为局部变量好，另外用Command ，会受Osnap影响，第一个也没有考虑，需改进

lzws03 · 发表于 2005-4-25 16:06:30

建议：程序功能中能否加入在绘出长圆孔后再加画出孔心线来？

梦断江南 · 发表于 2005-4-27 00:54:03

排除了绘制时的一些干扰因素，选角度时候自动打开极轴捕捉

;;
;| frec = 画药丸形实体-----------lxx.2005.4
[url]http://www.xdcad.net/forum/showthread.php?s=&postid=1852356#post1852356[/url]
|;
(defun c:frec (/ os as cen rad l d pt1 pt2 pt3 pt4 )
(setq os (getvar "osmode")
as (getvar "autosnap"))
(while (and (setq cen (getpoint "\n中心:"))
(setq rad (getdist cen "\n圆半径:"))
(setq l (getdist cen "\n半长:"))
)
(if (>= l rad)
(progn
(setq d (- l rad)
pt1 (mapcar '- cen (list d rad 0))
pt2 (mapcar '- cen (list d (- rad) 0))
pt3 (mapcar '+ cen (list d rad 0))
pt4 (mapcar '+ cen (list d (- rad) 0))
)
(setvar "osmode" 0)
(if (= 0 (logand as 8))
(setvar "autosnap" (+ as 8))
)
(vl-cmdf ".pline" pt1 "a" "d" 180 pt2 "l" pt3 "a" pt4 "l" "cl")
(vl-cmdf ".rotate" "l" "" cen)
(while (/= 0 (getvar "cmdactive"))
(vl-cmdf pause)
)
(setvar "osmode" os)
(setvar "autosnap" as)
)
(princ "\n半长小于半径!无法创建,再来一次...:")
)
)
(princ)
)

;; 
;| frec = 画药丸形实体-----------lxx.2005.4 
[url]http://www.xdcad.net/forum/showthread.php?s=&postid=1852356#post1852356[/url] 
|; 
(defun c:frec (/ os as cen rad l d pt1 pt2 pt3 pt4 ) 
  (setq os (getvar "osmode") 
        as (getvar "autosnap")) 
  (while (and (setq cen (getpoint "\n中心:")) 
              (setq rad (getdist cen "\n圆半径:")) 
              (setq l   (getdist cen "\n半长:")) 
         ) 
    (if        (>= l rad) 
      (progn 
        (setq d   (- l rad) 
              pt1 (mapcar '- cen (list d rad 0)) 
              pt2 (mapcar '- cen (list d (- rad) 0)) 
              pt3 (mapcar '+ cen (list d rad 0)) 
              pt4 (mapcar '+ cen (list d (- rad) 0)) 
        ) 
        (setvar "osmode" 0) 
        (if (= 0 (logand as 8)) 
          (setvar "autosnap" (+ as 8)) 
        ) 
        (vl-cmdf ".pline" pt1 "a" "d" 180 pt2 "l" pt3 "a" pt4 "l" "cl") 
        (vl-cmdf ".rotate" "l" "" cen) 
        (while (/= 0 (getvar "cmdactive")) 
          (vl-cmdf pause) 
        ) 
        (setvar "osmode" os) 
        (setvar "autosnap" as) 
      ) 
      (princ "\n半长小于半径!无法创建,再来一次...:") 
    ) 
  ) 
  (princ) 
)

lh869 · 发表于 2005-4-27 15:21:27

我也有一个啊，现在共享，代码如下：
(defun c:888 (/ cen len ang pt1 pt2 pt3 pt4 pt5 pt6 temp1 temp2)
 (if (not #dia1)
 (setq temp1 0. #dia1 0.)
 (setq temp1 #dia1))
 (if (not #len)
 (setq temp2 0. #len 0.)
 (setq temp2 #len)
);end if
 (setq cen (getpoint "Select the hole center point"))
 (initget 6)
 (setq #dia1 (getreal (strcat "\nInput the hole diameter <" (rtos #dia1 2 2) ">:")))
 (if (not #dia1) (setq #dia1 temp1))
 (setq #len (getreal (strcat "\nInput the hole length <" (rtos #len 2 2) ">:")))
 (if (not #len) (setq #len temp2))
 (setq ang (getangle cen "Input the angle of axis <0>"))
 (if (not ang) (setq ang 0.0))
 (setq pt1 (polar cen (+ ang (/ pi 2.)) (* #dia1 0.5)))
 (setq pt2 (polar pt1 ang (- (* #dia1 0.5) (* #len 0.5))))
 (setq pt3 (polar pt2 (- ang (/ pi 2.)) (* #dia1 1.0)))
 (setq pt4 (polar pt3 (- ang (/ pi 1.)) (- (* #dia1 0.5) (* #len 0.5))))
 (setq pt5 (polar pt4 (- ang (/ pi 1.)) (- (* #dia1 0.5) (* #len 0.5))))
 (setq pt6 (polar pt5 (+ ang (/ pi 2.)) (* #dia1 1.0)))
 (command "line" "non" (polar cen ang (* #len 1.))
 "non" (polar cen ang (* #len -1.)) ""
 "change" "l" "" "P" "la" "axis" ""
 "line" "non" (polar cen (+ ang (/ pi 2.)) (* #dia1 1.))
 "non" (polar cen (+ ang (/ pi 2.)) (* #dia1 -1.)) ""
 "change" "l" "" "P" "la" "axis" ""
 "pline" "non" pt1 "w" "0" "" ""
 "pline" "non" pt1 "non" pt2 "arc" "non" pt3 "line" "non" pt4 "non" pt5 "arc" "non" pt6 "line" "close"
 "change" "l" "" "P" "la" "axis" ""
)
);;;end defun

xjxing · 发表于 2005-5-23 21:06:40

用了3楼的程序,出现错误
错误: no function definition: XDRX_BEGIN
XDRX_BEGIN哪里找?

账号		自动登录	找回密码
密码			立即注册

[编程申请]：绘制长圆孔的程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子