新手报到，发个eachy帮忙完善的源码

上善若水001

以下源码为画矩形带面积和复制功能，十分感谢eachy的援助。。。。。。。。。。。

1. (defun c:tt (/ p1 p2 a b c d oldcmdecho oldos wh p3 wz ss)
   
2.   (if (and (setq p1 (getpoint "\nfirstpoint:"))
   
3.            (setq p2 (getcorner p1 "\nsecondpoint:"))
   
4.       )
   
5.     (progn
   
6.       (setq oldcmdecho (getvar "cmdecho")
   
7.             oldos      (getvar "osmode")
   
8.             ss               (ssadd)
   
9.       )
   
10.       (setvar "cmdecho" 0)
    
11.       (setvar "osmode" 0)
    
12.       (command "-.layer" "m" 1 "c" 8 "" "")
    
13.       (command ".rectang" p1 p2)
    
14.       (ssadd (entlast) ss)
    
15.            (setq wh (mapcar 'abs (mapcar '- p2 p1))
    
16.             p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2))
    
17.             wz (rtos (* (car wh) (cadr wh)) 2 0)
    
18.       )
    
19.       (command "-layer" "m" 2 "c" 1 "" "")
    
20.       (command "-text" "j" "mc" p3 50 0 wz)
    
21.       (ssadd (entlast) ss)
    
22.       (setvar "osmode" oldos)
    
23.       (setvar "cmdecho" oldcmdecho)
    
24.       (command ".copy" ss p3)
    
25.       (while (/= 0 (getvar "Cmdactive"))
    
26.         (command pause)
    
27.       )
    
28.     )
    
29.   )
    
30.   (princ)
    
31. )
    
32. 
    

(defun c:tt (/ p1 p2 a b c d oldcmdecho oldos wh p3 wz ss) <br />   (if (and (setq p1 (getpoint "\nfirstpoint:"))<br />            (setq p2 (getcorner p1 "\nsecondpoint:"))<br />       ) <br />     (progn<br />       (setq oldcmdecho (getvar "cmdecho")<br />             oldos      (getvar "osmode")<br />             ss               (ssadd) <br />       ) <br />       (setvar "cmdecho" 0) <br />       (setvar "osmode" 0) <br />       (command "-.layer" "m" 1 "c" 8 "" "") <br />       (command ".rectang" p1 p2)<br />       (ssadd (entlast) ss) <br />            (setq wh (mapcar 'abs (mapcar '- p2 p1)) <br />             p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)) <br />             wz (rtos (* (car wh) (cadr wh)) 2 0)<br />       )<br />       (command "-layer" "m" 2 "c" 1 "" "")<br />       (command "-text" "j" "mc" p3 50 0 wz)<br />       (ssadd (entlast) ss) <br />       (setvar "osmode" oldos) <br />       (setvar "cmdecho" oldcmdecho)<br />       (command ".copy" ss p3)<br />       (while (/= 0 (getvar "Cmdactive"))<br />         (command pause)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

newer

欢迎常来！

st788796

用 API 可以这样写

2. 
   
3. (defun c:tt (/ p1 p2 wh area box ss p txt mat0 p0 mat)
   
4.   (if (and (setq p1 (getpoint "\nFirst Corner: "))
   
5.              (setq p2 (getcorner p1 "\nSecond Corner: "))
   
6.       )
   
7.     (progn
   
8.       (xd::begin)
   
9.       (setq wh  (mapcar 'abs (mapcar '- p1 p2))
   
10.               area (rtos (* (car wh) (cadr wh)) 2 0)
    
11.               box  (xdrx_points_box p1 p2)
    
12.               p     (xdrx_line_midp p1 p2)
    
13.       )
    
14.       (xdrx_setmark)
    
15.       (xdrx_layer_make "1" 8)
    
16.       (apply 'xdrx_polyline_make (cons t box))
    
17.       (xdrx_layer_make "2" 1)
    
18.       (setq txt (xdrx_text_make p area 50. 0.))
    
19.       (xdrx_text_sethozmode txt 1) ;_水平居中
    
20.       (xdrx_text_setvermode txt 2) ;_垂直居中
    
21.       (xdrx_text_setalignmentpoint txt p) ;_还要修改对齐点
    
22.       ;;(setpropertyvalue txt "Justify" 10);_这个2011+函数不需要修改对齐点
    
23.       (setq ss   (xdrx_getss 9);_必须给房间号，否则后面会释放
    
24.               mat0 (xdrx_matrix_identity 3)
    
25.       )
    
26.       (while (setq p0 (getpoint p "\n下一点: "))
    
27.              (setq mat (xdrx_matrix_settranslation mat0 (mapcar '- p0 p)))
    
28.               (xdrx_entity_transformedcopy ss mat)
    
29.       )
    
30.       (xd::end)
    
31.     )
    
32.   )
    
33.   (princ)
    
34. )

<br /> (defun c:tt (/ p1 p2 wh area box ss p txt mat0 p0 mat)<br />   (if (and (setq p1 (getpoint "\nFirst Corner: "))<br />              (setq p2 (getcorner p1 "\nSecond Corner: "))<br />       )<br />     (progn<br />       (xd::begin)<br />       (setq wh  (mapcar 'abs (mapcar '- p1 p2))<br />               area (rtos (* (car wh) (cadr wh)) 2 0)<br />               box  (xdrx_points_box p1 p2)<br />               p     (xdrx_line_midp p1 p2)<br />       )<br />       (xdrx_setmark)<br />       (xdrx_layer_make "1" 8)<br />       (apply 'xdrx_polyline_make (cons t box))<br />       (xdrx_layer_make "2" 1)<br />       (setq txt (xdrx_text_make p area 50. 0.))<br />       (xdrx_text_sethozmode txt 1) ;_水平居中<br />       (xdrx_text_setvermode txt 2) ;_垂直居中<br />       (xdrx_text_setalignmentpoint txt p) ;_还要修改对齐点<br />       ;;(setpropertyvalue txt "Justify" 10);_这个2011+函数不需要修改对齐点<br />       (setq ss   (xdrx_getss 9);_必须给房间号，否则后面会释放<br />               mat0 (xdrx_matrix_identity 3)<br />       )<br />       (while (setq p0 (getpoint p "\n下一点: "))<br />              (setq mat (xdrx_matrix_settranslation mat0 (mapcar '- p0 p)))<br />               (xdrx_entity_transformedcopy ss mat)<br />       )<br />       (xd::end)<br />     )<br />   )<br />   (princ)<br /> )