新手发个 动态矩形平分线 望高手指教

weiqi

代码实在 丑陋。望见量，本代码貌似也没实际意义。
目标是 横线 竖线 交点 可以补块 才有意义。而且 矩形希望是可以歪的（取三点 ）。
运行命令qq 控制键q键w键 a键s键

1. 
   
2. (defun c:qq ( )
   
3. 
   
4.   (defun *error* ( m ) (redraw) (princ))
   
5.   (or *n (setq *n 3))
   
6.    (or *z (setq *z 3))
   
7.   (princ "\naaa ")
   
8.   (if (setq p1 (getpoint "\nQW控制横线平分 AS控制纵线平分 "))
   
9.     (progn
   
10.       (setq ms (princ "\n QW控制横线平分 AS控制纵线平分  "))
    
11.       (while
    
12.         (progn (setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr))
    
13.           (cond
    
14.             ( (= 5 g1)(redraw)
    
15.               (if *v
    
16. 
    
17. 
    
18. 
    
19.                   (setq l
    
20.                     (list
    
21.                       p1 (list (car p1) (+ v (cadr p1)) (caddr p1))
    
22.                       g2 (list (+ h (car p)) (cadr p) (caddr p))
    
23. 
    
24.                   )
    
25.                 )
    
26.                                
    
27.                                
    
28.                 (progn
    
29.                   (setq h (- (car g2) (car p1))
    
30.                         v (/ (- (cadr g2) (cadr p1)) (1+ *n))
    
31.                         p p1
    
32.                   )
    
33.                                    (setq pp p)    ;; 定义纵线 需要的元素 避开横线元素
    
34.                                    (setq vv (* v *n))
    
35.                                   (setq vv (+ v vv))
    
36.                                   (setq hh (/ h (+ 1 *z)))
    
37.                                   
    
38.                   (repeat *n  
    
39.                     (setq p (list (car p) (+ v (cadr p)) (caddr p)))
    
40.                                         (grdraw p (list (+ (car p) h) (cadr p) (caddr p)) 4)
    
41.                    )
    
42.                          (repeat *z  
    
43. 
    
44.                                   (setq pp (list (+ hh (car pp)) (cadr pp) (caddr pp)))
    
45.                     (grdraw pp (list (car pp) (+ vv (cadr pp)) (caddr pp)) -1)
    
46.                                   
    
47.                                   
    
48.                    )
    
49.                           
    
50.                   
    
51.                           
    
52.                           
    
53.                           
    
54.                           
    
55.                           
    
56.                   (setq l
    
57.                     (list
    
58.                       p1 (list (+ (car p1) h) (cadr p1) (caddr p1))
    
59.                       g2 (list (car p) (+ v (cadr p)) (caddr p))
    
60.                     )
    
61.                   )
    
62.                 )
    
63.               )   
    
64.                                          
    
65.               (mapcar '(lambda ( a b ) (grdraw a b 1 -1)) l (append (cdr l) (list (car l))));画个框
    
66.                           
    
67.             )
    
68.             ( (= 2 g1);;键盘条件
    
69.               (cond
    
70.                 ( (member g2 '(119 87))
    
71.                        
    
72.                   (if (= 1 *n)
    
73.                     (princ (strcat "\n--> 横线须大于0." ms))
    
74.                     (setq *n (1- *n))
    
75.                   )
    
76.                 )
    
77.                 ( (member g2 '(113 81))
    
78.                        
    
79.                   (setq *n (1+ *n))
    
80.                 )
    
81.                                
    
82.                                  ( (member g2 '(65 97))
    
83.                
    
84.                   (setq *z (1+ *z))
    
85.                 )
    
86.                                
    
87.                                         ( (member g2 '(83 115))
    
88.                        
    
89.                   (if (= 1 *z)
    
90.                     (princ (strcat "\n--> 纵须线大于0." ms))
    
91.                     (setq *z (1- *z))
    
92.                   )
    
93. 
    
94.                                          
    
95.                                          
    
96.                                          
    
97.                                          
    
98.                                          
    
99.                 )
    
100.                                
     
101. 
     
102.               )
     
103.             )
     
104. 
     
105.           )
     
106.         )
     
107.       )
     
108.     )
     
109.   )
     
110.   (redraw) (princ)
     
111. )
     
112. 
     
113. 
     

<br /> (defun c:qq ( )<br /> <br />   (defun *error* ( m ) (redraw) (princ))<br />   (or *n (setq *n 3))<br />    (or *z (setq *z 3))<br />   (princ "\naaa ")<br />   (if (setq p1 (getpoint "\nQW控制横线平分 AS控制纵线平分 "))<br />     (progn<br />       (setq ms (princ "\n QW控制横线平分 AS控制纵线平分  "))<br />       (while<br />         (progn (setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr))<br />           (cond<br />             ( (= 5 g1)(redraw)<br />               (if *v<br /> <br /> <br /> <br />                   (setq l<br />                     (list<br />                       p1 (list (car p1) (+ v (cadr p1)) (caddr p1))<br />                       g2 (list (+ h (car p)) (cadr p) (caddr p))<br /> <br />                   )<br />                 )<br />                                 <br />                                 <br />                 (progn<br />                   (setq h (- (car g2) (car p1))<br />                         v (/ (- (cadr g2) (cadr p1)) (1+ *n))<br />                         p p1<br />                   )<br />                                    (setq pp p)    ;; 定义纵线 需要的元素 避开横线元素<br />                                    (setq vv (* v *n))<br />                                   (setq vv (+ v vv))<br />                                   (setq hh (/ h (+ 1 *z)))<br />                                   <br />                   (repeat *n  <br />                     (setq p (list (car p) (+ v (cadr p)) (caddr p)))<br />                                         (grdraw p (list (+ (car p) h) (cadr p) (caddr p)) 4)<br />                    )<br />                          (repeat *z  <br /> <br />                                   (setq pp (list (+ hh (car pp)) (cadr pp) (caddr pp)))<br />                     (grdraw pp (list (car pp) (+ vv (cadr pp)) (caddr pp)) -1)<br />                                   <br />                                   <br />                    )<br />                            <br />                    <br />                            <br />                           <br />                            <br />                            <br />                            <br />                   (setq l<br />                     (list<br />                       p1 (list (+ (car p1) h) (cadr p1) (caddr p1))<br />                       g2 (list (car p) (+ v (cadr p)) (caddr p))<br />                     )<br />                   )<br />                 )<br />               )   <br />                                          <br />               (mapcar '(lambda ( a b ) (grdraw a b 1 -1)) l (append (cdr l) (list (car l))));画个框<br />                            <br />             )<br />             ( (= 2 g1);;键盘条件<br />               (cond<br />                 ( (member g2 '(119 87))<br />                         <br />                   (if (= 1 *n)<br />                     (princ (strcat "\n--> 横线须大于0." ms))<br />                     (setq *n (1- *n))<br />                   )<br />                 )<br />                 ( (member g2 '(113 81))<br />                         <br />                   (setq *n (1+ *n))<br />                 )<br />                                 <br />                                  ( (member g2 '(65 97))<br />                 <br />                   (setq *z (1+ *z))<br />                 )<br />                                 <br />                                         ( (member g2 '(83 115))<br />                         <br />                   (if (= 1 *z)<br />                     (princ (strcat "\n--> 纵须线大于0." ms))<br />                     (setq *z (1- *z))<br />                   )<br /> <br />                                          <br />                                          <br />                                          <br />                                          <br />                                          <br />                 )<br />                                 <br /> <br />               )<br />             )<br /> <br />           )<br />         )<br />       )<br />     )<br />   )<br />   (redraw) (princ)<br /> )<br /> <br /> <br />

smartstar

谢谢分钟。

flytoday

转发个lee-mac大师精品

weiqi

刚学的 写的直线 布块。。。
不过还是没啥用，块 会随 图层 变属性。
还不如 以前 我要用的 先组成一个块 然后用ME 之后炸碎来得方便。（论坛已经有 其他更好代替的程序啦）这个只是学习之用，望高手指点指点，感谢yanshengjiang 提供的帮助

1. (defun c:qq()
   
2. (setq k (Cdr(assoc 2(entget (Car(entsel))))))
   
3. (setq a (getpoint "\n 起点"))
   
4. (setq b (getpoint "\n 终点"))
   
5. 
   
6. (setq l (command "line" a b ""))
   
7. (setq c (entlast))
   
8. (command "measure" c "b" k "y" )
   
9. 
   
10. )
    
11. 
    
12. 
    
13. 
    

(defun c:qq()<br /> (setq k (Cdr(assoc 2(entget (Car(entsel)))))) <br /> (setq a (getpoint "\n 起点"))<br /> (setq b (getpoint "\n 终点"))<br /> <br /> (setq l (command "line" a b ""))<br /> (setq c (entlast))<br /> (command "measure" c "b" k "y" )<br /> <br /> )<br /> <br /> <br /> <br />

davide888

好人            

xyp1964

434939575

xyp1964 发表于 2012-12-5 19:33

战斗机。

xieyanghui

很好的功能，但是不能捕捉第二点，画出来没东西！！希望能完善