画斜坡 毫米单位图不支持圆弧

树櫴希德

1. (defun  mkxp ( pta jd /  )
   
2. (defun emkblk ( pt name / pt1 pt2 pt3 )
   
3.   (entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))
   
4. (setq pt1(polar pt (* 1.5 pi )  750 ))  (setq pt2 (polar pt 0  750 )) (setq pt3 (polar pt2 (* 1.5 pi )  1500 ))
   
5.   (entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 pt1)))
   
6. 
   
7.   (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt3)))
   
8.   (entmake '((0 . "ENDBLK")))
   
9.   
   
10.   ;(entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))
    
11. )
    
12. 
    
13. (emkblk '(0 0) "GCpzx")
    
14.   (entmake (list '(0 . "INSERT") (cons 2 "GCpzx") (cons 10 pta)  (cons 50 jd)  ))
    
15. )
    
16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
17. (defun vxs (e / i v lst ppp)
    
18.   (setq i 0)
    
19.   (while
    
20.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
    
21.      (setq lst (cons v lst))
    
22.   )
    
23.   (setq ppp (reverse lst) )
    
24. (append (list(vlax-curve-getpointatparam e 0)) ppp )
    
25.   
    
26.   )
    
27. ;;;;;;;;;;;;;;;;;;;;;
    
28. (defun c:hxp1000 ( /  p1 plst zbb juli jiaodu i )
    
29. (vl-load-com)
    
30. (setq plst (vxs(car(entsel "\n 请选择坡顶线："))) )
    
31. (setq p1 nil)
    
32. 
    
33. (setq zbb (mapcar'list plst (cdr plst)) )
    
34. 
    
35. 
    
36. (foreach x zbb
    
37.      (setq juli (distance (car x) (cadr x)))
    
38.      (setq jiaodu (angle (car x) (cadr x) ))
    
39.     (mkxp  (car x) jiaodu )
    
40. (setq i 0)
    
41.   (repeat   (fix ( / juli 1500) )
    
42.    (mkxp (polar (car x) jiaodu (* 1500 (1+ i) ))  jiaodu )
    
43. 
    
44. (setq i (1+ i))
    
45.     )
    
46.   
    
47.   )
    
48. (princ)
    
49. )

(defun  mkxp ( pta jd /  )<br /> (defun emkblk ( pt name / pt1 pt2 pt3 )<br />   (entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))<br /> (setq pt1(polar pt (* 1.5 pi )  750 ))  (setq pt2 (polar pt 0  750 )) (setq pt3 (polar pt2 (* 1.5 pi )  1500 ))<br />   (entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 pt1)))<br /> <br />   (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt3)))<br />   (entmake '((0 . "ENDBLK")))<br />   <br />   ;(entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))<br /> )<br /> <br /> (emkblk '(0 0) "GCpzx")<br />   (entmake (list '(0 . "INSERT") (cons 2 "GCpzx") (cons 10 pta)  (cons 50 jd)  ))<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun vxs (e / i v lst ppp)<br />   (setq i 0)<br />   (while<br />     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />      (setq lst (cons v lst))<br />   )<br />   (setq ppp (reverse lst) )<br /> (append (list(vlax-curve-getpointatparam e 0)) ppp )<br />   <br />   )<br /> ;;;;;;;;;;;;;;;;;;;;;<br /> (defun c:hxp1000 ( /  p1 plst zbb juli jiaodu i )<br /> (vl-load-com)<br /> (setq plst (vxs(car(entsel "\n 请选择坡顶线："))) )<br /> (setq p1 nil)<br /> <br /> (setq zbb (mapcar'list plst (cdr plst)) )<br /> <br /> <br /> (foreach x zbb<br />      (setq juli (distance (car x) (cadr x)))<br />      (setq jiaodu (angle (car x) (cadr x) ))<br />     (mkxp  (car x) jiaodu ) <br /> (setq i 0)<br />   (repeat   (fix ( / juli 1500) )<br />    (mkxp (polar (car x) jiaodu (* 1500 (1+ i) ))  jiaodu )<br /> <br /> (setq i (1+ i))<br />     )<br />   <br />   )<br /> (princ)<br /> )

www2002

收藏啦，感谢分享！

skg123

还有缺陷（附图），另外每个线段都是单独的个体，不方便删除；