求助：LISP实现图示图形

viking11

详附件，谢谢，QQ362349621

zhynt

2. 
   
3. (defun c:ty ()
   
4.   (setq ss (entsel "\n选择图形:"))
   
5.   (setq ent (entget (car ss)))
   
6. ;;;获取矩形顶点表
   
7.   (setq ptlist (vl-remove-if '(lambda (x) (/= 10 (car x))) ent))
   
8.   (setq ptlist (mapcar 'cdr ptlist))
   
9.   (setq ptlist
   
10.   (vl-sort ptlist
    
11.     (function
    
12.       (lambda (e1 e2)
    
13.         (< (car e1) (car e2))
    
14.       )
    
15.     )
    
16.   )
    
17.   )
    
18.   (setq xmin (car (car ptlist)))
    
19.   (setq ptlist
    
20.   (vl-sort ptlist
    
21.     (function
    
22.       (lambda (e1 e2)
    
23.         (< (cadr e1) (cadr e2))
    
24.       )
    
25.     )
    
26.   )
    
27.   )
    
28.   (setq ymin (cadr (car ptlist)))
    
29.   (setq ptlist
    
30.   (vl-sort ptlist
    
31.     (function
    
32.       (lambda (e1 e2)
    
33.         (> (car e1) (car e2))
    
34.       )
    
35.     )
    
36.   )
    
37.   )
    
38.   (setq xmax (car (car ptlist)))
    
39.   (setq ptlist
    
40.   (vl-sort ptlist
    
41.     (function
    
42.       (lambda (e1 e2)
    
43.         (> (cadr e1) (cadr e2))
    
44.       )
    
45.     )
    
46.   )
    
47.   )
    
48.   (setq ymax (cadr (car ptlist)))
    
49.   (setq pta (list xmin ymin)
    
50. ptb (list xmax ymax)
    
51.   )  
    
52.     (setq ptc (list xmin ymax)
    
53. ptd (list xmax ymin)
    
54.   )
    
55.   (setq h (getreal "\n高度:"))
    
56.   (setq pt1 (polar ptb (/ (* 34.0 pi) 180) (* 1.5 h))
    
57. pt2 (polar ptd (/ (* 34.0 pi) 180) (* 1.5 h))
    
58. pt3 (polar ptc (/ (* 146.0 pi) 180) (* 1.5 h))
    
59. pt4 (polar pta (/ (* 146.0 pi) 180) (* 1.5 h))
    
60. pt5 (polar ptc (/ pi 2) (* 1.5 h))
    
61. pt6 (polar ptb (/ pi 2) (* 1.5 h))
    
62.   )
    
63.   (command "pline" "non" pta ptd pt2 pt1  "A" "ce" ptb pt6 "L" pt5 "A" "ce" ptc pt3 "L" pt4 "C")
    
64. )
    

<br /> (defun c:ty ()<br />   (setq ss (entsel "\n选择图形:"))<br />   (setq ent (entget (car ss)))<br /> ;;;获取矩形顶点表<br />   (setq ptlist (vl-remove-if '(lambda (x) (/= 10 (car x))) ent))<br />   (setq ptlist (mapcar 'cdr ptlist))<br />   (setq ptlist<br />   (vl-sort ptlist<br />     (function<br />       (lambda (e1 e2)<br />         (< (car e1) (car e2))<br />       )<br />     )<br />   )<br />   )<br />   (setq xmin (car (car ptlist)))<br />   (setq ptlist<br />   (vl-sort ptlist<br />     (function<br />       (lambda (e1 e2)<br />         (< (cadr e1) (cadr e2))<br />       )<br />     )<br />   )<br />   )<br />   (setq ymin (cadr (car ptlist)))<br />   (setq ptlist<br />   (vl-sort ptlist<br />     (function<br />       (lambda (e1 e2)<br />         (> (car e1) (car e2))<br />       )<br />     )<br />   )<br />   )<br />   (setq xmax (car (car ptlist)))<br />   (setq ptlist<br />   (vl-sort ptlist<br />     (function<br />       (lambda (e1 e2)<br />         (> (cadr e1) (cadr e2))<br />       )<br />     )<br />   )<br />   )<br />   (setq ymax (cadr (car ptlist)))<br />   (setq pta (list xmin ymin)<br /> ptb (list xmax ymax)<br />   )  <br />     (setq ptc (list xmin ymax)<br /> ptd (list xmax ymin)<br />   )<br />   (setq h (getreal "\n高度:"))<br />   (setq pt1 (polar ptb (/ (* 34.0 pi) 180) (* 1.5 h))<br /> pt2 (polar ptd (/ (* 34.0 pi) 180) (* 1.5 h))<br /> pt3 (polar ptc (/ (* 146.0 pi) 180) (* 1.5 h))<br /> pt4 (polar pta (/ (* 146.0 pi) 180) (* 1.5 h))<br /> pt5 (polar ptc (/ pi 2) (* 1.5 h))<br /> pt6 (polar ptb (/ pi 2) (* 1.5 h))<br />   )<br />   (command "pline" "non" pta ptd pt2 pt1  "A" "ce" ptb pt6 "L" pt5 "A" "ce" ptc pt3 "L" pt4 "C")<br /> )<br />

viking11

谢谢ZHYNT，向雷锋同志学习

viking11

C:\1.jpg，zhynt兄，此处画出有错误，红色虚线为修正后

zhynt

回复 viking11 的帖子

看不到图???

viking11

file:///c:/1.jpg

zhynt

依然看不到图，有人看见吗？

daidong013

看不到！~~肯定没传上！~~

ljpnb

没注意少了两个自定义函数

viking11

回复 zhynt 的帖子

上传的图片可能只有我自己能看到，拉到附件里了，麻烦ZHYNT有时间给看看