【求助】请大侠门来编一个这样的程序！

ljpnb

daidong013 发表于 2011-6-25 13:59
回复 ZZXXQQ 的帖子

非常感谢大侠！~~画完后感觉还是6楼的好用些，因为四面的线都是段开的！~~

ZZXXQQ版编得多么简捷，你还觉得不好用，6#的简单型有改过了，你试试，升级版也出来过，不过不完美，改好再说。。。

zhynt

再来个组合版的：(简版去掉了四边框线)
将;(progn
    ;  (command "_.rectang" nk_pt1 nk_pt3)
      (setvar "clayer" "nk_line")
    ;)
的"号去掉为有框线

2. 
   
3. (defun err (s)
   
4.   (if (and
   
5.         (/= s "console break")
   
6.         (/= s "Function cancelled")
   
7.         (/= s "quit/exit abort")
   
8.       )
   
9.     (progn
   
10.       (setvar "LUPREC" oldlup)
    
11.       (setvar "LUNITS" oldlun)
    
12.       (setvar "osmode" oldos)
    
13.       (setvar "cmdecho" oldcmd)
    
14.       (setvar "clayer" oldlay)
    
15.       (setq *error* olderr)
    
16.       (princ (strcat "\n程序出错或用户退出:" s))
    
17.     )
    
18.   )
    
19. )
    
20. (defun c:ldf (/                wk_pt1          wk_pt2    wk_pt3    wk_pt4
    
21.               nk_pt1        nk_pt2          nk_pt3    nk_pt4    olds
    
22.               oldcmd        oldlup          oldlay    nk_n      nk_kd
    
23.               ptax        ptay          ptaz            ptbx      ptby
    
24.               ptbz        l_pt1_pt4 l_pt2_pt3 l_n              ang_pt1_pt4
    
25.              )
    
26.   (setq oldos (getvar "osmode"))
    
27.   (if (< oldos 16384)
    
28.     (setvar "osmode" (+ oldos 16384))
    
29.   )
    
30.   (setq        oldcmd        (getvar "cmdecho")
    
31.         oldlun        (getvar "LUNITS")
    
32.         oldlup        (getvar "LUPREC")
    
33.         olderr        *error*
    
34.         *error*        err
    
35.         oldlay        (getvar "clayer")
    
36.   )
    
37.   (setvar "cmdecho" 0)
    
38.   (setvar "LUPREC" 8)
    
39.   (setvar "LUNITS" 2)
    
40.   (if (= (TBLOBJNAME "LAYER" "wk_line") nil)
    
41.     (command "layer" "m" "wk_line" "c" "2" "" "")
    
42.   )
    
43.   (if (= (TBLOBJNAME "LAYER" "nk_line") nil)
    
44.     (command "layer" "m" "nk_line" "c" "1" "" "")
    
45.   )
    
46.   (setvar "clayer" "wk_line")
    
47.   (setq        wk_pt1 (getpoint "\n指定第一角点")
    
48.         wk_pt3 (getcorner wk_pt1 "\n指定第二角点:")
    
49.         nk_n   (getint "\n请输入大于零的等分数:")
    
50.         wk_kd  (getreal "\n输入边框宽度:输入0为简版<20mm>:")
    
51.   )
    
52.   (if (= wk_kd nil)
    
53.     (setq wk_kd 20.0)
    
54.   )
    
55.   (setq        ptax (car wk_pt1)
    
56.         ptay (cadr wk_pt1)
    
57.         ptbx (car wk_pt3)
    
58.         ptby (cadr wk_pt3)
    
59.   )
    
60.   (setq        wk_pt2 (list ptax ptby)
    
61.         wk_pt4 (list ptbx ptay)
    
62.   )
    
63.   (if (/= wk_kd 0)
    
64.     (progn
    
65.       (setq nk_pt1
    
66.              (polar wk_pt1
    
67.                     (/ (- (angle wk_pt1 wk_pt2) (angle wk_pt1 wk_pt4)) 2.0)
    
68.                     (* wk_kd (* 2 (sqrt 2)))
    
69.              )
    
70.       )
    
71.       (setq nk_pt3
    
72.              (polar wk_pt3
    
73.                     (+ (/ (- (angle wk_pt3 wk_pt2) (angle wk_pt3 wk_pt4)) 2.0)
    
74.                        (/ (* pi 3.0) 2.0)
    
75.                     )
    
76.                     (* wk_kd (* 2 (sqrt 2)))
    
77.              )
    
78.       )
    
79.       (setq ptax (car nk_pt1)
    
80.             ptay (cadr nk_pt1)
    
81.             ptbx (car nk_pt3)
    
82.             ptby (cadr nk_pt3)
    
83.       )
    
84.       (setq nk_pt2 (list ptax ptby)
    
85.             nk_pt4 (list ptbx ptay)
    
86.       )
    
87.     )
    
88.     (setq nk_pt1 wk_pt1
    
89.           nk_pt2 wk_pt2
    
90.           nk_pt3 wk_pt3
    
91.           nk_pt4 wk_pt4
    
92.     )
    
93.   )
    
94.   (setq        l_pt1_pt4   (distance nk_pt1 nk_pt4)
    
95.         l_pt1_pt2   (distance nk_pt1 nk_pt2)
    
96.         ang_pt1_pt4 (angle nk_pt1 nk_pt4)
    
97.         l_n            (/ l_pt1_pt4 nk_n)
    
98.   )
    
99.   (if (/= wk_kd 0)
    
100.     (progn
     
101.       (command "_.rectang" wk_pt1 wk_pt3)
     
102.       (setvar "clayer" "nk_line")
     
103.       (command "_.rectang" nk_pt1 nk_pt3)
     
104.     )
     
105.    ; (progn
     
106.    ;   (command "_.rectang" nk_pt1 nk_pt3)
     
107.       (setvar "clayer" "nk_line")
     
108.    ; )
     
109.   )     
     
110.   (setq        n_pt1 nk_pt1
     
111.         n_pt2 nk_pt2
     
112.   )
     
113.   (repeat (- nk_n 1)
     
114.     (setq n_pt3        (polar n_pt1 ang_pt1_pt4 l_n)
     
115.           n_pt4        (polar n_pt3 (+ ang_pt1_pt4 (/ pi 2.0)) l_pt1_pt2)
     
116.     )
     
117.     (command "_.line" n_pt1 n_pt4 n_pt3 n_pt2 "")
     
118.     (setq n_pt1        n_pt3
     
119.           n_pt2        n_pt4
     
120.     )
     
121.   )
     
122.   (command "_.line" n_pt1 nk_pt3 "")
     
123.   (command "_.line" nk_pt4 n_pt2 "")
     
124.   (setvar "osmode" oldos)
     
125.   (setvar "cmdecho" oldcmd)
     
126.   (setvar "clayer" oldlay)
     
127.   (setvar "LUPREC" oldlup)
     
128.   (setvar "LUNITS" oldlun)
     
129.   (princ)
     
130. )
     

<br /> (defun err (s)<br />   (if (and<br />         (/= s "console break")<br />         (/= s "Function cancelled")<br />         (/= s "quit/exit abort")<br />       )<br />     (progn<br />       (setvar "LUPREC" oldlup)<br />       (setvar "LUNITS" oldlun)<br />       (setvar "osmode" oldos)<br />       (setvar "cmdecho" oldcmd)<br />       (setvar "clayer" oldlay)<br />       (setq *error* olderr)<br />       (princ (strcat "\n程序出错或用户退出:" s))<br />     )<br />   )<br /> )<br /> (defun c:ldf (/                wk_pt1          wk_pt2    wk_pt3    wk_pt4<br />               nk_pt1        nk_pt2          nk_pt3    nk_pt4    olds<br />               oldcmd        oldlup          oldlay    nk_n      nk_kd<br />               ptax        ptay          ptaz            ptbx      ptby<br />               ptbz        l_pt1_pt4 l_pt2_pt3 l_n              ang_pt1_pt4<br />              )<br />   (setq oldos (getvar "osmode"))<br />   (if (< oldos 16384)<br />     (setvar "osmode" (+ oldos 16384))<br />   )<br />   (setq        oldcmd        (getvar "cmdecho")<br />         oldlun        (getvar "LUNITS")<br />         oldlup        (getvar "LUPREC")<br />         olderr        *error*<br />         *error*        err<br />         oldlay        (getvar "clayer")<br />   )<br />   (setvar "cmdecho" 0)<br />   (setvar "LUPREC" 8)<br />   (setvar "LUNITS" 2)<br />   (if (= (TBLOBJNAME "LAYER" "wk_line") nil)<br />     (command "layer" "m" "wk_line" "c" "2" "" "")<br />   )<br />   (if (= (TBLOBJNAME "LAYER" "nk_line") nil)<br />     (command "layer" "m" "nk_line" "c" "1" "" "")<br />   )<br />   (setvar "clayer" "wk_line")<br />   (setq        wk_pt1 (getpoint "\n指定第一角点")<br />         wk_pt3 (getcorner wk_pt1 "\n指定第二角点:")<br />         nk_n   (getint "\n请输入大于零的等分数:")<br />         wk_kd  (getreal "\n输入边框宽度:输入0为简版<20mm>:")<br />   )<br />   (if (= wk_kd nil)<br />     (setq wk_kd 20.0)<br />   )<br />   (setq        ptax (car wk_pt1)<br />         ptay (cadr wk_pt1)<br />         ptbx (car wk_pt3)<br />         ptby (cadr wk_pt3)<br />   )<br />   (setq        wk_pt2 (list ptax ptby)<br />         wk_pt4 (list ptbx ptay)<br />   )<br />   (if (/= wk_kd 0)<br />     (progn<br />       (setq nk_pt1<br />              (polar wk_pt1<br />                     (/ (- (angle wk_pt1 wk_pt2) (angle wk_pt1 wk_pt4)) 2.0)<br />                     (* wk_kd (* 2 (sqrt 2)))<br />              )<br />       )<br />       (setq nk_pt3<br />              (polar wk_pt3<br />                     (+ (/ (- (angle wk_pt3 wk_pt2) (angle wk_pt3 wk_pt4)) 2.0)<br />                        (/ (* pi 3.0) 2.0)<br />                     )<br />                     (* wk_kd (* 2 (sqrt 2)))<br />              )<br />       )<br />       (setq ptax (car nk_pt1)<br />             ptay (cadr nk_pt1)<br />             ptbx (car nk_pt3)<br />             ptby (cadr nk_pt3)<br />       )<br />       (setq nk_pt2 (list ptax ptby)<br />             nk_pt4 (list ptbx ptay)<br />       )<br />     )<br />     (setq nk_pt1 wk_pt1<br />           nk_pt2 wk_pt2<br />           nk_pt3 wk_pt3<br />           nk_pt4 wk_pt4<br />     )<br />   )<br />   (setq        l_pt1_pt4   (distance nk_pt1 nk_pt4)<br />         l_pt1_pt2   (distance nk_pt1 nk_pt2)<br />         ang_pt1_pt4 (angle nk_pt1 nk_pt4)<br />         l_n            (/ l_pt1_pt4 nk_n)<br />   )<br />   (if (/= wk_kd 0)<br />     (progn<br />       (command "_.rectang" wk_pt1 wk_pt3)<br />       (setvar "clayer" "nk_line")<br />       (command "_.rectang" nk_pt1 nk_pt3)<br />     )<br />    ; (progn<br />    ;   (command "_.rectang" nk_pt1 nk_pt3)<br />       (setvar "clayer" "nk_line")<br />    ; )<br />   )     <br />   (setq        n_pt1 nk_pt1<br />         n_pt2 nk_pt2<br />   )<br />   (repeat (- nk_n 1)<br />     (setq n_pt3        (polar n_pt1 ang_pt1_pt4 l_n)<br />           n_pt4        (polar n_pt3 (+ ang_pt1_pt4 (/ pi 2.0)) l_pt1_pt2)<br />     )<br />     (command "_.line" n_pt1 n_pt4 n_pt3 n_pt2 "")<br />     (setq n_pt1        n_pt3<br />           n_pt2        n_pt4<br />     )<br />   )<br />   (command "_.line" n_pt1 nk_pt3 "")<br />   (command "_.line" nk_pt4 n_pt2 "")<br />   (setvar "osmode" oldos)<br />   (setvar "cmdecho" oldcmd)<br />   (setvar "clayer" oldlay)<br />   (setvar "LUPREC" oldlup)<br />   (setvar "LUNITS" oldlun)<br />   (princ)<br /> )<br />

ljpnb

2. ;;;拉框N等分加边距 在ZZXXQQ基础上扩展的
   
3. (defun c:tt ()
   
4.   (setvar "CMDECHO" 0)
   
5.   (command "undo" "g")
   
6.   (setq oldos (getvar "OSMODE"))
   
7.   (if (and  (setq p1 (getpoint "\n第一角点 :"))
   
8.            (setq p2 (getcorner p1 "\n另一角点 :"))
   
9.            (setq n (getint "\n等分数 :"))
   
10.            (or (setq d (getreal "\n输入边框宽度:<20mm>:"))
    
11.                (setq d 20.)
    
12.            )
    
13.       )
    
14.    
    
15.     (progn
    
16.       (setvar "OSMODE" 0)
    
17.       (setq dx1        (abs (- (car p2) (car p1)))
    
18.             dy1        (abs (- (cadr p2) (cadr p1)))
    
19.       )
    
20.       (setq ptm        (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2)))
    
21.             p2        (list (max (car p1) (car p2)) (max (cadr p1) (cadr p2)))
    
22.             p01        ptm
    
23.       )
    
24.       (setq p1        (list (+ (car p01) d) (+ (cadr p01) d))
    
25.             p00        p1
    
26.       )
    
27.       ;;内基准点
    
28.       (setq dx (- dx1 (* d 2))
    
29.             dy (- dy1 (* d 2))
    
30.       )
    
31.       (if (> dx dy)
    
32.         (progn
    
33.           (setq dd (/ dx n))
    
34.           (repeat n
    
35.             (setq p3 (polar p1 0 dd)
    
36.                   p4 (polar p1 (/ pi 2) dy)
    
37.                   p5 (polar p4 0 dd)
    
38.             )
    
39.             (command "_.LINE" p1 p5 p3 "")
    
40.             (setq ent (entlast))
    
41.             (command "_.LINE" p3 p4 "")
    
42.             (setq p1 p3)
    
43.           )
    
44.         )
    
45.         (progn
    
46.           (setq dd (/ dy n))
    
47.           (repeat n
    
48.             (setq p3 (polar p1 (/ pi 2) dd)
    
49.                   p4 (polar p1 0 dx)
    
50.                   p5 (polar p3 0 dx)
    
51.             )
    
52.             (command "_.LINE" p1 p5 p3 "")
    
53.             (setq ent (entlast))
    
54.             (command "_.LINE" p3 p4 "")
    
55.             (setq p1 p3)
    
56.           )
    
57.         )
    
58.       )
    
59.       (entdel ent)
    
60.       (command "RECTANG" p00 p5)
    
61.       (setvar "OSMODE" oldos)
    
62.     )
    
63.   )
    
64.   (command "undo" "e")
    
65.   (setvar "CMDECHO" 1)
    
66.   (princ)
    
67. )
    

;;;拉框N等分加边距 在ZZXXQQ基础上扩展的<br /> (defun c:tt ()<br />   (setvar "CMDECHO" 0)<br />   (command "undo" "g")<br />   (setq oldos (getvar "OSMODE"))<br />   (if (and  (setq p1 (getpoint "\n第一角点 :"))<br />            (setq p2 (getcorner p1 "\n另一角点 :"))<br />            (setq n (getint "\n等分数 :"))<br />            (or (setq d (getreal "\n输入边框宽度:<20mm>:"))<br />                (setq d 20.)<br />            )<br />       )<br />     <br />     (progn<br />       (setvar "OSMODE" 0)<br />       (setq dx1        (abs (- (car p2) (car p1)))<br />             dy1        (abs (- (cadr p2) (cadr p1)))<br />       )<br />       (setq ptm        (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2)))<br />             p2        (list (max (car p1) (car p2)) (max (cadr p1) (cadr p2)))<br />             p01        ptm<br />       )<br />       (setq p1        (list (+ (car p01) d) (+ (cadr p01) d))<br />             p00        p1<br />       )<br />       ;;内基准点<br />       (setq dx (- dx1 (* d 2))<br />             dy (- dy1 (* d 2))<br />       )<br />       (if (> dx dy)<br />         (progn<br />           (setq dd (/ dx n))<br />           (repeat n<br />             (setq p3 (polar p1 0 dd)<br />                   p4 (polar p1 (/ pi 2) dy)<br />                   p5 (polar p4 0 dd)<br />             )<br />             (command "_.LINE" p1 p5 p3 "")<br />             (setq ent (entlast))<br />             (command "_.LINE" p3 p4 "")<br />             (setq p1 p3)<br />           )<br />         )<br />         (progn<br />           (setq dd (/ dy n))<br />           (repeat n<br />             (setq p3 (polar p1 (/ pi 2) dd)<br />                   p4 (polar p1 0 dx)<br />                   p5 (polar p3 0 dx)<br />             )<br />             (command "_.LINE" p1 p5 p3 "")<br />             (setq ent (entlast))<br />             (command "_.LINE" p3 p4 "")<br />             (setq p1 p3)<br />           )<br />         )<br />       )<br />       (entdel ent)<br />       (command "RECTANG" p00 p5)<br />       (setvar "OSMODE" oldos)<br />     )<br />   )<br />   (command "undo" "e")<br />   (setvar "CMDECHO" 1)<br />   (princ)<br /> )<br />

daidong013

回复 zhynt 的帖子

大侠！不错不错，不过怎么没有捕捉呢！！~~

daidong013

回复 ljpnb 的帖子

真厉害！~~这就是我想要的效果！~~~！~~
不过最外面的外框矩形可以选择有或者没有要怎么改一下！~~
【zhynt】大侠的组合版有最外面的矩形外框！~~

ljpnb

如果加外框，可以在(command "RECTANG" p00 p5)
之后再加一句(command "RECTANG" ptm p2)

daidong013

回复 ljpnb 的帖子

万分感谢！~~终于完美了！~~~

zhynt

将关闭捕捉的位置调整了一下：

2. 
   
3. (defun err (s)
   
4.   (if (and
   
5.         (/= s "console break")
   
6.         (/= s "Function cancelled")
   
7.         (/= s "quit/exit abort")
   
8.       )
   
9.     (progn
   
10.       (setvar "LUPREC" oldlup)
    
11.       (setvar "LUNITS" oldlun)
    
12.       (setvar "osmode" oldos)
    
13.       (setvar "cmdecho" oldcmd)
    
14.       (setvar "clayer" oldlay)
    
15.       (setq *error* olderr)
    
16.       (princ (strcat "\n程序出错或用户退出:" s))
    
17.     )
    
18.   )
    
19. )
    
20. (defun c:ldf (/                nk_pt1          nk_pt2    nk_pt3    nk_pt4
    
21.               olds        oldcmd          oldlup    oldlay    nk_n
    
22.               nk_kd        ptax          ptay            ptaz      ptbx
    
23.               ptby        ptbz          l_pt1_pt4 l_pt2_pt3 l_n
    
24.               ang_pt1_pt4
    
25.              )
    
26.   (setq oldos (getvar "osmode"))  
    
27.   (setq        oldcmd        (getvar "cmdecho")
    
28.         oldlun        (getvar "LUNITS")
    
29.         oldlup        (getvar "LUPREC")
    
30.         olderr        *error*
    
31.         *error*        err
    
32.         oldlay        (getvar "clayer")
    
33.   )
    
34.   (setvar "cmdecho" 0)
    
35.   (setvar "LUPREC" 8)
    
36.   (setvar "LUNITS" 2)
    
37.   (if (= (TBLOBJNAME "LAYER" "wk_line") nil)
    
38.     (command "layer" "m" "wk_line" "c" "2" "" "")
    
39.   )
    
40.   (if (= (TBLOBJNAME "LAYER" "nk_line") nil)
    
41.     (command "layer" "m" "nk_line" "c" "1" "" "")
    
42.   )
    
43.   (setvar "clayer" "wk_line")
    
44.   (setq        wk_pt1 (getpoint "\n指定第一角点")
    
45.         wk_pt3 (getcorner wk_pt1 "\n指定第二角点:")
    
46.         nk_n   (getint "\n请输入大于零的等分数:")
    
47.         wk_kd  (getreal "\n输入边框宽度:输入0为简版<20mm>:")
    
48.   )
    
49.   (if (= wk_kd nil)
    
50.     (setq wk_kd 20.0)
    
51.   )
    
52.   (setq        wk_ptn (list (min (car wk_pt1) (car wk_pt3))
    
53.                      (min (cadr wk_pt1) (cadr wk_pt3))
    
54.                )
    
55.         wk_pt3 (list (max (car wk_pt1) (car wk_pt3))
    
56.                      (max (cadr wk_pt1) (cadr wk_pt3))
    
57.                )
    
58.         wk_pt1 wk_ptn
    
59.   )
    
60.   (setq        ptax (car wk_pt1)
    
61.         ptay (cadr wk_pt1)
    
62.         ptbx (car wk_pt3)
    
63.         ptby (cadr wk_pt3)
    
64.   )
    
65.   (setq        wk_pt2 (list ptax ptby)
    
66.         wk_pt4 (list ptbx ptay)
    
67.   )
    
68.   (if (/= wk_kd 0)
    
69.     (progn
    
70.       (setq nk_pt1
    
71.              (polar wk_pt1
    
72.                     (/ pi 4)
    
73.                     (* wk_kd (* 2 (sqrt 2)))
    
74.              )
    
75.       )
    
76.       (setq nk_pt3
    
77.              (polar wk_pt3
    
78.                     (/ (* pi 5) 4)
    
79.                     (* wk_kd (* 2 (sqrt 2)))
    
80.              )
    
81.       )
    
82.       (setq ptax (car nk_pt1)
    
83.             ptay (cadr nk_pt1)
    
84.             ptbx (car nk_pt3)
    
85.             ptby (cadr nk_pt3)
    
86.       )
    
87.       (setq nk_pt2 (list ptax ptby)
    
88.             nk_pt4 (list ptbx ptay)
    
89.       )
    
90.     )
    
91.     (setq nk_pt1 wk_pt1
    
92.           nk_pt2 wk_pt2
    
93.           nk_pt3 wk_pt3
    
94.           nk_pt4 wk_pt4
    
95.     )
    
96.   )
    
97.   (setq        l_pt1_pt4   (distance nk_pt1 nk_pt4)
    
98.         l_pt1_pt2   (distance nk_pt1 nk_pt2)       
    
99.         ang_pt1_pt4 (angle nk_pt1 nk_pt4)
    
100.         l_n            (/ l_pt1_pt4 nk_n)
     
101.   )
     
102.   (if (< oldos 16384)
     
103.     (setvar "osmode" (+ oldos 16384))
     
104.   )
     
105.   (if (/= wk_kd 0)
     
106.     (progn
     
107.       (command "_.rectang" wk_pt1 wk_pt3)
     
108.       (setvar "clayer" "nk_line")
     
109.       (command "_.rectang" nk_pt1 nk_pt3)
     
110.     )
     
111.     (progn (command "_.rectang" nk_pt1 nk_pt3)
     
112.            (setvar "clayer" "nk_line")
     
113.     )
     
114.   )
     
115.   (setq        n_pt1 nk_pt1
     
116.         n_pt2 nk_pt2
     
117.   )
     
118.   (repeat (- nk_n 1)
     
119.     (setq n_pt3        (polar n_pt1 ang_pt1_pt4 l_n)
     
120.           n_pt4        (polar n_pt3 (+ ang_pt1_pt4 (/ pi 2.0)) l_pt1_pt2)
     
121.     )
     
122.     (command "_.line" n_pt1 n_pt4 n_pt3 n_pt2 "")
     
123.     (setq n_pt1        n_pt3
     
124.           n_pt2        n_pt4
     
125.     )
     
126.   )
     
127.   (command "_.line" n_pt1 nk_pt3 "")
     
128.   (command "_.line" nk_pt4 n_pt2 "")
     
129.   (setvar "osmode" oldos)
     
130.   (setvar "cmdecho" oldcmd)
     
131.   (setvar "clayer" oldlay)
     
132.   (setvar "LUPREC" oldlup)
     
133.   (setvar "LUNITS" oldlun)
     
134.   (princ)
     
135. )
     

<br /> (defun err (s)<br />   (if (and<br />         (/= s "console break")<br />         (/= s "Function cancelled")<br />         (/= s "quit/exit abort")<br />       )<br />     (progn<br />       (setvar "LUPREC" oldlup)<br />       (setvar "LUNITS" oldlun)<br />       (setvar "osmode" oldos)<br />       (setvar "cmdecho" oldcmd)<br />       (setvar "clayer" oldlay)<br />       (setq *error* olderr)<br />       (princ (strcat "\n程序出错或用户退出:" s))<br />     )<br />   )<br /> )<br /> (defun c:ldf (/                nk_pt1          nk_pt2    nk_pt3    nk_pt4<br />               olds        oldcmd          oldlup    oldlay    nk_n<br />               nk_kd        ptax          ptay            ptaz      ptbx<br />               ptby        ptbz          l_pt1_pt4 l_pt2_pt3 l_n<br />               ang_pt1_pt4<br />              )<br />   (setq oldos (getvar "osmode"))  <br />   (setq        oldcmd        (getvar "cmdecho")<br />         oldlun        (getvar "LUNITS")<br />         oldlup        (getvar "LUPREC")<br />         olderr        *error*<br />         *error*        err<br />         oldlay        (getvar "clayer")<br />   )<br />   (setvar "cmdecho" 0)<br />   (setvar "LUPREC" 8)<br />   (setvar "LUNITS" 2)<br />   (if (= (TBLOBJNAME "LAYER" "wk_line") nil)<br />     (command "layer" "m" "wk_line" "c" "2" "" "")<br />   )<br />   (if (= (TBLOBJNAME "LAYER" "nk_line") nil)<br />     (command "layer" "m" "nk_line" "c" "1" "" "")<br />   )<br />   (setvar "clayer" "wk_line")<br />   (setq        wk_pt1 (getpoint "\n指定第一角点")<br />         wk_pt3 (getcorner wk_pt1 "\n指定第二角点:")<br />         nk_n   (getint "\n请输入大于零的等分数:")<br />         wk_kd  (getreal "\n输入边框宽度:输入0为简版<20mm>:")<br />   )<br />   (if (= wk_kd nil)<br />     (setq wk_kd 20.0)<br />   )<br />   (setq        wk_ptn (list (min (car wk_pt1) (car wk_pt3))<br />                      (min (cadr wk_pt1) (cadr wk_pt3))<br />                )<br />         wk_pt3 (list (max (car wk_pt1) (car wk_pt3))<br />                      (max (cadr wk_pt1) (cadr wk_pt3))<br />                )<br />         wk_pt1 wk_ptn<br />   )<br />   (setq        ptax (car wk_pt1)<br />         ptay (cadr wk_pt1)<br />         ptbx (car wk_pt3)<br />         ptby (cadr wk_pt3)<br />   )<br />   (setq        wk_pt2 (list ptax ptby)<br />         wk_pt4 (list ptbx ptay)<br />   )<br />   (if (/= wk_kd 0)<br />     (progn<br />       (setq nk_pt1<br />              (polar wk_pt1<br />                     (/ pi 4)<br />                     (* wk_kd (* 2 (sqrt 2)))<br />              )<br />       )<br />       (setq nk_pt3<br />              (polar wk_pt3<br />                     (/ (* pi 5) 4)<br />                     (* wk_kd (* 2 (sqrt 2)))<br />              )<br />       )<br />       (setq ptax (car nk_pt1)<br />             ptay (cadr nk_pt1)<br />             ptbx (car nk_pt3)<br />             ptby (cadr nk_pt3)<br />       )<br />       (setq nk_pt2 (list ptax ptby)<br />             nk_pt4 (list ptbx ptay)<br />       )<br />     )<br />     (setq nk_pt1 wk_pt1<br />           nk_pt2 wk_pt2<br />           nk_pt3 wk_pt3<br />           nk_pt4 wk_pt4<br />     )<br />   )<br />   (setq        l_pt1_pt4   (distance nk_pt1 nk_pt4)<br />         l_pt1_pt2   (distance nk_pt1 nk_pt2)        <br />         ang_pt1_pt4 (angle nk_pt1 nk_pt4)<br />         l_n            (/ l_pt1_pt4 nk_n)<br />   )<br />   (if (< oldos 16384)<br />     (setvar "osmode" (+ oldos 16384))<br />   )<br />   (if (/= wk_kd 0)<br />     (progn<br />       (command "_.rectang" wk_pt1 wk_pt3)<br />       (setvar "clayer" "nk_line")<br />       (command "_.rectang" nk_pt1 nk_pt3)<br />     )<br />     (progn (command "_.rectang" nk_pt1 nk_pt3)<br />            (setvar "clayer" "nk_line")<br />     )<br />   )<br />   (setq        n_pt1 nk_pt1<br />         n_pt2 nk_pt2<br />   )<br />   (repeat (- nk_n 1)<br />     (setq n_pt3        (polar n_pt1 ang_pt1_pt4 l_n)<br />           n_pt4        (polar n_pt3 (+ ang_pt1_pt4 (/ pi 2.0)) l_pt1_pt2)<br />     )<br />     (command "_.line" n_pt1 n_pt4 n_pt3 n_pt2 "")<br />     (setq n_pt1        n_pt3<br />           n_pt2        n_pt4<br />     )<br />   )<br />   (command "_.line" n_pt1 nk_pt3 "")<br />   (command "_.line" nk_pt4 n_pt2 "")<br />   (setvar "osmode" oldos)<br />   (setvar "cmdecho" oldcmd)<br />   (setvar "clayer" oldlay)<br />   (setvar "LUPREC" oldlup)<br />   (setvar "LUNITS" oldlun)<br />   (princ)<br /> )<br />

daidong013

回复 zhynt 的帖子

现在好了，不错不错！~二合为一！~~感谢！~~
只不过只能识别一个方向的等分，不是识别长边为基础！~~
这样竖向画的时候就有问题！~~

ZZXXQQ

7楼和13楼的可竖画。