[源码]测绘画房子

004

1. ;;;测绘画房子
   
2. ;;;四个，三个，两个边长画房子
   
3. ;;;wkq004  20140402
   
4. (defun c:df (/ e pt pt2 pt3 ang fxang fxline)
   
5.     (defun *error* (msg)
   
6.     (princ "\n取消!")
   
7.     (if e
   
8.     (entdel e)
   
9.   )
   
10.     (command ".undo" "end")
    
11.     (setq *error* nil)
    
12.   )
    
13.     (if (>= (setq os (getvar "osmode")) 16384)
    
14.     (setvar "osmode" (- os 16384))
    
15.     (setvar "osmode" (+ os 16384))
    
16.   )
    
17. 
    
18.   (setq pt (getpoint "\n拾取房角点："))
    
19.   (setq pt2 (getpoint pt "\n拾取房边方向线："))
    
20.   (entmake (list '(0 . "LINE")
    
21.        '(100 . "AcDbEntity")
    
22.        '(100 . "AcDbLine")
    
23.        (cons 10 pt)
    
24.        (cons 11 (polar pt (angle pt pt2) 1000))
    
25.        '(62 . 1)
    
26.        '(210 0. 0. 1.)
    
27.        )
    
28.     )
    
29.   (setq dist (getdist pt "\n输入房边长："))
    
30.   (entdel (entlast))
    
31.   (setq startpt pt)
    
32.   (setq ang (angle pt pt2))
    
33.   (command "line" pt (setq pt2 (polar pt ang dist)) "")
    
34.   (setq co 2)
    
35.   (setq elst '())
    
36.   (setq elst (cons (entlast) elst))
    
37.   (defun fxline  (pta ptb /)
    
38.     (setq ang (angle pta ptb))
    
39.     (cond ((and (>= ang 0) (< ang (/ pi 2)))
    
40.      (setq fxang (+ ang (/ pi 2)))
    
41.     ) ;_0-90
    
42.     ((and (>= ang (/ pi 2)) (< ang pi))
    
43.      (setq fxang (- ang (/ pi 2)))
    
44.     ) ;_90-180
    
45.     ((and (>= ang pi) (< ang (/ (* 3 pi) 2)))
    
46.      (setq fxang (+ (- ang pi) (/ pi 2)))
    
47.     ) ;_180-270
    
48.     ((and (>= ang (/ (* 3 pi) 2)) (< ang (* 2 pi)))
    
49.      (setq fxang (- (- ang pi) (/ pi 2)))
    
50.     ) ;_270-0
    
51.     )
    
52.     (setq ptc (polar ptb fxang 1000))
    
53.     (entmake (list '(0 . "LINE")
    
54.        '(100 . "AcDbEntity")
    
55.        '(100 . "AcDbLine")
    
56.        (cons 10 ptb)
    
57.        (cons 11 ptc)
    
58.        '(62 . 1)
    
59.        '(210 0. 0. 1.)
    
60.        )
    
61.     )
    
62.     (setq e (entlast))
    
63.   )
    
64.   (fxline pt pt2)
    
65.   (setq xh T)
    
66. 
    
67.   (while (and xh
    
68.        (/= (setq world
    
69.       (getstring
    
70.         "\n测绘画房,负距离反方向线绘制[闭合(C)/延长(Y)/撤销(U)]<房边长>： "
    
71.       )
    
72.      )
    
73.      ""
    
74.        )
    
75.    )
    
76.     (if  (/= 0.0 (setq num (atof world)))
    
77.       (if (>= num 0.0)
    
78.   (progn
    
79.     (entdel e)
    
80.     (command "line" pt2 (setq pt3 (polar pt2 fxang num)) "")
    
81.     (setq elst (cons (entlast) elst))
    
82.     (fxline pt2 pt3)
    
83.    
    
84.     (setq pt2 pt3)
    
85.   )
    
86.   (progn
    
87.     (if (> fxang pi)
    
88.       (setq fxang (- fxang pi))
    
89.       (setq fxang (+ fxang pi))
    
90.     )
    
91.     (entdel e)
    
92.     (command "line"
    
93.        pt2
    
94.        (setq pt3 (polar pt2 fxang (abs num)))
    
95.        ""
    
96.     )
    
97.     (setq elst (cons (entlast) elst))
    
98.     (fxline pt2 pt3)
    
99.    
    
100.     (setq pt2 pt3)
     
101.   )
     
102.       )
     
103.       (cond
     
104.   ((= (strcase world) "C")
     
105.    (setq xh nil)
     
106.    (setq elst (cons (entlast) elst))
     
107.    (entdel e)
     
108.    (command "line" pt3 startpt "")
     
109.   )
     
110.   ((= (strcase world) "Y")
     
111.    (if (/= (setq world (getstring "\n请输入延长距离：")) "")
     
112.      (if (> (setq num (atof world)) 0.0)
     
113.        (progn
     
114.          (entdel e)
     
115.          (setq pt3 (polar pt2 ang num))
     
116.          (if (> (setq co (1+ co)) 5)
     
117.      (setq co 2)
     
118.      )
     
119.          (entmake  (list '(0 . "LINE")
     
120.             '(100 . "AcDbEntity")
     
121.             '(100 . "AcDbLine")
     
122.             (cons 10 pt2)
     
123.             (cons 11 pt3)
     
124.             (cons 62 co)
     
125.             '(210 0. 0. 1.)
     
126.       )
     
127.          )
     
128. 
     
129.          (fxline pt2 pt3)
     
130. 
     
131.          (setq pt2 pt3)
     
132.        )
     
133.        (princ "   延长距离只能为正实数!")
     
134.      )
     
135.    )
     
136.   )
     
137.   ((= (strcase world) "U")
     
138.    (entdel e) ;_删辅助线
     
139.    (entdel (car elst)) ;_删线
     
140.    (setq elst (cdr elst))
     
141.    (setq laste (car elst))
     
142.    (setq el (entget laste))
     
143.    (setq pt (cdr (assoc 10 el)))
     
144.    (setq pt2 (cdr (assoc 11 el)))
     
145.    (fxline pt pt2)
     
146.    (setq pt2 pt3)
     
147.   )
     
148. ;;;  (t
     
149. ;;;   
     
150. ;;;  )
     
151.       )
     
152.     )
     
153.   )
     
154.   (if (= world "")
     
155.     (entdel e)
     
156.   )
     
157.     (if (>= (setq os (getvar "osmode")) 16384)
     
158.     (setvar "osmode" (- os 16384))
     
159.     (setvar "osmode" (+ os 16384))
     
160.   )
     
161. 
     
162.   (princ)
     
163. )

;;;测绘画房子<br /> ;;;四个，三个，两个边长画房子<br /> ;;;wkq004  20140402<br /> (defun c:df (/ e pt pt2 pt3 ang fxang fxline)<br />     (defun *error* (msg)<br />     (princ "\n取消!")<br />     (if e<br />     (entdel e)<br />   )<br />     (command ".undo" "end")<br />     (setq *error* nil)<br />   )<br />     (if (>= (setq os (getvar "osmode")) 16384)<br />     (setvar "osmode" (- os 16384))<br />     (setvar "osmode" (+ os 16384))<br />   )<br /> <br />   (setq pt (getpoint "\n拾取房角点："))<br />   (setq pt2 (getpoint pt "\n拾取房边方向线："))<br />   (entmake (list '(0 . "LINE")<br />        '(100 . "AcDbEntity")<br />        '(100 . "AcDbLine")<br />        (cons 10 pt)<br />        (cons 11 (polar pt (angle pt pt2) 1000))<br />        '(62 . 1)<br />        '(210 0. 0. 1.)<br />        )<br />     )<br />   (setq dist (getdist pt "\n输入房边长："))<br />   (entdel (entlast))<br />   (setq startpt pt)<br />   (setq ang (angle pt pt2))<br />   (command "line" pt (setq pt2 (polar pt ang dist)) "")<br />   (setq co 2)<br />   (setq elst '())<br />   (setq elst (cons (entlast) elst))<br />   (defun fxline  (pta ptb /)<br />     (setq ang (angle pta ptb))<br />     (cond ((and (>= ang 0) (< ang (/ pi 2)))<br />      (setq fxang (+ ang (/ pi 2)))<br />     ) ;_0-90<br />     ((and (>= ang (/ pi 2)) (< ang pi))<br />      (setq fxang (- ang (/ pi 2)))<br />     ) ;_90-180<br />     ((and (>= ang pi) (< ang (/ (* 3 pi) 2)))<br />      (setq fxang (+ (- ang pi) (/ pi 2)))<br />     ) ;_180-270<br />     ((and (>= ang (/ (* 3 pi) 2)) (< ang (* 2 pi)))<br />      (setq fxang (- (- ang pi) (/ pi 2)))<br />     ) ;_270-0<br />     )<br />     (setq ptc (polar ptb fxang 1000))<br />     (entmake (list '(0 . "LINE")<br />        '(100 . "AcDbEntity")<br />        '(100 . "AcDbLine")<br />        (cons 10 ptb)<br />        (cons 11 ptc)<br />        '(62 . 1)<br />        '(210 0. 0. 1.)<br />        )<br />     )<br />     (setq e (entlast))<br />   )<br />   (fxline pt pt2)<br />   (setq xh T)<br /> <br />   (while (and xh<br />        (/= (setq world<br />       (getstring<br />         "\n测绘画房,负距离反方向线绘制[闭合(C)/延长(Y)/撤销(U)]<房边长>： "<br />       )<br />      )<br />      ""<br />        )<br />    )<br />     (if  (/= 0.0 (setq num (atof world)))<br />       (if (>= num 0.0)<br />   (progn<br />     (entdel e)<br />     (command "line" pt2 (setq pt3 (polar pt2 fxang num)) "")<br />     (setq elst (cons (entlast) elst))<br />     (fxline pt2 pt3)<br />     <br />     (setq pt2 pt3)<br />   )<br />   (progn<br />     (if (> fxang pi)<br />       (setq fxang (- fxang pi))<br />       (setq fxang (+ fxang pi))<br />     )<br />     (entdel e)<br />     (command "line"<br />        pt2<br />        (setq pt3 (polar pt2 fxang (abs num)))<br />        ""<br />     )<br />     (setq elst (cons (entlast) elst))<br />     (fxline pt2 pt3)<br />     <br />     (setq pt2 pt3)<br />   )<br />       )<br />       (cond<br />   ((= (strcase world) "C")<br />    (setq xh nil)<br />    (setq elst (cons (entlast) elst))<br />    (entdel e)<br />    (command "line" pt3 startpt "")<br />   )<br />   ((= (strcase world) "Y")<br />    (if (/= (setq world (getstring "\n请输入延长距离：")) "")<br />      (if (> (setq num (atof world)) 0.0)<br />        (progn<br />          (entdel e)<br />          (setq pt3 (polar pt2 ang num))<br />          (if (> (setq co (1+ co)) 5)<br />      (setq co 2)<br />      )<br />          (entmake  (list '(0 . "LINE")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbLine")<br />             (cons 10 pt2)<br />             (cons 11 pt3)<br />             (cons 62 co)<br />             '(210 0. 0. 1.)<br />       )<br />          )<br /> <br />          (fxline pt2 pt3)<br /> <br />          (setq pt2 pt3)<br />        )<br />        (princ "   延长距离只能为正实数!")<br />      )<br />    )<br />   )<br />   ((= (strcase world) "U")<br />    (entdel e) ;_删辅助线<br />    (entdel (car elst)) ;_删线<br />    (setq elst (cdr elst))<br />    (setq laste (car elst))<br />    (setq el (entget laste))<br />    (setq pt (cdr (assoc 10 el)))<br />    (setq pt2 (cdr (assoc 11 el)))<br />    (fxline pt pt2)<br />    (setq pt2 pt3)<br />   )<br /> ;;;  (t<br /> ;;;   <br /> ;;;  )<br />       )<br />     )<br />   )<br />   (if (= world "")<br />     (entdel e)<br />   )<br />     (if (>= (setq os (getvar "osmode")) 16384)<br />     (setvar "osmode" (- os 16384))<br />     (setvar "osmode" (+ os 16384))<br />   )<br /> <br />   (princ)<br /> )

杜阳

j继续了  大师  我是个初学者   支持你了

lioun4105

拿来试一试，谢谢

月之圣痕

学习当中。

happy336

谢谢分享，支持