Bộ AutoLISP Do kts. Trần Ngọc Thắng TỰ BIÊN SOẠN + SƯU TẦM

TranNgocThang76

1. ********************************************************************************
   
2. *             ACADLISP FOR AUTOCAD R.14 -> AUTOCAD R.2012                      *
   
3. *         Tran Ngoc Thang DHXD-HaNoi41 from years 1999 -> 2015                 *
   2 x7 O7 p7 U' H! E' [: U
4. *                         Suu tam & Soan                                       *
   7 S. ~, d+ q+ i* M
5. ********************************************************************************
   / p% k0 I# ~" ]. o( |9 Y& |( j$ ]
6. 
   1 K# T: g$ `. }) E9 a2 F1 R- S
7. ; Next available MSG number is  104
   : [) z. e6 _1 ~4 K9 ~/ l
8. ; MODULE_ID ACAD2000doc_LSP_
   , y& Q/ _* H/ j, o9 W
9. ;;;    ACAD2000DOC.LSP Version 1.0 for AutoCAD 2000
     y' L- Z3 R: l# I
10. ;;;
    4 V; W0 T3 C: V
11. ;;;    Copyright (C) 1994 - 1999 by Autodesk, Inc.
    
12. ;;;
    
13. ;;;    Permission to use, copy, modify, and distribute this software
    - e; P; c3 j# h5 T
14. ;;;    for any purpose and without fee is hereby granted, provided
    
15. ;;;    that the above copyright notice appears in all copies and
    / C/ B! j1 ~) W
16. ;;;    that both that copyright notice and the limited warranty and
    5 p6 X9 U( K1 \7 Q4 a; O8 E
17. ;;;    restricted rights notice below appear in all supporting
    ! E1 @. _$ p$ e
18. ;;;    documentation.
    
19. ;;;
    % p; L5 v; W7 U/ h+ ~6 k2 T8 Q
20. ;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
    
21. ;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
    0 M3 @* t  D- s) R; H* m: z6 H
22. ;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
    
23. ;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
    % ~1 k0 b4 T* c2 a  O3 u% j+ D" S
24. ;;;    UNINTERRUPTED OR ERROR FREE.
    , f( _  h- i! i
25. ;;;
    
26. ;;;    Use, duplication, or disclosure by the U.S. Government is subject to
    
27. ;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
    0 [1 X( o4 ~3 {
28. ;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
    
29. ;;;    (Rights in Technical Data and Computer Software), as applicable.
    
30. ;;;
    
31. ;;;.
    9 ]1 X: t  [5 p& a
32. ;;;
    
33. ;;;    Note:
    
34. ;;;            This file is loaded automatically by AutoCAD every time
    
35. ;;;            a drawing is opened.  It establishes an autoloader and
    
36. ;;;            other utility functions.
    
37. ;;;
    
38. ;;;    Globalization Note:   
    % s! ]( R! S* c' j  x- t* D
39. ;;;            We do not support autoloading applications by the native
    ( e$ D0 {1 M' i
40. ;;;            language command call (e.g. with the leading underscore
    
41. ;;;            mechanism.)
    ' Q/ O# w- ]5 p
42. 
    8 w# Q& p1 }$ ~# d- T: E$ y
43. 
    
44. ;;;===== Raster Image Support for Clipboard Paste Special =====
    . @+ K0 ^  V) U- |* ^9 ^1 g1 G. A
45. ;;
    
46. ;; IMAGEFILE
      B& S+ y3 L& d3 P/ }% K% E3 @
47. ;;
      q! s3 ~- G$ k0 K" o. P; t
48. ;; Allow the IMAGE command to accept an image file name without
    + \' U, z9 N) H- V
49. ;; presenting the file dialog, even if filedia is on.
    " s+ j9 t. [7 ^& p/ w# r% a6 @$ ]
50. ;; Example: (imagefile "c:/images/house.bmp")
    
51. ;;
    
52. (defun imagefile (filename / filedia-save cmdecho-save)
    
53.   (setq filedia-save (getvar "FILEDIA"))
    
54.   (setq cmdecho-save (getvar "CMDECHO"))
    
55.   (setvar "FILEDIA" 0)
    ' D4 ], X- n$ k) r. i" j. n
56.   (setvar "CMDECHO" 0)
    $ V. i& }* G0 S4 ~% @  ^2 V4 _
57.   (command "_.-image" "_attach" filename)
    
58.   (setvar "FILEDIA" filedia-save)
    1 \, E; t" r8 z6 `. G
59.   (setvar "CMDECHO" cmdecho-save)
    
60.   (princ)
    $ _" R7 l- Z% e; Y. S8 f
61. )
    
62. 
    
63. (defun c:zx () (command "zoom" ".5x"))
    3 t( Q$ e' @/ N4 U6 W# H; u0 a& \
64. (defun c:zz () (command "zoom" "p"))
    
65. (defun c:za () (command "zoom" "a"))
    
66. (defun c:zd () (command "zoom" "d"))
    
67. (defun c:ze () (command "zoom" "e"))
    ) e/ s- f0 O% g1 Z9 |( _
68. (defun c:zr () (command "zoom" "" ""))
    # R6 B& M1 f! G+ D, K" \. |# L. L
69. (defun c:vv () (command "ucs" "v"))
    ) O: d) F8 J" a7 O4 B" c7 [
70. (defun c:co () (ssget) (command "copy" "p" "" "m"))
    2 Z; m1 S& w, L9 g1 M! G
71. (defun c:c () (command "circle"))
    
72. (defun c:rt () (command "rotate"))
    . \% ], ?( H! E
73. (defun c:3q () (ssget) (command "_rotate3d" "ANGDIR" "value" pause (princ)))
    
74. (defun c:30 () (ssget) (command "rotate" "p" "" pause "30"))
    ' C1 B; ]4 X1 Q4 [' N6 n
75. (defun c:-30 () (ssget) (command "rotate" "p" "" pause "-30"))
    ; b. w- r1 B1 h  ~9 x8 g$ _; _
76. (defun c:45 () (ssget) (command "rotate" "p" "" pause "45"))
    
77. (defun c:r5 () (ssget) (command "rotate" "p" "" pause "5"))
    # |5 E6 ~. X/ h' v: J' a( v
78. (defun c:60 () (ssget) (command "rotate" "p" "" pause "60"))
    / F4 |2 t& i5 P  r. R1 b
79. (defun c:-60 () (ssget) (command "rotate" "p" "" pause "-60"))
    $ k  w" v" ?) O9 l5 Y
80. (defun c:90 () (ssget) (command "rotate" "p" "" pause "90"))
    
81. (defun c:180 () (ssget) (command "rotate" "p" "" pause "180"))
    . w' Q# {: V* L& V
82. (defun c:-45 () (ssget) (command "rotate" "p" "" pause "-45"))
    
83. (defun c:-90 () (ssget) (command "rotate" "p" "" pause "-90"))
    ( J' L" f) ]6 Z
84. (defun c:md () (ssget) (command "mirror" "p" "" pause pause "y"))
    
85. (defun c:fd () (command "find" "p" "" )(princ))(princ)
    
86. 
    # a* Q1 D/ B8 K9 G
87. (defun c:romantdim () (command "-style" "ROMANT-DIM" "romant,vnh.shx" "200""1""0""n""n""n"))(princ)
    
88. (defun c:romantext () (command "-style" "ROMANT-TEXT" "romant,vnh.shx" "200""1""0""n""n""n"))(princ)
    * w( I) q- k" I' x+ F, A
89. (defun c:vnhelvthuong () (command "-style" "VNHELVLT-Thuong" "vnhelv,vnh.shx" "500""1""0""n""n""n"))(princ)
    ( [; ^8 ]2 S5 {! j" @
90. (defun c:vnhelvhoa () (command "-style" "VNHELVLT-Hoa" "vnhelvh,vnh.shx" "500""1""0""n""n""n"))(princ)
    
91. (defun c:truc () (command "-style" "TRUC" "impact" "0""1""0""n""n""n"))
    
92. (defun c:chu () (command "-style" "VERDANA" "verdana" "200""1""0""n""n"))
    # W  Q+ S+ q$ f5 f! x
93. (defun c:cot () (command "-style" "COTES" "verdana" """1""0""n""n"))
    : F; ?" h$ o' t, S" R( J% k
94. 
    & z% M/ u8 K+ Q' r, y
95. (defun c:an () (command "-style" ".AVANT" ".vnavant" "200""1""0""n""n"))
    ; z2 _# U# n# R
96. (defun c:ah () (command "-style" ".AVANTH" ".vnavanth" "200""1""0""n""n"))
    $ C0 }+ m' P2 l: q6 V. W
97. (defun c:ha () (command "-style" ".ARIALH" ".vnarialh" "200""1""0""n""n"))
    
98. (defun c:na () (command "-style" ".ARIALNARROWH" ".vnarial narrowh""1200""1""0""n""n"))
    ! i; \; L  a6 |
99. (defun c:vn () (command "-style" ".VNTIME" ".vntime" "200""1""0""n""n"))
    ) }6 [0 _# w6 a% s3 |
100. (defun c:vh () (command "-style" ".VNTIMEH" ".vntimeh" "200""1""0""n""n"))
     & N7 w; S8 ~4 @
101. 
     ' |$ \9 Q( C$ c7 M) H  a
102. (defun c:ps () (command "PSOUT" "CorelDraw-import-Photoshop" "W"))(princ);export the current view of a drawing as an EPS file
     
103. 
     / s/ ?6 \1 x% g& c, ^/ q
104. ;free lisp by cadviet,cd2k44
     , ^$ d3 y, }5 l0 T" b' R8 j
105. ;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
     
106. (defun c:FTEXT (/ ent tstyle )
     
107. (command "undo" "be")
     
108. (setq ent (entsel "\n Pick text :"))
     6 \% A0 y, E, p. G0 ?
109. (setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
     ! T# e, a$ r+ L& T
110. (command "STYLE" TSTYLE "romant.shx,vnh.shx" "0" "1" "0" "N" "N" "n")
     9 g& F' ]! l6 [# b5 l( |. ~: ^
111. (setvar "TEXTSTYLE" Tstyle)
     ; m5 V3 [' m3 J
112. (command "undo" "end")
     6 K1 z3 C, F- M$ h# u
113. )
     3 ]4 e& R; i' o$ y  L$ ?% v) l' q
114. ;Cam on cadviet nhieu 27-11-2023 04h15p36s (thanks cadviet)
     
115. 
     
116. ;free lisp by cadviet,cd2k44
     
117. ;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
     
118. (defun c:Fvnh (/ ent tstyle )
     
119. (command "undo" "be")
     
120. (setq ent (entsel "\n Pick text :"))
     ' Z$ T- E3 S; G# x5 h
121. (setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
     
122. (command "STYLE" TSTYLE "vnhelvh.shx,vnh.shx" "0" "1" "0" "N" "N" "n")
     & |8 I6 G' ~" L7 z# i
123. (setvar "TEXTSTYLE" Tstyle)
     
124. (command "undo" "end")
     " V5 z" T( o$ C; j
125. )
     9 y2 P2 K( L; g, A( X# S
126. 
     4 |, v9 G  X' x; m7 c5 x5 h8 I
127. ;free lisp by cadviet,cd2k44
     
128. ;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
     
129. (defun c:Chbg (/ ent tstyle )
     
130. (command "undo" "be")
     ( u! j7 I% H9 r% _7 K: y" g
131. (setq ent (entsel "\n Pick text :"))
     
132. (setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
     7 U2 h; Z" _  I5 D& u
133. (command "STYLE" TSTYLE "chhbg.shx,vnh.shx" "0" "1" "0" "N" "N" "n")
     
134. (setvar "TEXTSTYLE" Tstyle)
     
135. (command "undo" "end")
       G$ W( `/ `' y$ m9 e! L) Y4 }( K
136. )
     ' X" ]7 |0 z8 q7 [7 z8 W: o
137. 
     & T/ e* |8 o9 Y; Y% N5 N" m
138. ;free lisp by cadviet,cd2k44
     % Q- C& b1 {4 x& j
139. ;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
     ; M) e- V9 m, R" L: O$ U  R4 U, F
140. (defun c:Chsm (/ ent tstyle )
     ( H* W7 d& a# o
141. (command "undo" "be")
     : j2 @& I) C1 z( D& j' i
142. (setq ent (entsel "\n Pick text :"))
     ' t9 t9 X/ w" y/ H) X
143. (setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
     1 Y* k& J; C9 j: ~) m
144. (command "STYLE" TSTYLE "chhsml.shx,vnh.shx" "0" "1" "0" "N" "N" "n")
     
145. (setvar "TEXTSTYLE" Tstyle)
     
146. (command "undo" "end")
     
147. )
     
148. 
     
149. ;free lisp by cadviet,cd2k44
     
150. ;link bai viet http://www.cadviet.com/forum/index.php?showtopic=53830
     
151. (defun c:Fttf (/ ent tstyle )
     
152. (command "undo" "be")
     
153. (setq ent (entsel "\n Pick text :"))
     
154. (setq TSTYLE (cdr (assoc 7 (entget (car ent)))))
     # S7 P& ~+ H2 C; ^$ V
155. (command "STYLE" TSTYLE "verdana.ttf" "0" "1" "0" "N" "N" "n")
     
156. (setvar "TEXTSTYLE" Tstyle)
     " O: e4 }8 }: R. l8 H/ I4 c$ b
157. (command "undo" "end")
     ' o3 i2 q8 |. J" H- x/ @
158. )
     
159. 
     $ R9 e# k# `" I3 `$ d! x' Y7 w
160. ;;; ============================================
     9 i4 H& o$ J1 b! b! g/ |
161. ;;;
     
162. ;;;   LISP Creater Tao Duong Dan AUTOCAD2000
     2 G. E( P  }& q! P/ r4 E
163. ;;;
     
164. ;;; ============================================
     
165. 
     : j! p& z4 a8 n( n1 Y2 ]
166. ;;; ============================================
     
167. ;;;
     * o0 o8 `, N. E% b
168. ;;;          CREATING FROM AUTOCAD2000
     
169. ;;;
     8 O* B1 M* Z/ w( F  a3 E8 c
170. ;;; ============================================
     
171. 
     
172. (setvar "INSUNITS"4)
     , V# A& {, V# B5 h" f  o$ @
173. (setvar "ANGBASE"0)
     # K/ ?8 q  v- R1 T3 j
174. (setvar "ANGDIR"0)
     
175. (setvar "AUNITS"0)
     
176. (setvar "AUPREC"8)
     & G( v- P4 K0 ~7 |  C! I. i
177. (setvar "LUNITS"2)
     , l: t1 g, D, @/ i% z
178. (setvar "LUPREC"8)
     8 T% o' k5 T7 T/ [% m
179. (setvar "ACADLSPASDOC"1)
     
180. (setvar "pickbox"5)
     
181. (setvar "blipmode"0)
     
182. (setvar "mirrtext"0)
     * A; x" c* s9 l) n) R; }9 U
183. (setvar "cursorsize"100)
     
184. (setvar "ZOOMFACTOR"75)
     * S" r9 `% N' U+ U
185. (setvar "LTSCALE" 10)
     9 B& ^$ M1 m: f9 h
186. (setvar "lwunits"1)
     ( b9 i6 k2 D  N7 s- @
187. (setvar "DIMBLK" "Closed")
     
188. (setvar "DIMGAP"0.0693)
     
189. (setvar "DIMASZ"0.20)
     ) n; F0 ^1 t& O! L( q. i3 ?& K) D0 k( u
190. (setvar "DIMCEN"0.2)
     
191. (setvar "DIMDLI"0.1)
     
192. (setvar "DIMEXE"0.0693)
     
193. (setvar "DIMEXO"0.25)
     8 r! L3 J3 K. Z3 ]( K
194. (setvar "DIMDEC"0)
     
195. (setvar "DIMTIX" 1)
     
196. (setvar "DIMTXT" 0.099)
     
197. (setvar "DIMCLRT" 7)
     
198. (setvar "DIMTVP" 1)
     
199. (setvar "DIMJUST" 0)
     6 B. J2 O9 k) @, p2 Q! Z+ d5 `2 H
200. (setvar "DIMTIH" 0)
     1 R! u3 e5 x; I1 _! \" h( D
201. (setvar "DIMTOFL" 1)
       q7 ^  X' y0 {. C4 c6 }0 ]4 ]7 K- z
202. (setvar "DIMSCALE" 1111.1111)
     " G! [0 m5 ~4 y1 d0 D. G
203. 
     
204. 
     
205. 
     
206. (defun c:zp ()  (command "'.zoom" "p"))
     
207. (defun c:zz ()  (command "'.zoom" "p"))
     0 L! T' n, L3 z" w
208. (defun c:ze ()  (command "'.zoom" "e"))
     
209. (defun c:za ()  (command "'.zoom" "a"))
     - ^0 y7 p; S1 T& E8 G5 @7 ^
210. (defun c:zd ()  (command "'.zoom" "d"))
     
211. (DEFUN C:ZZZ () (COMMAND "ZOOM" ".25X"))
     & x; m9 z, m3 H" y/ K( e  W
212. (DEFUN C:ZX  () (COMMAND "ZOOM" "2X"))
     4 @; X! E( O, P2 T% N
213. (defun c:de () (command "ddedit")(princ))
     ( B7 G- o& K. E/ Q' R( F! W3 M
214. (defun c:dda () (command "Dimaligned"))
     : W/ P" Z' [5 `! G! d: Y7 |. |
215. (defun c:ddb () (command "Dimabaseline"))
     / \& B& ?5 o' Z- @! z7 O
216. (defun c:ddc () (command "Dimcontinue"))
     
217. (defun c:dde () (command "Dimtedit"))
     
218. (defun c:ddf () (command "Ddattdef"))
     3 s( G, L( k3 `1 b8 j) u" F9 B# I( Y
219. (defun c:ddi () (command "Dimdiameter"))
     8 o3 r, x9 X9 M3 |8 j
220. (defun c:ddl () (command "Dimlinear"))
     $ P- U$ t$ v3 ?& `, U
221. (defun c:ddn () (command "Dimangular"))
     8 d% A; D! {" s: `- h5 Z
222. (defun c:ddo () (command "Dimordinate"))
     " F" }" `4 o0 E2 b- a
223. (defun c:ddr () (command "Dimradius"))
     
224. (defun c:dds () (command "Dimstyle"))
     
225. 
     
226. (defun c:DU () (command "dim1" "up" "select" "exit" pause ))(princ)
     ( r7 b- H( i/ G2 O" y$ l" E+ A
227. (defun c:DH () (command "Dim1" "home" "select" "exit" pause))(princ)
     
228. (defun c:UU () (command "dim1""update""all"))
     
229. (defun c:ded() (command "dim1""tedit"))
     " y, P0 `/ ~& {9 V0 l. h% O4 S5 p: @
230. (defun c:da () (command "dim1""ali"))
     3 c' E$ J& A7 w$ C4 O, |  s% m
231. (defun c:dll() (command "dim1""l"))
     
232. (defun c:dan() (command "dim1""an"))
     
233. (defun c:d1 () (command "dim1""ra"))
     # E" u! j% |( D/ n3 n
234. (defun c:n  () (command "dim1""new"))
       H+ H% I& U8 M" p3 c
235. 
     ; |% s5 g8 c" ]9 T/ Y
236. (DEFUN C:PE  () (COMMAND "PEDIT"))
     , h0 B5 w2 |1 u
237. (DEFUN C:PL  () (COMMAND "PLINE"))
     
238. (defun c:dd () (command "dist")(princ))
     
239. (defun c:w () (command "pedit" pause "w" "au")(princ))
       O# P$ q8 b; x( s  Z! ~8 F" J
240. (defun c:pg  () (command "polygon" "polygon"))
     
241. (defun c:el  () (command "ellipse"))
     
242. (defun c:xe  () (command "explode"))
     3 U& W) V: i- ]
243. (defun c:eex  () (command "extrude"))
     - u) g; Z/ T' e4 r( c
244. (defun c:xg  () (command "xline""a"))
     8 k9 E' t0 T  L9 b
245. (defun c:xh  () (command "xline""h"))
     ) o! ~9 [  v  a* j5 i* D
246. (defun c:xv  () (command "xline""v"))
     - m/ O$ W% o: Z" F/ x: x
247. 
     
248. (defun c:oc () (command "osnap""cen"))
     
249. (defun c:od () (command "osnap""nod"))
     
250. (defun c:oe () (command "osnap""end"))
     5 x, H1 L) W3 M8 j. P
251. (defun c:oi () (command "osnap""int"))
     ( M$ I4 e/ A: u" ?8 E
252. (defun c:or () (command "osnap""per"))
     
253. (defun c:on () (command "osnap""none"))
     
254. (defun c:oq () (command "osnap""qua"))
     
255. (defun c:om () (command "osnap""mid"))
     
256. (defun c:ot () (command "osnap""tan"))
     
257. (defun c:oin () (command "osnap""ins"))
     % k$ b8 L. g! L7 {  q5 |- t( B
258. (defun c:oa () (command "osnap""nea"))
     
259. (defun c:ol () (command "osnap" "End,Mid,Cen,Node,Nea,Int,Perp,Qua")(princ))
     
260. ;(defun c:du () (command "dim1" "up" "s" "pick" "other"))
     
261. ;(defun c:nn () (command "new" "y" ))
     
262. 
     
263. (defun c:/ () (command "limits"))
     
264. (defun c:`1 () (command "region"))
     
265. (defun c:`2 () (command "subtract"))
     
266. (defun c:`3 () (command "union"))
     & O* j/ m; y8 _$ @7 d: \
267. (defun c:`4 () (command "intersect"))
     
268. (defun c:`c () (command "cal"))
     
269. (defun c:`g () (command "Polygon"))
     $ [: ^2 R6 o$ s; _
270. 
     
271. (defun c:lmi() (command "LIMMAX" pause "" "zoom" "all" )(princ))
     , o; i0 X" k) R3 ~
272. (defun c:drt () (command "DRAWORDERCTL" pause "Integer" "" "" )(princ))
     - w+ D; N  c& V3 b2 w! ^8 b" e% V9 a) Y
273. (defun c:ip () (ssget) (command "print,_plot" ))(princ)
     5 t7 z9 ~5 g4 g1 ~
274. 
     
275. (defun c:ddm () (command "ddlmodes" pause))
     
276. 
     
277. (defun c:sha () (command "shade" pause))
     
278. 
     # d" i& l$ T/ n. y. v3 y; j
279. (defun c:sr1 () (command "surftab1" "p" "" pause))
     
280. (defun c:sr2 () (command "surftab2" "p" "" pause))
     
281. 
     3 d; c7 B' O9 P. b# V6 \/ h
282. (defun c:ad () (command "audit""y"))
     , h' q/ U! K" h& T  N1 A% c7 W
283. (defun c:q () (command "quit"))
     - I7 h# I$ p* ?9 a4 N- p  N& \3 }3 s6 ?
284. 
     + w: ]+ v$ h4 R/ @
285. (defun c:30 () (ssget) (command "rotate" "p" "" pause "30"))
     
286. (defun c:-30 () (ssget) (command "rotate" "p" "" pause "-30"))
     
287. (defun c:45 () (ssget) (command "rotate" "p" "" pause "45"))
     
288. (defun c:-45 () (ssget) (command "rotate" "p" "" pause "-45"))
     - ]  m" D* ]. I! @/ g+ d/ h% [. z
289. (defun c:60 () (ssget) (command "rotate" "p" "" pause "60"))
     
290. (defun c:-60 () (ssget) (command "rotate" "p" "" pause "-60"))
     8 K$ r3 |/ I' f  `
291. (defun c:90 () (ssget) (command "rotate" "p" "" pause "90"))
     
292. (defun c:-90 () (ssget) (command "rotate" "p" "" pause "-90"))
     
293. (defun c:180 () (ssget) (command "rotate" "p" "" pause "180"))
     
294. 
     % r- B3 ~! z: y6 R7 z) G8 j. ^
295. (defun c:u3 () (command "ucs""3"))
     
296. (defun c:ue () (command "ucs""o""end"))
     
297. (defun c:ui () (command "ucs""o""int"))
     7 a0 p; e- [& G. o
298. (defun c:um () (command "ucs""o""mid"))
     
299. (defun c:uc () (command "ucs""o""cen"))
     0 h! d) R' P2 P' ~  W4 T6 n
300. (defun c:uq () (command "ucs""o""qua"))
     9 n3 x' o2 p* i' o" u  ?
301. (defun c:3s () (command "ucs""3"))
     9 G" c( q, c" N/ R( z" ]( I
302. (defun c:sx () (command "ucs""s"))
     9 {$ H! h6 g/ ]1 `9 j: x
303. (defun c:sf () (command "ucs""o"))
     ! w8 `$ }) Q( z3 w: g& d
304. (defun c:sz () (command "ucs""p"))
     - d# U% q( }6 b
305. (defun c:sr () (command "ucs""r"))
     
306. (defun c:sw () (command "ucs""w"))
     & @# k, Y+ x, P
307. (defun c:fv () (command "ucs""v"))
     7 M% Q" {% N. G1 N
308. (defun c:ux () (command "ucs""x"))
     
309. (defun c:uux () (command "ucs""x""90"))
     
310. (defun c:xxu () (command "ucs""x""-90"))
     
311. (defun c:uy () (command "ucs""y"))
     
312. (defun c:uuy () (command "ucs""y""90"))
     
313. (defun c:yyu () (command "ucs""y""-90"))
     4 z3 a" K* C5 J% F3 {5 S
314. (defun c:uz () (command "ucs""z"))
     
315. (defun c:uuz () (command "ucs""z""90"))
     + P% Z# \2 {3 I, C( m$ L
316. (defun c:zzu () (command "ucs""z""-90"))
     
317. (defun c:uci () (command "ucsicon" "Properties" ))(princ)
     
318. (defun c:ucm () (command "ucsman" ))(princ)
     1 x" m% F- o4 z% q
319. 
     ' [* Q  l8 H6 \
320. (defun c:sa () (command "vpoint""_non""-1,-1,1"))
     
321. (defun c:sd () (command "vpoint""_non""1,-1,1"))
     % `. M" Y/ \; R5 j
322. (defun c:se () (command "vpoint""_non""1,1,1"))
     + p1 n5 x& P+ p; n  ~8 ^# j1 R
323. (defun c:sq () (command "vpoint""_non""-1,1,1"))
     4 I* @8 N! N( R' A2 y1 n
324. (defun c:vc () (command "plan"""))
     
325. (defun c:vd () (command "dview""all"))
       y6 ^; J  ^+ }8 J  S, |
326. 
     
327. (defun c:TT0 () (command "tilemode""0"))
     
328. (defun c:TT1 () (command "tilemode""1"))
     $ n7 C! i8 i; D$ l
329. 
     
330. (defun c:vt () (command "vpoint""_non""0,0,1"))
     
331. (defun c:vb () (command "vpoint""_non""0,0,-1"))
     
332. (defun c:vl () (command "vpoint""_non""-1,0,0"))
     1 ^2 b" ~' `2 `0 Q3 N6 Y' {/ E
333. (defun c:vr () (command "vpoint""_non""1,0,0"))
     3 E, g( h; U& x/ k. l0 D
334. (defun c:vf () (command "vpoint""_non""0,-1,0"))
     8 d3 k- i3 f. Q0 v, l
335. (defun c:vk () (command "vpoint""_non""0,1,0"))
     # y2 K) c8 _  l* _
336. 
     
337. (DEFUN C:MM  () (COMMAND "MIRROR"))
     # q% o, m! F0 C! V4 s
338. (DEFUN C:MP  () (COMMAND "MOVE" "P"))
     
339. 
     , ]* z; n2 ~0 o  ~* q( I
340. (defun c:mee (/ a)
     
341.   (setq a (ssget))(command "move"a"""end"pause"end"))
     6 \  h; `  f, `. \9 |3 t$ Y  ?
342. (defun c:mc (/ a)
     6 [; ^5 h- c3 y. e( P7 Y$ Z
343.   (setq a (ssget))(command "move"a"""cen"pause"cen"))
     ! l0 h% H! b' N
344. (defun c:cc (/ a)
     
345.   (setq a (ssget))(command "copy"a"""m"))
     
346. (defun c:ce (/ a)
     7 m' A: |% W& N+ ?) |  F
347.   (setq a (ssget))(command "copy"a"""m""end"pause"end"))
     * G; u) ?7 }- k/ J( E
348. (defun c:cn (/ a)
     ' a( [  m( w5 o+ O+ N
349.   (setq a (ssget))(command "copy"a"""m""cen"pause"cen"))
     
350. (defun c:tl ()(command "trim""l"""))
     6 Z& C- q9 e5 n- }% u4 z! m$ ?
351. (defun c:tf (/ a)
     
352. (setq a (ssget))(command "trim"a"""f"))
     6 }8 y! Z$ n9 n+ a" x$ \
353. (defun c:el ()(command "extend""l"""))
     9 \" k& Y' P  A9 ^' ~6 |
354. (defun c:ef (/ a)
     
355.   (setq a (ssget))(command "extend"a"""f"))
     6 ], ?( \  L$ U
356. 
     
357. 
     
358. (DEFUN C:110   ()(princ "\nChon doi tuong can offset ra 110.......") (COMMAND "offset" "110"))
     
359. (DEFUN C:220   ()(princ "\nChon doi tuong can offset ra 220.......")(COMMAND "offset" "220"))
     1 a! T( o" o5 E2 g* V# w
360. (DEFUN C:330   ()(princ "\nChon doi tuong can offset ra 330.......")(COMMAND "offset" "330"))
     
361. (DEFUN C:400   ()(princ "\nChon doi tuong can offset ra 400.......")(COMMAND "offset" "400"))
     ! R3 n1 P" p! D' ~6 ?3 C
362. (DEFUN C:55   ()(princ "\nChon doi tuong can offset ra 55.......") (COMMAND "offset" "55"))
     
363. (DEFUN C:600   ()(princ "\nChon doi tuong can offset ra 600.......") (COMMAND "offset" "600"))
     ! L9 n1 S$ }% O% q: `. v
364. (DEFUN C:700   ()(princ "\nChon doi tuong can offset ra 700.......") (COMMAND "offset" "700"))
     
365. (DEFUN C:800   ()(princ "\nChon doi tuong can offset ra 800.......") (COMMAND "offset" "800"))
     0 u9 I1 P* L+ ~7 Z. n
366. (DEFUN C:900   ()(princ "\nChon doi tuong can offset ra 900.......") (COMMAND "offset" "900"))
     9 t2 q, s* M9 P
367. (DEFUN C:1200   ()(princ "\nChon doi tuong can offset ra 1200.......") (COMMAND "offset" "1200"))
     % Y$ D+ a! Z2 W2 q) k
368. (DEFUN C:1500   ()(princ "\nChon doi tuong can offset ra 1500.......") (COMMAND "offset" "1500"))
     
369. (DEFUN C:1800   ()(princ "\nChon doi tuong can offset ra 1800.......") (COMMAND "offset" "1800"))
     
370. (DEFUN C:2400   ()(princ "\nChon doi tuong can offset ra 2400.......") (COMMAND "offset" "2400"))
     . l( Z/ C0 P" Z- {7 S
371. (DEFUN C:3000   ()(princ "\nChon doi tuong can offset ra 3000.......") (COMMAND "offset" "3000"))
     & q( p8 M/ @6 [1 M
372. (DEFUN C:3600   ()(princ "\nChon doi tuong can offset ra 3600.......") (COMMAND "offset" "3600"))
     
373. (DEFUN C:4200   ()(princ "\nChon doi tuong can offset ra 4200.......") (COMMAND "offset" "4200"))
     . I3 T: Y2 q% J+ w& L" m
374. (DEFUN C:5000   ()(princ "\nChon doi tuong can offset ra 5000.......") (COMMAND "offset" "5000"))
     5 |) q3 h( ]9 d" D
375. 
     
376. (defun c:mla () (command "-mledit""av"))
     9 n; v0 z) M% ~7 X- C+ v3 T" |
377. (defun c:mlc () (command "-mledit""mc"))
     
378. (defun c:mld () (command "-mledit""dv"))
     * J+ n+ F! m9 Q1 d  }
379. (defun c:mle () (command "mline""end"pause"end"))
     0 ]3 R: Y0 G: G* q( T" s$ r
380. (defun c:mli () (command "-mledit""ca""int"pause"int"))
     
381. (defun c:mlj () (command "-mledit""cj"))
     , S- A& y. T# c" U) Q. J" I
382. (defun c:mlt () (command "-mledit""mt"))
     ! K: c% _* U  }1 _; y8 B  {
383. (defun c:mlk () (command "-mledit""ca""end"pause"end"))
     5 s+ R! l* ]$ p7 _( K8 G
384. (defun c:mlw () (command "-mledit""wa"))
     
385. 
     4 `+ }0 H4 i/ K
386. (DEFUN C:DCA () (COMMAND "DVIEW" "all" "" "CA"))
     
387. (DEFUN C:DPA () (COMMAND "DVIEW" "all" "" "PA"))
     
388. (DEFUN C:DPO () (COMMAND "DVIEW" "all" "" "PO"))
     0 N+ v* L) Q+ w; I( k: f3 e' t; c
389. (DEFUN C:DDD () (COMMAND "DVIEW" "all" "" "D"))
     
390. (DEFUN C:DZ  () (COMMAND "DVIEW" "all" "" "Z"))
     7 K" G' E4 \% q6 o! I, [. w
391. 
     5 V. i! c% I0 T
392. (defun c:p0 () (command "pline""""w""0""0"))
     
393. (defun c:ot  () (command "offset""t"))
     
394. (defun c:t  () (command "mtext"pause"j""bl""h"pause))
     2 A! v1 j  Q2 l/ T5 ^
395. (defun c:uo () (command "ucs""ob"pause))
     % E$ d2 P1 k4 m0 k
396. (defun c:f0 () (command "fillet""r""0"))
     
397. (defun c:fr () (command "fillet""r"))
     : S8 r& ~; L% c3 K/ X0 U% ?& z; S
398. 
     
399. ;CHAMFER
     
400. (defun c:cf () (command "chamfer"))
     / |% A, s5 s. i& x
401. (defun c:cfd () (command "chamfer" "d"))
     2 M% C! h. W. h9 R
402. (defun c:cf0 () (command "chamfer" "d" "0" ""))
     
403. 
     
404. ;FILLET
     5 S4 [6 \9 y" T7 ^& D2 m0 g9 B: r
405. (defun c:f () (command "fillet"))
     * N" h' K  f/ D: G, o1 r" f
406. (defun c:fr () (command "fillet" "r"))
     
407. (defun c:f0 () (command "fillet" "r" "0"))
     1 c. e7 b" |' B, K1 a1 u
408. 
     
409. (defun c:OO  () (command "oops"))
     ) g0 R( s9 m% \# e6 D
410. (defun c:dln  () (command "dimlinear"))
     , ]! p% N. n2 k0 C0 U# x" L
411. (defun c:dan  () (command "dimaligned"))
     
412. (defun c:ddc  () (command "dimcontinue"))
     
413. 
     8 ]: T$ w4 H4 q" C' _2 Y
414. (defun c:sc () (command "scale" "auto"))
     
415. (DEFUN C:XO  () (COMMAND "snapang"))
     
416. (defun c:cc (/ a)
     
417.   (setq a (ssget))(command "copy"a"""m"))
     
418. 
     5 g9 j3 {: k* E) u, Z$ c  a" D1 j) e
419. (defun c:PJ (/ a)
     
420.   (setq a (ssget))(command "pedit"a"""j""all""y"))
     
421. (defun c:JJ (/ a)
     2 m7 g% k  X( q: g" a1 H, S9 f
422.   (setq a (ssget))(command "pedit"a"""j""y"))
     
423. (defun c:TN (/ a)
     " C3 E" B) P) [" H$ Y. j  H' [) V
424.   (setq a (ssget))(command "change"a"""p""T"))
     
425. 
     
426. 
     
427. ;=======================Tran Ngoc Thang - Tu nam 2000 - Hoc nam cuoi KTS . DHXD=========================
     5 M* [' N7 A. Z+ H( a4 o7 X! M
428. 
     
429. (defun C:IB ()(setvar"cmdecho"1)
     
430.   (setq pt(cadr(entsel"\nSelect Block:")))
     " c& d$ P& b( M+ f" X0 u6 t0 X* K
431.   (setq e1(ssget pt))
     
432.   (setq e2 (entget (ssname e1 0)))
     
433.   (setq blname (cdr(assoc 2 e2)))
     0 P3 q/ \7 x. s/ m& G9 I. I
434.   (setq oer *error* *error* err2)(command ".insert" blname))
     
435. 
     ; i( [: s4 E" @6 I0 D; X- t
436. (defun c:II ()
     ; q$ B! o+ ~9 \7 |
437.     (setvar "cmdecho" 0)
     , M( ~' o. E+ m7 `" R
438.     (setq olderr *error* *error* myerror)
     
439.     (prompt "\nSelect objects: ")
     
440.     (command "select" "au" pause)
     2 T' |2 s  D) _* C3 S
441.     (setq sstxt (ssget "p")
     ; L- w4 I! q3 Z: _7 N/ u
442.           sslen (sslength sstxt)
     
443.           ctr 0
     
444.     )
     
445.     (command ".undo" "mark")
     , j7 X) B* q/ o$ X
446.     (while (< ctr sslen)
     
447.            (setq listxt (entget (ssname sstxt ctr))
     
448.                  txttxt (cdr (assoc 1 listxt))
     
449.                  enttxt (cdr (assoc 0 listxt))
     3 p, c1 P4 X( C' y& a* f+ a
450.            )
     . C" k! Q( V% M* {2 Z
451.            (if (= enttxt "TEXT")
     7 e0 h/ b6 w! J* }# h
452.                (progn
     % t0 W# s1 \; S$ i
453.                    (setq testxt (substr txttxt 1 3))
     5 y: [( r  o3 I. J7 U3 M4 |
454.                    (if (or (= testxt "%%C") (= testxt "%%C"))
     
455.                        (setq newtxt (substr txttxt 4))
     
456.                        (setq newtxt (strcat "%%C" txttxt))
     ( I# y7 Y0 [) D+ Q8 x
457.                    )
     
458.                    (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
     ( H, O% X" @+ F% T4 p0 u7 [! A% t
459.                    (entmod listxt)
     
460.                 )
     & z6 O8 g" S( \6 G; P+ P! I
461.             )
     
462.             (setq ctr (1+ ctr))
     ! A2 ~+ c; ^/ h4 x' U; `3 u. G2 n
463.     )
     
464.     (setq *error* olderr)
     6 h, o/ u8 a- F" C
465.     (setvar "cmdecho" 1)
     
466.     (princ)
     . X0 ~9 ~. x& n: A/ Z6 P& P
467. )
     . Y( A, X5 P' r: }) w  Q9 {
468. 
     
469. (defun c:DG ()
     " I, n5 l3 ^1 K( y1 _9 W
470.     (setvar "cmdecho" 0)
     + H% @; w0 W5 _% n" M
471.     (setq olderr *error* *error* myerror)
     - M" N- w8 Z/ P$ `4 P
472.     (prompt "\nSelect objects: ")
     " E" }. r' k& B1 {- k6 n; }5 `2 L
473.     (command "select" "au" pause)
     5 a% p1 ]# d1 t7 T  p7 K
474.     (setq sstxt (ssget "p")
     ) N  s9 B% Q* P6 F
475.           sslen (sslength sstxt)
     8 i& V, f: W" J9 R- q6 }
476.           ctr 0
     
477.     )
     
478.     (command ".undo" "mark")
     
479.     (while (< ctr sslen)
     
480.            (setq listxt (entget (ssname sstxt ctr))
     & Q6 A( |9 T( ^# `
481.                  txttxt (cdr (assoc 1 listxt))
     1 p1 m8 D6 I5 m* s" Z7 ~, f
482.                  enttxt (cdr (assoc 0 listxt))
     
483.            )
     , L) ?, k$ \* x; J9 y
484.            (if (= enttxt "TEXT")
     $ o! J% K$ w- L! D* W; Q% s7 U
485.                (progn
     
486.                    (setq testxt (substr txttxt 1 3))
     , p1 t8 M1 q# l7 v
487.                    (if (or (= testxt "%%d") (= testxt "%%d"))
     
488.                        (setq newtxt (substr txttxt 4))
     4 K6 h3 I6 L( F9 k' p
489.                        (setq newtxt (strcat txttxt "%%dC" ))
     
490.                    )
     ' M3 E- |8 x! a$ d' ~2 w. @$ o
491.                    (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
     9 q! o" U$ C; W" i5 r: ~# ~
492.                    (entmod listxt)
     
493.                 )
     3 o2 q- _  w3 W1 a' m1 P
494.             )
     # X  M3 R- l  i  _8 W( e
495.             (setq ctr (1+ ctr))
     
496.     )
     2 ^; ?8 M; o+ w# W: r1 b+ R: y
497.     (setq *error* olderr)
     % v' W7 h& i% ~( n
498.     (setvar "cmdecho" 1)
     1 {' I" t: q3 n4 C
499.     (princ)
     
500. )
     
501. 
     
502. (defun c:PI ()
     * u5 G$ j: D, Y+ T0 G
503.     (setvar "cmdecho" 0)
     
504.     (setq olderr *error* *error* myerror)
     
505.     (prompt "\nSelect objects: ")
     5 F6 S* a' N( K0 R3 C; _
506.     (command "select" "au" pause)
     
507.     (setq sstxt (ssget "p")
     
508.           sslen (sslength sstxt)
     1 O& |7 Z" N1 L- d. d5 i" S  q5 q
509.           ctr 0
     $ c* ^* G- T' E( i& g. Z9 J$ z
510.     )
     
511.     (command ".undo" "mark")
     
512.     (while (< ctr sslen)
     
513.            (setq listxt (entget (ssname sstxt ctr))
     
514.                  txttxt (cdr (assoc 1 listxt))
     
515.                  enttxt (cdr (assoc 0 listxt))
     # S& Y% y3 A" p
516.            )
     , G; b3 D) P( {* h% j
517.            (if (= enttxt "TEXT")
     
518.                (progn
     9 b: D8 x& X! j5 `
519.                    (setq testxt (substr txttxt 1 3))
     $ d1 O% v1 V1 E: ?6 m6 Z1 U) s* Y
520.                    (if (or (= testxt "%%p") (= testxt "%%p"))
     
521.                        (setq newtxt (substr txttxt 4))
     
522.                        (setq newtxt (strcat "%%p" txttxt))
     
523.                    )
     
524.                    (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
     
525.                    (entmod listxt)
     
526.                 )
     
527.             )
     
528.             (setq ctr (1+ ctr))
     
529.     )
     ; j3 X9 x2 M4 ^  j3 M2 c
530.     (setq *error* olderr)
     
531.     (setvar "cmdecho" 1)
     
532.     (princ)
     3 A) \! @% q" {+ I
533. )
     
534. 
     
535. (Defun c:CB (/ a)
     
536.    (setq olderr *error* *error* myerror)
     7 q& G! n/ ]# W3 |2 o
537.    (setq ocmd (getvar "cmdecho"))
     ' ]4 D2 f+ [! f0 K
538.    (setq oblp (getvar "blipmode"))
     
539.    (setvar "cmdecho" 0)
     4 D* z! A% u! k
540.    (setq a (ssget))
     0 l2 V0 D4 P8 B4 [% l
541.    (command "CHPROP" a "" "C" "bylayer" "")
     
542.    (setvar "cmdecho" ocmd)
     
543.    (setvar "blipmode" oblp)
     
544.    (setq *error* olderr)
     
545.    (princ)
     " P9 d* t9 E3 B% G
546. )
     : {6 i( |) ~8 ?+ v# e2 J& h
547. 
     
548. (defun c:LCC (/ co43 obj23 la23)
     8 P1 [$ V3 i, v
549.    (setvar "cmdecho" 0)
     
550.    (setq co43 (getstring "\nNew color : "))
     
551.    (setq obj23 (car (entsel "\nPick object on desired layer: ")))
     
552.    (if obj23 (progn
     . f; u+ |+ `4 D7 G# ^
553.              (setq obj23 (entget obj23))
     
554.              (setq la23 (cdr (assoc 8 obj23)))
     ; ?. J8 A; A* ]# o/ H
555.              (command "layer" "c" co43 la23 "")
     
556.           )
     $ g2 j6 ]- t) A* l$ A0 P7 m3 F* X
557.     )
     * Y! Q/ X7 |4 U9 T
558.    (prompt (strcat  "\nLayer has changed..." la23))
     # w; r& Y) s$ ^* A4 d8 K
559.    (setvar "cmdecho" 1)
     9 h0 J3 w5 e  d+ M7 y3 |
560.    (princ)
     
561. )  
     ) T3 t% P% H6 f# S/ N
562. 
     ' Y, x( _9 S* P) D: u
563. (Defun c:RP (/ a)
     2 m) n% V- J7 O8 _' ^4 u: c* g* g% S
564.    (setq olderr *error* *error* myerror)
     * D1 k% S# e- u* m" f) ]
565.    (setq ocmd (getvar "cmdecho"))
     6 C+ \! \, o6 w) s
566.    (setq oblp (getvar "blipmode"))
     
567.    (setvar "cmdecho" 0)
     & p& P& M( g9 y
568.    (prompt (strcat "\nUSE: Delete object(s) belonging to"
     
569.                    " the layer of the entity picked...!"))
     7 W  Z  y" f/ p5 d! J+ O
570.    (setq a (entsel "\nPick the entity with the desired layer to delete: "))
     
571.    (if (/= a nil)
     ; @0 C0 G8 F; f% l
572.       (progn (setq a (cdr (assoc 8 (entget (car a )))))
     " K  @' t% C1 ?6 T
573.       (command "Erase" (ssget "x" (cons (cons 8 (eval a)) tempword)) ""))
     % u0 _! @. }2 Y! B# u
574.       (prompt "\nNo entity selected!"))
     
575.    (setvar "cmdecho" ocmd)
     " l8 J4 W7 p8 ]' W5 q+ @
576.    (setvar "blipmode" oblp)
     
577.    (setq *error* olderr)
     
578.    (princ)
     
579. )
     ' ?  @/ u) b# }! l7 Y, _
580. 
     
581. (DEFUN C:WL(/ SSET NET SSL M)
     
582.    (PRINC "\nSelect lines :")
     
583.    (SETQ SSET (SSGET))
     
584.    (IF (/= NIL SSET) (PROGN
     , w; n( a- c2 c
585.    (SETQ SSL (SSLENGTH SSET))
     
586.    (INITGET 4)
       a/ G. B: A7 D" N$ |* m* G
587.    (SETQ NET (GETREAL "New width : "))
     $ j$ @, u) t5 p
588.    (IF (/= NIL NET)
     ( }- @+ X, [/ i0 Y
589.     (WHILE (> SSL 0)
     
590.       (SETQ M (SSNAME SSET (SETQ SSL (- SSL 1)) ))
     
591.       (IF (= (CDR (ASSOC '0 (ENTGET M))) "LINE")
     & o% i5 J( `5 y3 _/ T/ p
592.           (COMMAND "PEDIT" M "Y" "W" NET "")
     
593.       )
     
594.     )
     
595.    )))
     
596.    (PRINC)
     7 U1 I1 R- h2 A- }6 }' ~
597. )
     
598. 
     9 i: g1 ?" W; H9 {2 Y
599. (defun C:MML ()
     
600.   (princ "\nSelect objects to move to another Layer.")
     
601.   (setq ss (ssget))
     
602.   (SETQ UL1(GETSTRING "\nLayer to move entities to : "))
     / V: y, Z" i: Y
603.   (setq counter 0)
     
604.   (prompt "Moving to layer.....")(princ ul1)
     . v2 E( t7 w$ g9 J/ h! P- g
605.   (setq e (ssname ss counter))
     + ]9 w: G, S' y/ p4 q
606.   (setq l (cdr (assoc 8 (entget e))))
     ( ^0 }6 t: w4 e; Y
607.   (setq S (ssget "X" (list (cons 8 l))))
     0 e/ L# V( Z! g. o; M0 ^) p& T
608.   (command "CHANGE" ss "" "P" "LA" UL1 "")
     & o( a/ `+ n" a/ _* }( |
609.   (setq counter (+ counter 1))
     . {% {. e' b3 ?8 B7 u& T
610. (princ)
     
611. )
     - ~6 x/ V, W7 x+ Z" Q+ B& v* m; d
612. 
     " J1 B# D/ u+ ]! R3 m
613. ;;; ================================ GHI CHU ============================
     
614. ;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
     " z- s( q3 T8 R: N+ g6 \  t
615. ;;; =======================Thuong Dung Font Romant.vnh===================
     
616. 
     
617. (defun c:RS (/ pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
     
618.   (setq oer *error* *error* err2)
     3 Z  v  S# D! H  ]8 j$ W
619.   (PROMPT "\n(UNICODE-Verdana)(D)ining room. (S)torage. c(L)oset. (C)onference. (O)ffice. (K)itchen. (B)ath. (M)aster Bedroom. ")
     
620.   (SETQ Cpt(GETSTRING "\n (ROMANT-vnh)(DD).(SS).(LL).(CC).(OW).(KK).(BB).(MM). (UNKNOWN-font)(oD).(oS).(oL).(oC).(oww).(oK).(oB).(oM)."))
     + s! b! I; X/ @* e1 ]
621.   (IF(OR(= Cpt "K")(= cpt "k"))(SETQ CPT ' "Nha`  Bê´p"))
     
622.   (IF(OR(= cpt "B")(= cpt "b"))(SETQ CPT ' "Pho`ng Vê? Sinh"))
     ; V9 O- N' ^3 P* B( H
623.   (IF(OR(= cpt "C")(= cpt "c"))(SETQ CPT ' "Pho`ng  Ho?p"))
     9 m. X# s- D8 P4 a: C) c
624.   (IF(OR(= cpt "O")(= cpt "o"))(SETQ CPT ' "Pho`ng La`m Viê?c"))
     
625.   (IF(OR(= cpt "M")(= cpt "m"))(SETQ CPT ' "Pho`ng Ngu?"))
     
626.   (IF(OR(= cpt "D")(= cpt "d"))(SETQ CPT ' "Pho`ng Bê´p + An"))
     ' |4 S! i* x5 v+ W$ m
627.   (IF(OR(= cpt "S")(= cpt "s"))(SETQ CPT ' "Nha`  Kho"))
     
628.   (IF(OR(= cpt "L")(= cpt "l"))(SETQ CPT ' "Pho`ng Ðê? Ðô`"))
     
629. 
     ( H6 I/ a5 Q- q* [4 n$ A
630.   (IF(OR(= Cpt "KK")(= cpt "kk"))(SETQ CPT ' "Nhµ BÕp"))
     - K( S3 q7 a5 H
631.   (IF(OR(= cpt "BB")(= cpt "bb"))(SETQ CPT ' "Phßng VÖ Sinh"))
     2 k) e/ W! x0 H' o2 p
632.   (IF(OR(= cpt "CC")(= cpt "cc"))(SETQ CPT ' "Phßng Häp"))
       a. V$ Q/ E$ N/ `5 H
633.   (IF(OR(= cpt "OW")(= cpt "ow"))(SETQ CPT ' "Phßng Lµm ViÖc"))
     6 q% E8 Q; z* S% R+ v7 B9 W* s
634.   (IF(OR(= cpt "MM")(= cpt "mm"))(SETQ CPT ' "Phßng Ngñ"))
     2 [9 l6 Q: X, @& Z3 q
635.   (IF(OR(= cpt "DD")(= cpt "dd"))(SETQ CPT ' "Phßng BÕp-¡n"))
     
636.   (IF(OR(= cpt "SS")(= cpt "ss"))(SETQ CPT ' "Nhµ Kho"))
     ' s. h" y2 Q1 |% e! y' ^
637.   (IF(OR(= cpt "LL")(= cpt "ll"))(SETQ CPT ' "Phßng §Ó §å"))
     : W5 ]6 Q+ C: y2 r  u
638. 
     2 Y; O% Z5 N* ?/ ]) ?4 ]8 }
639.   (IF(OR(= Cpt "oK")(= cpt "ok"))(SETQ CPT '"NHA/F BE/M/SP"))
     
640.   (IF(OR(= cpt "oB")(= cpt "ob"))(SETQ CPT '"PHO/F/NG TA/W/SM"))
     
641.   (IF(OR(= cpt "oC")(= cpt "oc"))(SETQ CPT '"PHO/FNG HO/JP"))
     , U( O5 k$ n3 ~! D2 }* y' A
642.   (IF(OR(= cpt "oww")(= cpt "oww"))(SETQ CPT '"P.LA/FM VI/E/M/JC"))
     
643.   (IF(OR(= cpt "oM")(= cpt "om"))(SETQ CPT '"PHO/FNG NGU/R"))
     7 [) h) J. Z: \" a+ p, _3 ]* Z1 ?2 V
644.   (IF(OR(= cpt "oD")(= cpt "od"))(SETQ CPT '"PHO/FNG A/WN"))
     : X* N0 @1 L3 ?8 X
645.   (IF(OR(= cpt "oS")(= cpt "os"))(SETQ CPT '"NHA/F KHO"))
     
646.   (IF(OR(= cpt "oL")(= cpt "ol"))(SETQ CPT '"PHO/FNG /DO/M/F"))
     8 e  I4 B6 L  h
647. (setq pta (getpoint
     2 I8 E5 f8 M$ W: z: v  ^( i
648.     "\nPick first corner. : "))
     
649.   (setq ptb (getcorner pta
     . z* F4 t# J5 y6 h/ z
650.     "\nPick second corner. : "))
     $ j9 T0 O- w+ l! |% ?% b3 d
651.   (setq ptc (list (car ptb)(cadr pta)))
     
652.   (setq ptd (list (car pta)(cadr ptb)))
     
653.   (setq ang (angle pta ptb))
     
654.   (setq d1 (/(distance pta ptb) 2))
     ) {5 v4 w& o* M  |
655.   (setq cp (polar pta (- ang (dtr 0)) d1))
     " x  t5 ?( a' E
656.   (setq X (distance pta ptc))
     
657.   (setq Y (distance pta ptd))
     
658.   (setq X1 (rtos x 2 1))
     / S: z1 ]# M; _- y* B; m
659.   (setq Y1 (rtos y 2 1))
     
660.   (setq rmsz (strcat "(" X1 " x " Y1 ")"))
     
661.   (command "TEXT" "c" cp "0" CPT "ROMANT-TEXT" "" rmsz))
     . g6 w  ]% R5 K4 [
662.   (defun dtr (angg)
     1 L, \, }4 r: A4 \/ Q
663.   (* pi (/ angg 180.0)))
     
664. 
     4 H+ @* W6 N" G3 u1 e7 [
665. (defun c:WS (/ pta ptb rmsz pl1)
     
666.   (setq oer *error* *error* err2)
     
667.   (PROMPT "\n (RomanT.TXT)floorp(L)an.(E)levation.(S)ection.(M)planFoundation.(C)Found.(K).(P).")
     ( K. b- l% G" u
668.   (SETQ Cpt(GETSTRING "\n (VnHELVH.Vnh)(LL)floorplan.(EE)elevation.(SS)section.(BM)planFoundation.(CM)foundation.(KC)Structure.(PP)perspective."))
     
669. 
     
670.   (IF(OR(= Cpt "LL")(= cpt "ll"))(SETQ CPT ' "MÆt B»ng TÇng 1 : TØ LÖ - 1:100"))
     4 k* b+ d  o1 S) S' v# g) T5 b
671.   (IF(OR(= cpt "EE")(= cpt "ee"))(SETQ CPT ' "MÆt §øng Trôc ?-? : TØ LÖ - 1:100"))
     % q; g' R  K1 F1 N; F
672.   (IF(OR(= cpt "SS")(= cpt "ss"))(SETQ CPT ' "MÆt C¾t A-A : TØ LÖ - 1:100"))
     ) n8 g  l- A, B! W$ L3 s& y
673.   (IF(OR(= cpt "BM")(= cpt "bm"))(SETQ CPT ' "MÆt B»ng Mãng : TØ LÖ - 1 : 100"))
     9 s! O$ u$ _) Q+ h8 h5 p
674.   (IF(OR(= cpt "CM")(= cpt "cm"))(SETQ CPT ' "MÆt C¾t Mãng : TØ LÖ - 1 : 100"))
     , a8 z# ~0 W/ d7 A. |
675.   (IF(OR(= cpt "KC")(= cpt "kc"))(SETQ CPT ' "KÕt CÊu Khung Däc Nhµ : TØ LÖ - 1 : 100"))
     
676.   (IF(OR(= cpt "PP")(= cpt "pp"))(SETQ CPT ' "Phèi C¶nh Mét Gãc Nh×n"))
     
677. 
     4 [- h: o0 d- Y# M
678.   (IF(OR(= Cpt "L")(= cpt "l"))(SETQ CPT '"MA/W/JT BA/W/FNG TA/M/FNG 1 : TI/R LE/M/J - 1:100"))
     
679.   (IF(OR(= cpt "E")(= cpt "e"))(SETQ CPT '"MA/W/JT /D/}/SNG TRU/JC ?-? : TI/R LE/M/J - 1:100"))
       @3 `+ F! D' [  e7 ~
680.   (IF(OR(= cpt "S")(= cpt "s"))(SETQ CPT '"MA/W/JT CA/W/ST A-A TI/R : LE/M/J - 1:100"))
     
681.   (IF(OR(= Cpt "M")(= cpt "m"))(SETQ CPT '"MA/W/JT BA/W/FNG MO/SNG : TI/R LE/M/J - 1:100"))
     
682.   (IF(OR(= Cpt "C")(= cpt "c"))(SETQ CPT '"MA/W/JT CA/W/ST MO/SNG : TI/R LE/M/J - 1:100"))
     + D1 ]7 F$ r& j+ u- h
683.   (IF(OR(= Cpt "K")(= cpt "k"))(SETQ CPT '"KE/M/S/T CA/M/SU KHUNG DO/JC NHA/F : TI/R LE/M/J - 1:100"))
     
684.   (IF(OR(= cpt "P")(= cpt "p"))(SETQ CPT '"PHO/M/SI CA/R/NH MO/M/JT GO/SC NHI/FN"))
     
685. (setq pta (getpoint
     
686.     "\nPick first corner. : "))
     
687.   (setq ptb (getcorner pta
     
688.     "\nPick second corner. : "))
     
689.   (setq ptc (list (car ptb)(cadr pta)))
     $ L. `3 V4 y1 v3 w, u
690.   (setq ptd (list (car pta)(cadr ptb)))
     $ Y* p6 ?( o5 ]& f" l, S2 h8 i1 r
691.   (setq ang (angle pta ptb))
     % X: ~& r' ?* v/ `
692.   (setq d1 (/(distance pta ptb) 2))
       T6 b5 z  o; n; r6 M
693.   (setq cp (polar pta (- ang (dtr 0)) d1))
     ; m1 o: B8 J/ [8 U, r
694.   (command "TEXT" "c" cp "0" CPT "ROMANT-TEXT" "" rmsz))
     
695.   (defun dtr (angg)
     
696.   (* pi (/ angg 180.0)))
     
697. 
     3 _& }/ ^9 Q, m! T! M* R% `1 K8 Z
698. ;;; ================================ GHI CHU ============================
     
699. ;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
     
700. ;;; =======================Thuong Dung Font Romant.vnh===================
     
701. 
     
702. (defun c:RRS (/ pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
     
703.   (setq oer *error* *error* err2)
     
704.   (PROMPT "\n(D)ining room. (S)torage. c(L)oset. (C)onference. (O)ffice. (K)itchen. (B)ath. ")
     
705.   (SETQ Cpt(GETSTRING "\n(M)aster Bedroom. (DD). (SS). (LL). (CC). (OO). (KK). (BB). (MM). "))
     ) P2 W! S& s0 \4 K( r; ~/ \
706.   (IF(OR(= Cpt "K")(= cpt "k"))(SETQ CPT ' "Nhà B?p"))
     * m2 u  b9 `% \( b$ X7 t
707.   (IF(OR(= cpt "B")(= cpt "b"))(SETQ CPT ' "Phòng T?m"))
     5 d( T  q' ]& n, r
708.   (IF(OR(= cpt "C")(= cpt "c"))(SETQ CPT ' "Nhà H?p"))
     
709.   (IF(OR(= cpt "O")(= cpt "o"))(SETQ CPT ' "Phòng Làm Vi?c"))
     
710.   (IF(OR(= cpt "M")(= cpt "m"))(SETQ CPT ' "Phòng Ng?"))
     
711.   (IF(OR(= cpt "D")(= cpt "d"))(SETQ CPT ' "Phòng B?p-An"))
     
712.   (IF(OR(= cpt "S")(= cpt "s"))(SETQ CPT ' "Nhà Kho"))
     
713.   (IF(OR(= cpt "L")(= cpt "l"))(SETQ CPT ' "Phòng d? Ð?"))
     . _! J+ f& o9 I1 S' q+ X
714.   (IF(OR(= Cpt "KK")(= cpt "kk"))(SETQ CPT ' "Nhµ BÕp"))
     
715.   (IF(OR(= cpt "BB")(= cpt "bb"))(SETQ CPT ' "Phßng VÖ Sinh"))
     
716.   (IF(OR(= cpt "CC")(= cpt "cc"))(SETQ CPT ' "Phßng Häp"))
     0 C( h# h. a$ J2 P* y, I
717.   (IF(OR(= cpt "OO")(= cpt "oo"))(SETQ CPT ' "Phßng Lµm ViÖc"))
     
718.   (IF(OR(= cpt "MM")(= cpt "mm"))(SETQ CPT ' "Phßng Ngñ"))
     " |* i3 [+ I$ W0 z6 T
719.   (IF(OR(= cpt "DD")(= cpt "dd"))(SETQ CPT ' "Phßng BÕp-¡n"))
     
720.   (IF(OR(= cpt "SS")(= cpt "ss"))(SETQ CPT ' "Nhµ Kho"))
     
721.   (IF(OR(= cpt "LL")(= cpt "ll"))(SETQ CPT ' "Phßng §Ó §å"))
     5 Y1 Q. L; j" {8 p' Q/ Q2 f/ _' T
722. (setq pta (getpoint
     
723.     "\nPick first corner. : "))
     9 E7 o/ v) c* j. K5 j& t2 z& A5 F; R
724.   (setq ptb (getcorner pta
     + ]4 l4 i" S* N6 D3 J
725.     "\nPick second corner. : "))
     . Z9 [0 T' i) j; W6 _
726.   (setq ptc (list (car ptb)(cadr pta)))
     , h- u) ^/ M9 a+ h9 h+ w+ `# y
727.   (setq ptd (list (car pta)(cadr ptb)))
     5 R( q, g' G0 X
728.   (setq ang (angle pta ptb))
     $ t+ J8 Q5 @) X- f" X9 y- m
729.   (setq d1 (/(distance pta ptb) 2))
     / a1 d+ U+ ]8 |$ L* K
730.   (setq cp (polar pta (- ang (dtr 0)) d1))
     
731.   (setq X (distance pta ptc))
     3 ]! ~8 _5 h8 \1 @' C8 N
732.   (setq Y (distance pta ptd))
     " J* K0 P7 i( C; b9 ]4 d; v
733.   (setq X1 (rtos x 2 1))
     
734.   (setq Y1 (rtos y 2 1))
     ( f* g6 Q' `3 X
735.   (setq rmsz (strcat "(" X1 " x " Y1 ")"))
     * b+ y  S7 A" k; q6 z
736.   (command "TEXT" "c" cp "0" CPT "text" "" rmsz))
     
737.   (defun dtr (angg)
     / n/ n! |4 b& @! d: s# y. g$ I9 Y
738.   (* pi (/ angg 180.0)))
     ) N0 P2 A5 d. [4 x/ p7 y
739. 
     ( N$ f: _9 A6 F* I: [* G7 M4 G
740. ;;; ================================ GHI CHU ============================
     
741. ;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
     
742. ;;; =======================Thuong Dung Font Romant.vnh===================
     / ]- T- H/ m7 ^$ t8 M
743. 
     + d0 O$ T, Z+ D: ?* |9 X7 c
744. (defun c:GS (/ a b c d)
     / W+ Z: F# @# Z' n
745.   (graphscr)
     
746.   (prompt "\nSelect text to set style....")
     
747.   (setq a (entsel))
     
748.   (setq b (entget (car a)))
     
749.   (setq c (cdr (assoc 7 b)))
     
750.   (setq d (cdr (assoc 40 b)))
     0 ?  k; w) w% |3 p5 _* _  L" n- D
751.   (command "style" c "" d "" "" "" ""))
     
752.   (princ "\nType GS to set text style.")
     & g+ H# V1 ]/ |8 y$ E
753. 
     
754. (defun c:RC (/ olderr ocmd oblp pt1 pt2 pt3 pt4 l w)
     8 C, ?1 p3 U' A
755.   (setq olderr *error* *error* myerror)
     
756.   (setq ocmd (getvar "cmdecho"))
     
757.   (setq oblp (getvar "blipmode"))
     
758.   (setvar "cmdecho" 0)
     0 c4 S  u1 y% \, s" G' [# m
759.   (initget 1)                         ;3D point can't be null
     . S/ F$ o" i- k' F
760.   (Setq pt1 (getpoint (strcat "\nCorner of rectangle or square: ")))
     6 f6 v3 r% L  W. E+ m; `
761.   (setvar "ORTHOMODE" 1)
     8 {: S9 V0 N! Q6 m
762.   (initget 7)                         ;Length can't be 0, neg, or null
     
763.   (Setq l (getdist pt1 "\nLength: "))
     
764.   (Setq pt2 (list (+ (car pt1) l) (cadr pt1) (caddr pt1)))
     
765.   (grdraw pt1 pt2 2)
     
766.   (initget 7 "Square")                ;Width can't be 0, neg, or null
     0 d8 g* _6 Z& [, v5 D' c) B* ^
767.   (setq w (getdist pt1 "\nSquare/<Width>: "))
     4 }( H4 f$ o+ }3 x; }3 v6 ~8 y4 B
768.   (if (= w "Square")
     2 V; j5 b3 P# |# o6 W& B8 K
769.       (setq w l)
     7 ~: a  Q% ]: r& `5 \
770.   )
     * L! W% G- V+ ?) I% J0 \" x9 ]
771.   (setq pt3 (list (car pt2) (+ (cadr pt2) w) (caddr pt2)))
     
772.   (setq pt4 (list (car pt1) (+ (cadr pt1) w) (caddr pt1)))
     + Q+ t: M7 p) W, o5 X
773.   (grdraw pt2 pt3 2)
     ( [- V4 `" Y* {5 S- }/ ~. R
774.   (grdraw pt3 pt4 2)
     * p# _( P% N2 w! H$ Y
775.   (grdraw pt4 pt1 2)
     
776.   (setvar "ORTHOMODE" 0)
     ( _! c5 C$ v9 W2 q" O5 O/ p
777.   (command "pline"  pt1 pt2 pt3 pt4 "close")
     
778.   (setvar "cmdecho" ocmd)
     
779.   (setvar "blipmode" oblp)
     + I8 }: S. r. K& E. l) X8 h0 e
780.   (setq *error* olderr)               ; Restore old *error* handler
     . Q- c! x, R+ j3 r
781.   (princ)
     
782. )
     
783. 
     
784. (defun c:SG (/ ent pt1 pt2 ang)
     / n: E" p3 v- h
785.   (setq cmd (getvar "cmdecho"))
     4 T2 J4 i" _3 v
786.   (setvar "cmdecho" 1)
     
787.   (prompt (strcat"\nSnap angle will be set to angle of line"))
     
788.   (setq ent (entget (car (entsel))))
     
789.   (setq pt1 (cdr (assoc 10 ent)))
     7 A% K* D+ k: K/ P$ z# k5 ^9 z) ~, V
790.   (setq pt2 (cdr (assoc 11 ent)))
     
791.   (setq ang (angle pt1 pt2))
     
792.   (setq ang (/ (* ang 180.0) pi))
     4 z# `- h# Y+ S, U; m0 K; Q
793.   (setvar "cmdecho" 0)
     4 ^5 O# o$ v# K
794.     (command "setvar" "snapang" ang)
     
795.     (setvar "cmdecho" cmd)
     
796. )
     : i( f: p, @6 Z( T
797. 
     * J6 _+ c" |9 P  M; I. y" ^, ^
798. (defun C:TG ()
     # a/ a, y  i7 Z. r
799.   (initget "Increase New")
     ! ?2 c' d. G1 O/ h# k4 Q
800.   (setq ans (getkword "Increase/<New>: "))
     
801.   (modang)
     
802. )
     8 `0 ]0 ?% u$ l- H
803. (defun modang (/ ang ss ca e na ssl)
     ) @* z5 h7 K5 }, f, R
804. (if (= ans "Increase")
     9 ]' Y- m4 j& F8 C9 H; G
805.      (princ "\nIncrease angle for text by: ")
     8 T; z7 i+ L9 `6 w: A( j
806.      (princ "\nNew angle for text: ")
     1 c7 h/ d* q" h
807. )
     
808. (setq ang (getreal))
     , i" E1 l6 b- _1 I, j- u
809. (setq ang (* (/ ang 180) pi))
     
810. (setq ss (ssget))
     9 n' O1 B- S. @8 U' j
811. (setq ca 0 ssl (sslength ss))
     . v# R" {5 z$ c; a
812. (while (< ca ssl)
     # R7 M2 p, v6 F8 J$ _
813.   (if (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname ss ca))))))
     & @+ l/ r2 m: Y# @1 ^
814.    (progn
     : L- w8 F$ Q+ E! d5 x
815.     (if (= ans "Increase")
     
816.         (setq na (cons 50 (+ (cdr (assoc 50 e)) ang)))
     
817.         (setq na (cons 50 ang))
     + p% r9 H- @( q0 h7 s+ a
818.     )
     $ J, m. x3 [3 N2 V
819.     (setq e (subst na (assoc 50 e) e))
     3 W" A4 C6 n# ?5 v) R
820.     (entmod e)
     
821.   (setq ca (1+ ca))
     ( j7 Y* N. u& l* H5 G* P
822. )
     / ~, @, h+ t9 T. z$ u
823. )
     / j# B/ ]" I! ~( C; `
824. )
     
825. (terpri)
     
826. )
     
827. 
     
828. 
     1 P+ Q" a" W- d4 j, P
829. (defun c:WL ()
     
830.   (setvar "cmdecho" 0)
     ' H0 a5 K/ w# _3 U+ X
831.   (setq a 1)
     ! ]! P) i  c* {# g& F7 t- G
832.   (prompt "\nSelect Polylines to change: ")
     " w; h2 o) @: t; n: j
833.   (while (/= a nil)
     " u$ D5 G/ R) r6 s( S5 y$ P
834.     (progn
     : L# G/ u. q. P- V- j
835.     (setq a (entsel))
     8 o; N2 g. o1 E- ~
836.     (if (/= a nil)
     ; I  Z9 K! e  ^" c4 R$ j
837.         (progn
     3 ?: j9 z: g# `" e* @* U6 U! c3 s
838.           (setq b (entget (car a)))
     
839.           (setq c (cdr (assoc 40 b)))
     
840.           (princ c)
     % e0 Y5 a( Z5 n1 s6 z' Q/ K
841.           (command "pedit"a"w""lw""")
     0 \4 D2 f, p3 m5 y8 U
842.         ))))
     4 w9 C! k% ~4 A9 r$ J8 _4 V: }7 S
843.   (princ)
     4 O8 }  M( V) }1 w8 u, Z
844. )
     9 k" @) X: w* a4 y* D: r
845. 
     
846. ;;; ================================ TEXT FIT ============================
     
847. 
     + c& S+ ?) ]& x" u+ d/ X" G
848. (Defun c:FT ( )
     
849.   (defun setsnapang (arg /) (setvar "snapang" (angtof (angtos (cdr (assoc 50 arg)) 0 8) 0 ))  )
     
850.   (Defun LL-xyz (arg) (CAR (TextBox arg))  )
     + N# Q1 V3 I' t
851.   (Defun UR-x (arg) (CAADR (TextBox arg))  )
     
852.   (Defun LL-y (arg)     (CADAR (TextBox arg))  )
     2 o. X3 @0 B: @* i7 h
853.   (Defun LR-xy (arg)     (List (UR-x arg) (LL-y arg))  )
     
854.    (Setq ename (CAR (EntSel "\nSelect Text to stretch/shrink:"   )  )
     - l. D3 j' p" H5 N
855.       Textent (If ename (EntGet ename))   )   
     6 n, n% ^9 H# u! u+ [! p% u
856.    (If (= (CDR (Assoc 0 textent)) "TEXT")
     
857.       (Progn (initget 0 "Start")
     
858.          (Setq  NewEnd  (Distance  (LR-xy Textent) (LL-xyz Textent) ) )
     ! R% T7 r7 I6 Z
859.          (setsnapang Textent)                 ;set snap along text entity
     
860.          (setvar "ORTHOMODE" 1)                   ;drag along the text
     9 z3 ?4 G2 P' J% p1 J- G$ V
861.          (setq
     
862. TMP (getpoint (cdr (assoc 10 Textent)) "\nStarting Point/<Pick new ending point>: ") )
     
863.          (setvar "snapang" 0)
     . A) J) a6 r5 X/ j& d# a; o
864.          (cond
     # b9 k$ N6 Y; C2 t
865.            ((= (type TMP) 'STR) ;;new starting point to be selected
     2 h& w, E: p; Y4 N2 s7 U
866.                (setq Start (getpoint "\nPick new starting point: "))
     3 P) \5 Y9 i( I# H: t/ X; h
867.                (if Start  (progn
     # V& C- p9 x5 d
868.                   (command "_UCS" "_E" (cdr (assoc -1 textent)))
     
869.                   (setvar "ORTHOMODE" 1)
     
870.                   (setq NewPt
     
871.                         (if Start
     " l1 N! P4 R0 Y
872.           (getpoint (trans Start 0 1) " ending point: ") nil ) )
     
873.                   (if NewPt (setq NewPt (trans NewPt 1 0)))
     
874.                   (setvar "ORTHOMODE" 0)
     # Y1 C; q2 ]  R) o, v. A. W
875.                   (command "_UCS" "_W") ) ) )
     
876.            ((not (null TMP))    ;;new ending point selected
     " K) H9 N6 c1 Q( e
877.                (setq Start (cdr (assoc 10 Textent)) NewPt TMP)  )
     # W5 ~' j: U: s0 o. v: [
878.            (t  (setq Start nil NewPt nil) ) )
     0 R, g6 j' `* f; ~8 v. A2 e
879.          (if (and Start NewPt) (progn
     $ b) O' |  g% M, c
880.            (setq Val (Assoc 41 Textent) ;;current width factor
     9 r) R+ u  e% G/ C4 E5 Q7 P3 E
881.                  Val (if Val (cdr Val) 1.0)  LTC_%      
     $ ~" o. E) A( n0 X+ z
882.           (* (/ (Distance Start NewPt) NewEnd ) Val )
     
883.                  textent (Subst (cons 41 LTC_%)
     / }; x$ q3 p/ B7 D+ J
884.            (assoc 41 textent) textent)
     
885.   textent (subst (cons 10 Start) (assoc 10 textent) textent)
     * J+ ^) S9 n. n' n1 y
886.   textent (subst (cons 11 NewPt) (assoc 11 textent) textent) )
     
887.    (EntMod textent) (EntUpd (cdr (assoc -1 textent))))))) (Princ))
     * t# O' k3 O" N! W$ S
888. 
     8 U# r4 x& Q& h
889. ;=====================================================================
     * g% N. R) p) i+ L! F$ j: J! k
890. ;=========================COPY + ROTATE ==============================
     9 B- w0 A7 y; ^- p2 _
891. ;=====================================================================
     
892. 
     
893. (defun c:CR(/ olderr cm loop ss1 ss2 bp mult lent ss2 lp1 lp2)
     . F8 B" }9 g6 }7 S
894.   (setq olderr *error*
     ( L4 J2 X/ {+ s4 D- @- H
895.         *error* croerr)
     
896.   (setq cm (getvar "cmdecho"))
     
897.   (setvar "cmdecho" 0)
     4 y, O! S; g/ d6 ?
898.   (setq loop t)
     , h! c& O/ R" Y( _( G3 ?+ s, A
899.   (while (not (setq ss1 (ssget))))
     1 t  I9 N# n2 _: q$ \  p, R. E
900.   (initget 1 "Multiple")
     * a- e  k. P8 t3 s2 _0 C$ j
901.   (setq bp (getpoint "\nBase point or displacement>/Multiple: "))
     
902.   (if (= bp "Multiple")
     ( x; I# X: Z  v! p
903.     (progn
     % G2 V& V# ]% ]* B9 k8 \/ T
904.       (setq bp (getpoint "\nBase point: "))
     
905.       (setq mult t)
     
906.     )
     + B" [9 U. q( {- x
907.   )
     
908.   (while loop
     
909.     (setq loop mult)
     
910.     (setq lent (lastent))
     % B: H9 ^8 F. U0 w
911.     (command ".copy" ss1 "" bp bp)
     
912.     (setq ss2 (lss lent))
     . M" C7 E0 u5 C" T* s% H
913.     (setq lp1 (getvar "lastpoint"))
     
914.     (prompt "\nSecond point of displacement: ")
     8 u6 n$ x1 p+ r( G% _% N& |) ]" D
915.     (command ".move" ss2 "" bp pause)
     
916.     (setq lp2 (getvar "lastpoint"))
     
917.     (redss ss1)
     ; b/ y# ]! S1 q, v- w( H7 q7 B
918.     (if (and (not mult)
     + c1 |* T+ O0 p
919.              (= (distance lp1 lp2) 0)
     : V" G- i+ C# [8 ?
920.         )
     2 V' I8 L5 V5 V+ A0 o$ Z( Y. q
921.       (setq lp2 (getpoint "\nRotation Point: "))
     6 Y7 S* E; N$ X! V# ?; X3 O8 M- L
922.     )
     
923.     (if mult
     ) N" u2 Z, `( C; q& |
924.       (prompt "\nRotation angle ")
     
925.       (prompt "\nReference/<Rotation angle>: ")
     
926.     )
     5 u5 h. }0 n' e* t
927.     (command ".rotate" ss2 "" lp2 pause)
     
928.   )
     * U& t6 D& s$ @+ G; v; c# h
929.   (setvar "CMDECHO" cm)
     
930.   (setq *error* olderr)
     
931.   (princ)
     
932. )
     ' g3 T1 d7 a3 i2 m( m  Z
933. (princ)
     0 l  Q: R) C9 |# ^" _
934. (defun croerr (s)        
     9 T7 a+ n* o, A5 Z1 ?: s- T, {8 N5 M
935.   (if (/= s "Function cancelled")
     1 e, d0 l' o1 L
936.     (princ (strcat "\nError: " s))
     
937.   )
     
938.   (setq S nil)
     0 F7 h: Z1 {  y$ o- Z) v0 h
939.   (setvar "CMDECHO" cm)
     
940.   (setq *error* olderr)
     $ c8 Z+ N3 H2 q$ s' B
941.   (princ)
     
942. )
     
943. (defun lastent (/ a b)
     2 Q3 x2 L7 [' H, F
944.   (if (setq a (entlast))
     - K) U; b' z  R( u" s
945.     (while (setq b (entnext a))
     
946.       (setq a b)
     7 h" b, H0 R1 G8 y( Q% q
947.     )
     
948.   )
     
949.   a
     
950. )
     * @  d+ S: H- ?
951. (defun redss (ss / en i)
     
952.   (setq i 0)
     
953.   (while (setq en (ssname ss i))
     - T! {: a8 L( i
954.     (redraw en 1)
     
955.     (setq i (1+ i))
     
956.   )
     
957. )
     
958. (defun lss (en / sels ed)
     8 Q7 n9 ~' P# H" n0 f
959.   (setq sels (ssadd))
     
960.   (while (/= en nil)
       e& W+ p/ n. y
961.     (if (setq en (entnext en)) (setq ed (entget en)))
     4 p$ q/ i6 ]% s( V; a; j8 s
962.     (if (/= en nil) (setq sels (ssadd en sels)))
     
963.     (if (or (= (cdr (assoc 0 ed)) "Polyline")
     
964.             (= (cdr (assoc 0 ed)) "Insert")
     
965.         )
     ; w5 P; b5 }; e( z
966.       (while (/= (cdr (assoc 0 (entget (setq en (entnext en))))) "Seqend"))
     
967.     )
     5 S, i& |: `& F+ y
968.   )
     / Z8 x" h* B* ~8 L% f2 w
969.   sels
     . W, _6 Q# r* U3 Y. X
970. )
     3 {8 {0 T2 Q5 J3 t) A3 q2 g
971. 
     
972. ;;;; ================== CAC FUNCTIONS DUNG TRONG ACAD.LSP ==================
     8 ?2 L- D* U7 _( ~% n2 d
973. 
     - J, q  \7 E1 N3 B* I
974. (defun c:00 ()(princ "\nChon doi tuong net Defpoints")(ssget)(command "change" "p" "" "p" "la" "Defpoints" ""))
     % f" {" i" h7 T  m- y! `9 y1 H
975. (defun c:0 ()(princ "\nChon doi tuong net 0")(ssget)(command "change" "p" "" "p" "la" "0" ""))
     
976. (defun c:1 ()(princ "\nChon doi tuong net COT")(ssget)(command "change" "p" "" "p" "la" "COT" ""))
       ?/ d9 i" W$ I! _& k) e% z
977. (defun c:11 ()(princ "\nChon doi tuong net DIM")(ssget)(command "change" "p" "" "p" "la" "DIM" ""))
     
978. (defun c:22 ()(princ "\nChon doi tuong net MANH")(ssget)(command "change" "p" "" "p" "la" "MANH" ""))
     . V/ Z0 ?8 h6 _& L
979. (defun c:33 ()(princ "\nChon doi tuong net NETMANH")(ssget)(command "change" "p" "" "p" "la" "NETMANH" ""))
     
980. (defun c:2 ()(princ "\nChon doi tuong net NETDUT")(ssget)(command "change" "p" "" "p" "la" "NETDUT" ""))
     
981. (defun c:3 ()(princ "\nChon doi tuong net NOITHAT")(ssget)(command "change" "p" "" "p" "la" "NOITHAT" ""))
     3 J: ]5 w# @) }" ]
982. (defun c:4 ()(princ "\nChon doi tuong net TUONG")(ssget)(command "change" "p" "" "p" "la" "TUONG" ""))
     
983. (defun c:44 ()(princ "\nChon doi tuong net KHUNGTEN")(ssget)(command "change" "p" "" "p" "la" "KHUNGTEN" ""))
     
984. (defun c:5 ()(princ "\nChon doi tuong net TIMTUONG")(ssget)(command "change" "p" "" "p" "la" "TIMTUONG" ""))
     
985. (defun c:6 ()(princ "\nChon doi tuong net CUA")(ssget)(command "change" "p" "" "p" "la" "CUA" ""))
     3 g7 C3 s. n+ h
986. (defun c:7 ()(princ "\nChon doi tuong net THAY")(ssget)(command "change" "p" "" "p" "la" "THAY" ""))
     * E% [! x- B1 P2 R$ c( k
987. (defun c:77 ()(princ "\nChon doi tuong net NETTHAY")(ssget)(command "change" "p" "" "p" "la" "NETTHAY" ""))
     $ L$ o* @9 O4 k; ~, t
988. (defun c:8 ()(princ "\nChon doi tuong net HATCH")(ssget)(command "change" "p" "" "p" "la" "HATCH" ""))
     + n2 F& G* v% I, k- `
989. (defun c:9 ()(princ "\nChon doi tuong net TEXT")(ssget)(command "change" "p" "" "p" "la" "TEXT" ""))
     
990. (defun c:99 ()(princ "\nChon doi tuong net CUAMATDUNG")(ssget)(command "change" "p" "" "p" "la" "CUAMATDUNG" "p" "C" "bylayer" ""))
     
991. (defun c:td ()(princ "\nChon doi tuong net THEPDOC")(ssget)(command "change" "p" "" "p" "la" "THEPDOC" ""))
     % k) i' N( p3 k4 A. |) e
992. (defun c:ddt ()(princ "\nChon doi tuong net THEPDAI")(ssget)(command "change" "p" "" "p" "la" "THEPDAI" ""))
       C7 {8 R8 q# U; V0 i, `
993. 
     
994. ;=============== DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =============
     8 X  n- y7 n7 M& M& ^+ l1 K
995. 
     " ^( k1 O* G6 L5 L
996. ;=============== DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =============
     
997. 
     8 D" y* }) j) y& f' i
998. (alert "Using the NetXuatAnh-[ 5940.00 x 4200.00 <pixels> ] command!")
     % C# [$ z4 V. d+ f3 Q9 @
999. (princ "\nEnter (DEFUN C:netxuatanh () to get to real LAYER command.\n") (command "NETXUATANH")
     
1000. 
      
1001. ;=============== DAT LAYER NET de xuat anh JPG [W x H] [5940.00 x 4200.00] ===DRAW===
      
1002. 
      
1003. ;(DEFUN C:netxuatanh ()
      ! y  Y7 k! `; B0 G! G
1004.                  (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.6" "" "LT" "ACAD_ISO03W100" "" "" "LTSCALE" "5" ""
      
1005.                               "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "1.58" ""
      
1006.                                            "M" "MANH" "C" "9" "" "Lw" "0.5" ""
      
1007.                                        "M" "TEXT" "C" "7" "" "Lw" "0.5" ""
      7 L9 o: b! l* ^) F4 b1 u
1008.                                        "M" "DIM" "C" "1" "" "Lw" "0.6" ""
      + w2 P* q4 I: t1 m8 P$ F
1009.                                        "M" "THAY" "C" "7" "" "Lw" "0.7" ""
      
1010.                                        "M" "NOITHAT" "C" "3" "" "Lw" "0.5" ""
      
1011.                                        "M" "HATCH" "C" "5" "" "Lw" "0.35" ""
      . R3 z, @# a( D- v. N/ i/ j' W
1012.                                        "M" "COT" "C" "2" "" "Lw" "2" ""
      6 \( W3 K9 B* c8 P  F) n
1013.                                        "M" "Defpoints" "C" "7" ""
      
1014.                                        "M" "0" "C" "3" "" "Lw" "0.5" ""
      7 ]8 Y" H# n  N8 t6 b
1015. ;                                       "M" "1" "C" "1" "" "Lw" "0.5" ""
      ; {9 h5 `% M% ]: H6 e4 _8 b
1016. ;                                       "M" "2" "C" "31" "" "Lw" "0.5" ""
      + u4 ~' s5 ^. `4 h* |4 S: B. }
1017. ;                                       "M" "3" "C" "8" "" "Lw" "0.35" ""
      & v' |0 A4 E2 U. e, |
1018. ;                                       "M" "4" "C" "4" "" "Lw" "0.8" ""
      9 o6 O7 M/ O. _4 X4 s( k
1019. ;                                       "M" "6" "C" "6" "" "Lw" "0.35" ""
      9 J8 A8 v: ^3 t* \# g* X
1020. ;                                       "M" "7" "C" "7" "" "Lw" "0.4" ""
      8 X/ Z  c6 u$ Q% l% G$ d# r  p
1021. ;                                       "M" "8" "C" "8" "" "Lw" "0.35" ""
      
1022.                                        "M" "DAY-DIEN" "C" "3" "" "Lw" "0.5" ""
      1 ?  |4 b6 V: Z  s, x
1023.                                        "M" "DUONGBAO" "C" "7" "" "Lw" "1" ""
      0 \9 Z/ Z5 x7 w; E. E6 @7 W- t
1024.                                        "M" "KE" "C" "8" "" "Lw" "0.3" ""
      2 r) {6 ^7 d& Y. Y- T& f
1025.                                        "M" "KT" "C" "9" "" "Lw" "0.35" ""
      
1026.                                        "M" "NETTHAY" "C" "255" "" "Lw" "0.7" ""
      * R4 A9 p$ _5 H* H0 ?* j3 m9 d( g
1027.                                        "M" "NETMANH" "C" "43" "" "Lw" "0.5" ""
      % u1 b* b1 R6 A, U
1028.                                        "M" "TBD" "C" "2" "" "Lw" "0.8" ""
      7 Z; {7 c/ ~, H2 _# W4 a7 E& j
1029.                                        "M" "TEXTTXT" "C" "7" "" "Lw" "0.4" ""
      
1030.                                        "M" "TEXTVN" "C" "132" "" "Lw" "0.4" ""
      # h/ @+ K# D0 Y2 k! ]
1031.                                        "M" "THEPDAI" "C" "3" "" "Lw" "0.7" ""
      / Y- K7 w( M* L  M8 Q" }
1032.                                        "M" "THEPDOC" "C" "2" "" "Lw" "1.58" ""
      : I  f( p) N! ^1 c
1033.                                        "M" "CUA" "C" "6" "" "Lw" "0.5" ""
      
1034.                                        "M" "CUAMATDUNG" "C" "6" "" "Lw" "0.5" ""
      / X& z9 {0 X; a* R% F7 r
1035. 
      
1036. ;=============== DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] ===NUOC===
      1 |  T  F* S# i8 i# ?" e
1037. 
      $ i* z; E: P- P
1038.                                        "M" "10-VAN_KHOA" "C" "10" "" "Lw" "0.5" ""
      
1039.                                        "M" "4-WateR_IN" "C" "4" "" "Lw" "0.6" "" "LT" "FENCELINE1" ""
      
1040.                                        "M" "4-WateR_OUT" "C" "4" "" "Lw" "0.6" "" "LT" "FENCELINE2" ""
      
1041. ;                                       "M" "250" "C" "250" "" "Lw" "0.35" ""
      2 \/ ]" w$ d1 S/ T# J0 W
1042.                                        "M" "KHUNGTEN" "C" "4" "" "Lw" "1" ""
      + v' P! A1 I6 j% [  `; T& _- N
1043.                                        "M" "TIMTUONG" "C" "5" "" "Lw" "0.5" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "10" "" )
      
1044. 
      " H* E% p9 v  I. @4 v
1045. ;=============== DAT LAYER TEXT de xuat anh JPG [DIM] [TEXT] [GHI CHU]======
      , R1 `7 ~4 q' G
1046. ;===================================30|04|2024==============================
      
1047. 
      + U8 w  T- ~8 A- L! @7 L1 z' {; r0 t) C
1048.                      (Command "-style" "Vni-VietNam" "vn_vni,vns.shx" "0" "1" "0" "n" "n" "n" )
      
1049.                      (Command "-style" "Vni-ROMANS-TEXT" "vni-romans,vns.shx" "200" "1" "0" "n" "n" "n" )
      
1050.                      (Command "-style" "COTES" "verdana" "" "1" "0" "n" "n" )
      
1051.                      (Command "-style" "TRUC" "impact" "0" "1" "0" "n" "n" "n" )
      
1052.                      (Command "-style" "VNHELVLT-Hoa" "vnhelvh,vnh.shx" "500" "1""0" "n" "n" "n" )
      
1053.                      (Command "-style" "VNHELVLT-Thuong" "vnhelv,vnh.shx" "500""1" "0" "n" "n" "n" )
      # m) A0 t" R% Y/ n) l
1054.                      (Command "-style" "STANDARD" "Verdana" "200" "1" "0" "n" "n" "n" )
      
1055.                      (Command "-style" "VERDANA" "verdana" "200" "1" "0" "n" "n" )
      
1056.                      (Command "-style" "ROMANT-DIM" "romant,vnh.shx" "0" "1" "0" "n" "n" "n" )
      # `2 W/ m$ B9 U) w
1057.                      (Command "-style" "ROMANT-TEXT" "romant,vnh.shx" "200" "1" "0" "n" "n" "n" )(princ)
      5 G) Q3 [" G! T" @' Y6 H8 d1 Q
1058. 
      
1059. ;============= DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =DIM-STYLE=
      
1060. ;===================================17|10|2024===================================
      6 S+ a1 p$ I' j  K7 e
1061. 
      8 G+ f3 F# Z. L! w- {' h2 l# {
1062.                      (Command "DIMTXSTY" "ROMANT-DIM" )
      
1063.                      (Command "DIMBLK" "" "Closed" )
      3 `* i; {5 b, A- N$ P0 t
1064. 
      . @4 w2 `1 ^* ^
1065. ;============= DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =DIM-STYLE=
      
1066. ;===================================17|10|2024===================================
      
1067. 
      + y0 V; Y" z! X; {2 B& ^1 X
1068. ;(Command "-units" "2" "8" "1" "8" "" "N")
      
1069. (Command "-plot" "Y" "" "publishtoweb jpg.pc3" "User 1 (5940.00 x 4200.00 Pixels)" "Landscape" "N" "Display" "Fit" "Center" "Y" "monochrome.ctb" "Y" "")(princ)
      0 K8 K- m9 ^/ ^: x
1070. 
      
1071. ;============= DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =DIM-STYLE=
      : P) }) Y/ S# J  \8 C7 X- A5 |
1072. ;===================================17|10|2024===================================
      
1073. 
      
1074. ;======== KET THUC - DAT NET IN de xuat anh JPG [W x H] [5940.00 x 4200.00] =====
      
1075. 
      
1076. ;======================== DAT NET IN & TI LE BAN VE =============================
      4 p2 R' t- D% M6 ?# M9 a
1077. 
      
1078. ;=================LENH VE KHUNG TEN - Tieu Diet Lenh==================
      ( ^- u: W% T2 H
1079. ;=============== DAT KHO GIAY BAN VE - KIEU KHUNG TEN ================
      
1080. ;=============================11|07|2025==============================
      
1081. ;Ti Le Ban Ve - 1 : 100
      $ ^! z# Z& r8 F5 y/ q; z2 W
1082. (Defun c:kta4 ()
      2 f& q3 s0 |: D) d* p$ x* j8 |
1083.     (setq mv_sc 100);Ti le  ban ve
      
1084.       (setq x4  297)
      2 n+ j9 S9 d. |6 P/ h
1085.       (setq y4  210)
      7 z. i3 n$ `% r+ i, a, W$ p# F
1086.   (setq x4 (* mv_sc x4)
      
1087.         y4 (* mv_sc y4)  )
      
1088.   (command  
      2 E" A! x* o* z; s  \, p5 s$ `
1089.     "LIMITS" "0,0" (list x4 y4)
      
1090.     "PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
      
1091. ;Khung CHU NHAT Chinh   
      
1092.     "RECTANG" "500,500" "@28700,20000"
      
1093.     "RECTANG" "700,700" "@28300,19600"
      + j3 M  L5 R4 t# ^8 Z9 M3 j. G
1094. ;Khung Ten Chung
      
1095.     "RECTANG" "700,700" "@8000,1250"
      
1096.     "RECTANG" "700,700" "@17300,2500"
      
1097. ;Ten Ban Ve
      : j3 T3 }+ D' ^5 [3 f6 v
1098.     "RECTANG" "18000,700" "@11000,1250"
      ! S1 ?, O9 |; z5 y( l; V% c; _4 N4 X
1099.     "RECTANG" "18000,700" "@11000,2500"
      ) w6 g( {, N+ p" _$ u
1100. ;Khung Ti Le + Ngay Thang Nam
      , d9 |+ s1 R% P& f# N! _
1101.     "RECTANG" "22500,700" "@2000,2500"
      
1102. ;Khung CHU TRI
      
1103.     "RECTANG" "8700,700" "@3800,2500"
        [5 p  `' t6 }0 B7 t7 z
1104. "ZOOM" "_a"  ))
      
1105. ;=====================================================================
      7 w* M& j- g1 X
1106. ;Ti Le Ban Ve - 1 : 100
      ) X/ B( a1 i1 C: e
1107. (Defun c:kt4a ()
      
1108.     (setq mv_sc 100);Ti le  ban ve
      
1109.       (setq x4  297)
      0 t' B2 c( d8 N# U7 g  X
1110.       (setq y4  210)
      3 X& {1 b8 D1 w- m) W% |
1111.   (setq x4 (* mv_sc x4)
      
1112.         y4 (* mv_sc y4)  )
      ; G+ }* U6 M. Q. F% Q2 g5 o" w
1113.   (command  
      
1114.     "LIMITS" "0,0" (list x4 y4)
      
1115.     "PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
      1 L3 q1 R) Y& H
1116. ;Khung CHU NHAT Chinh  
      ( ~$ O: s/ z( B3 g/ {( b
1117.     "RECTANG" "2000,500" "@27200,20000"
      # I' W" x& G' G1 L, S6 d  T$ s
1118.     "RECTANG" "2200,700" "@26800,19600"
      
1119. ;Khung Ten Chung
      / \; m  e. [. ]1 J- B9 L8 f
1120.     "RECTANG" "2200,700" "@6500,1250"
      
1121.     "RECTANG" "2200,700" "@15800,2500"
      ! d% ^1 O: |: t, u9 t3 z% g, N; |
1122. ;Ten Ban Ve
      
1123.     "RECTANG" "18000,700" "@11000,1250"
      5 G9 u% `3 N$ I" r4 |/ ^( a
1124.     "RECTANG" "18000,700" "@11000,2500"
      
1125. ;Khung Ti Le + Ngay Thang Nam
      
1126.     "RECTANG" "22500,700" "@2000,2500"
      6 [2 w6 C+ D1 a  h8 G9 `
1127. ;Khung CHU TRI
      5 u, t0 H: }$ Q$ K
1128.     "RECTANG" "8700,700" "@3800,2500"
      9 F( i! ^% ?% @1 q2 d( s
1129.     "ZOOM" "_a"  ))
      , B' e! q* I6 Q! `- s
1130. 
      
1131. ;;; ============================GHI CHU Khung Ten========================
      4 |: j' k; R. e
1132. ;;; ======== Phai Vao STYLE Tao LAYER Ten TEXT + Phai Dat Height ========
      
1133. ;;; =======================Thuong Dung Font Romant.vnh===================
      : p. @4 u6 o/ {* R9 g/ H: A. u
1134. 
      9 E2 X! a9 W! f% F
1135. (defun c:GhiChu (/ pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
      
1136.   (setq oer *error* *error* err2)
      5 x9 O" M% k  U+ A" G) C! s9 D
1137.   (PROMPT "\nChuTri. ThietKe. KiemTra. TiLe. Ngay. HangMuc. QuyMo. KieuNha. CongTrinh. KyHieu. TenBanVe. Kts. TranNgocThang. ")
      1 O) ^* a: _" i: X7 C1 `- E& {
1138.   (SETQ Cpt(GETSTRING "\n(CT). (TK). (KT). (TL). (Ng). (HM). (QM). (KN). (CTr). (KH). (TBV). (Kts). (TnT). "))
      7 ]& B! T( \. I* l- ~+ C$ }$ n
1139.   (IF(OR(= Cpt "QM")(= cpt "qm"))(SETQ CPT ' "Hå S¬ ThiÕt KÕ Nhµ D©n Dông quy M« :"))
      
1140.   (IF(OR(= cpt "KN")(= cpt "kn"))(SETQ CPT ' "2 TÇng 1 Tum Thang"))
      . j) s" e, S  w4 i+ g8 H3 _4 W
1141.   (IF(OR(= cpt "CT")(= cpt "ct"))(SETQ CPT ' "Chñ Tr× :"))
      ( j2 B( l9 N4 J7 Y* F5 m
1142.   (IF(OR(= cpt "HM")(= cpt "hm"))(SETQ CPT ' "H¹ng Môc :"))
      
1143.   (IF(OR(= cpt "CTr")(= cpt "ctr"))(SETQ CPT ' "Nhµ ë Gia §×nh - Nhµ LiÒn KÒ"))
      & W" v5 l- r  q5 D4 _0 |' e3 l
1144.   (IF(OR(= cpt "TK")(= cpt "tk"))(SETQ CPT ' "ThiÕt KÕ :"))
      
1145.   (IF(OR(= cpt "KT")(= cpt "kt"))(SETQ CPT ' "KiÓm Tra :"))
      
1146.   (IF(OR(= cpt "TL")(= cpt "tl"))(SETQ CPT ' "TØ LÖ :"))
      
1147.   (IF(OR(= cpt "KH")(= cpt "kh"))(SETQ CPT ' "Ký HiÖu :"))
      - e) ^0 t6 i2 I( D
1148.   (IF(OR(= cpt "TBV")(= cpt "tbv"))(SETQ CPT ' "Tªn B¶n VÏ :"))
      
1149.   (IF(OR(= cpt "Ng")(= cpt "ng"))(SETQ CPT ' "Ngµy :"))
      
1150.   (IF(OR(= cpt "Kts")(= cpt "kts"))(SETQ CPT ' "Kts. TrÇn Ngäc Th¾ng"))
      # D: P3 m& Y# S* K% C* ?
1151.   (IF(OR(= cpt "TnT")(= cpt "tnt"))(SETQ CPT ' "TrÇn Ngäc Th¾ng"))
      
1152. (setq pta (getpoint
      : j& Q9 I) {7 O8 X' S6 m0 U
1153.     "\nPick first corner. : "))
      
1154.   (setq ptb (getcorner pta
      
1155.     "\nPick second corner. : "))
      
1156.   (setq ptc (list (car ptb)(cadr pta)))
      # c7 W4 h- \/ h4 ]( K* q+ q7 @" @
1157.   (setq ptd (list (car pta)(cadr ptb)))
      $ w: I, |( U% r- l
1158.   (setq ang (angle pta ptb))
      
1159.   (setq d1 (/(distance pta ptb) 2))
      
1160.   (setq cp (polar pta (- ang (dtr 0)) d1))
      
1161.   (setq X (distance pta ptc))
      
1162.   (setq Y (distance pta ptd))
      
1163.   (setq X1 (rtos x 2 1))
      
1164.   (setq Y1 (rtos y 2 1))
      
1165.   (setq rmsz (strcat "(" X1 " x " Y1 ")"))
      7 P7 \4 L9 T! P5 c* z6 C6 R; G" J
1166.   (command "TEXT" "c" cp "0" CPT "text" "" rmsz))
      9 b, c: r* H6 U: ^$ e
1167.   (defun dtr (angg)
      ( ]9 l# _% n% A% Y' T
1168.   (* pi (/ angg 180.0)))
      
1169. 
      0 R( M0 S8 q' d' d1 G1 X
1170. ;=====================================================================
      & @% v  ?4 u2 c/ u4 J$ B6 M7 O! `8 O
1171. ;==========================DAT KHO GIAY BAN VE - KIEU 1========================
      
1172. ;=====================================================================
      
1173. 
      4 q: m( i: s% l( e- v! @
1174. (Defun c:a6 ()
      + F# d) Q7 S2 o9 D$ N! ]
1175.         (setq mv_sc 100);Ti le  ban ve
      9 F3 `: I1 M6 h: w8 c/ T2 A% m
1176.       (setq x4  74.25)
      $ Z" N) j  D( N" |3 P
1177.       (setq y4  52.5)
      
1178.   (setq x4 (* mv_sc x4)
      / x- a4 s9 A9 I! ?7 e
1179.         y4 (* mv_sc y4)  )
      
1180.   (command  
      & R6 \. h" i: P: m/ S" E
1181.     "LIMITS" "0,0" (list x4 y4)
      ) u4 l( y0 [: w, b4 M( {
1182.     "PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
      * G' q- _- t* @- ]2 r
1183.     "RECTANG" "125,125" "@7175,5000"
      
1184.     "RECTANG" "175,175" "@7075,4900"
      
1185.     "ZOOM" "_a"  ))
      # D; b, x8 f( B, X+ e
1186. ;=====================================================================
      ( f" _+ A, X9 B3 P
1187. (Defun c:a5 ()
      
1188.         (setq mv_sc 100);Ti le  ban ve
      8 X- T2 Y& {+ I& n! n) ?4 i
1189.       (setq x4  147.5)
      
1190.       (setq y4  104)
      5 h& b2 u/ |5 {  u
1191.   (setq x4 (* mv_sc x4)
      & \$ r7 @* Y6 t% W/ ]$ I0 X
1192.         y4 (* mv_sc y4)  )
      
1193.   (command  
      
1194.     "LIMITS" "0,0" (list x4 y4)
      
1195.     "PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
      ; ]4 P: N  u9 Y. j* }+ c
1196.     "RECTANG" "250,250" "@14350,10000"
      " m0 ?9 p8 ~8 {+ D# Z& S: V
1197.     "RECTANG" "350,350" "@14150,9800"
      ) ^( Q3 n+ r5 z+ c
1198.     "ZOOM" "_a"  ))
        R. b- w6 P; R5 ?) U# u
1199. ;=====================================================================
      4 J+ o( J+ B$ X7 P* l# i! V
1200. (Defun c:a4 ()
      4 ~7 D# F4 m  {3 C- ^3 U% H% ^; w
1201.         (setq mv_sc 100);Ti le  ban ve
      1 W+ p1 T2 c8 M( J* B
1202.       (setq x4  297)
      
1203.       (setq y4  210)
      
1204.   (setq x4 (* mv_sc x4)
      , d0 T* ~) U7 F" m+ Q; {1 `8 p! ^
1205.         y4 (* mv_sc y4)  )
      8 o+ G5 h2 ~3 l$ g% g" ?! @
1206.   (command  
      
1207.     "LIMITS" "0,0" (list x4 y4)
      
1208.     "PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
      
1209.     "RECTANG" "500,500" "@28700,20000"
      
1210.     "RECTANG" "700,700" "@28300,19600"
      
1211.     "ZOOM" "_a"  ))
      1 d4 J. S. G, d  B; }, h0 ~& G$ ^
1212. ;=====================================================================
      6 E+ m: e3 q0 E# D( e& v+ Y
1213. (Defun c:a3 ()
      " K. {$ X, H" M0 U5 [; \7 l5 e
1214.         (setq mv_sc 100)
      
1215.       (setq x3  420)
      " b  B4 [4 I$ \1 b) g1 z/ \/ b6 R3 [
1216.       (setq y3  297)
      ; q- ]  j; V3 u  _, `9 a  ]0 @5 _
1217.   (setq x3 (* mv_sc x3)
      3 S/ `! ^, ~% h  L% C
1218.         y3 (* mv_sc y3)  )
      
1219.   (command  
      - p( F4 N& g. f
1220.     "LIMITS" "0,0" (list x3 y3)
      9 _( {' n5 W# @% a; f4 e
1221.     "PLINE" "0,0" (list 0 y3) (list x3 y3) (list x3 0) "0,0" "_C"
      , o+ Y5 D1 B: r. ~8 `
1222.     "RECTANG" "707.14285714,707.14285714" "@40590,28285.71428571"
      5 \2 }( D0 L3 [# B
1223.     "RECTANG" "990,990" "@40024.28571429,27720"
      
1224.     "ZOOM" "_a"  ))
      . b1 }9 f2 j$ H5 _4 o& p1 h) R. W
1225. ;=====================================================================
      % ~! r) I, x5 S" B, X
1226. (Defun c:a2 ()
      
1227.         (setq mv_sc 100)
      
1228.       (setq x2  594)
      
1229.       (setq y2  420)
      
1230.   (setq x2 (* mv_sc x2)
      0 y% P! h: }5 c& y% u8 ?' B$ A
1231.         y2 (* mv_sc y2)  )
      
1232.   (command  
      ( R& J5 t8 V; Y! \5 b* R
1233.     "LIMITS" "0,0" (list x2 y2)
      / |+ ^+ Y4 }* }0 p) W0 ^
1234.     "PLINE" "0,0" (list 0 y2) (list x2 y2) (list x2 0) "0,0" "_C"
      
1235.     "RECTANG" "1000,1000" "@57400,40000"
      
1236.     "RECTANG" "1400,1400" "@56600,39200"
      
1237.     "ZOOM" "_a"  ))
      6 J* W. v2 U% n7 q6 g8 }
1238. ;=====================================================================
      
1239. (Defun c:a1 ()
      
1240.         (setq mv_sc 100)
      4 W: U$ E/ a$ J/ H. L- C. @
1241.       (setq x1  840)
      6 u# M: ~. U6 l/ D5 a6 ^
1242.       (setq y1  594)
      - {9 Q( t) Y2 Z, d2 E; x
1243.   (setq x1 (* mv_sc x1)
      " x  n/ v: Y! e) q+ f; Z9 v
1244.         y1 (* mv_sc y1)  )
      8 a4 C; w% t; \4 Q
1245.   (command  
      
1246.     "LIMITS" "0,0" (list x1 y1)
      
1247.     "PLINE" "0,0" (list 0 y1) (list x1 y1) (list x1 0) "0,0" "_C"
      + X* Z; P0 T( L* T# T6 |* z: M6 i
1248.     "RECTANG" "1414.28571429,1414.28571429" "@81180,56571.42857143"
      
1249.     "RECTANG" "1980,1980" "@80048.57142857,55440"
      ) L# H: j, Z8 S% C% W4 f  y
1250.     "ZOOM" "_a"  ))
      ! E! c  ?, a3 C6 j
1251. ;=====================================================================
      
1252. (Defun c:a0 ()
      # b: W+ V( Z2 M8 n% P- R
1253.         (setq mv_sc 100)
        e6 [" [, X4 K
1254.       (setq x0  1188)
      - Z4 v% z3 R% E) i5 o: ]3 X1 W
1255.       (setq y0  840)
      
1256.   (setq x0 (* mv_sc x0)
      , ^% t. u  Y. q- r. U" t
1257.         y0 (* mv_sc y0)  )
      3 t5 F; W8 R. ~* r' B
1258.   (command  
      
1259.     "LIMITS" "0,0" (list x0 y0)
      
1260.     "PLINE" "0,0" (list 0 y0) (list x0 y0) (list x0 0) "0,0" "_C"
      
1261.     "RECTANG" "2000,2000" "@114800,80000"
      
1262.     "RECTANG" "2800,2800" "@113200,78400"
      
1263.     "ZOOM" "_a"  ))
      
1264. 
      
1265. ;=====================================================================
      
1266. ;=========================DAT KHO GIAY BAN VE - KIEU 2=========================
      # r9 u9 }8 }6 k% w+ r! y
1267. ;=====================================================================
      
1268. 
      7 k! B) F- I8 B5 J% b8 O
1269. (Defun c:6a ()
      
1270.         (setq mv_sc 100);Ti le  ban ve
      
1271.       (setq x4  74.25)
      / c, E, s" p/ U- ?- A8 K* p$ x  P  b
1272.       (setq y4  52.5)
      
1273.   (setq x4 (* mv_sc x4)
      ) ?( [: C. }- C5 A
1274.         y4 (* mv_sc y4)  )
      
1275.   (command  
      
1276.     "LIMITS" "0,0" (list x4 y4)
      
1277.     "PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
      
1278.     "RECTANG" "505,125" "@6800,5000"
      * c- ^  u8 G! x$ b
1279.     "RECTANG" "555,175" "@6700,4900"
      
1280.     "ZOOM" "_a"  ))
      
1281. ;=====================================================================
      
1282. (Defun c:5a ()
      8 E% X) Z( Q1 G$ H
1283.         (setq mv_sc 100);Ti le  ban ve
        e7 E3 n! H- A7 M
1284.       (setq x4  148.5)
      
1285.       (setq y4  105)
      
1286.   (setq x4 (* mv_sc x4)
      : i1 G& p, z$ Q2 \, S" b
1287.         y4 (* mv_sc y4)  )
      6 T. b# P, W; r+ t* M
1288.   (command  
      
1289.     "LIMITS" "0,0" (list x4 y4)
      
1290.     "PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
      
1291.     "RECTANG" "1000,250" "@13600,10000"
      8 b1 u. x" g0 s# U8 X: @
1292.     "RECTANG" "1100,350" "@13400,9800"
      ( v8 T# _/ ?; B$ t+ S
1293.     "ZOOM" "_a"  ))
      % w% W8 d8 ^1 n/ s( f2 W" W" y
1294. ;=====================================================================
      
1295. (Defun c:4a ()
      1 a1 g/ t/ D- O% }
1296.         (setq mv_sc 100);Ti le  ban ve
      / r! h! }* o7 D1 `2 k0 d3 {& z
1297.       (setq x4  297)
      
1298.       (setq y4  210)
      
1299.   (setq x4 (* mv_sc x4)
      
1300.         y4 (* mv_sc y4)  )
      
1301.   (command  
      " n; O7 y3 Y$ ~7 L7 W) g* S# r
1302.     "LIMITS" "0,0" (list x4 y4)
      4 }+ {3 I! j1 _4 o% p
1303.     "PLINE" "0,0" (list 0 y4) (list x4 y4) (list x4 0) "0,0" "_C"
      
1304.     "RECTANG" "2000,500" "@27200,20000"
      
1305.     "RECTANG" "2200,700" "@26800,19600"
      
1306.     "ZOOM" "_a"  ))
      7 Z" u1 u2 b9 |0 ~8 A3 }
1307. ;=====================================================================
      
1308. (Defun c:3a ()
      
1309.         (setq mv_sc 100)
      ; v: q: h5 i: u8 a
1310.       (setq x3  420.0428571429)
      
1311.       (setq y3  297)
      
1312.   (setq x3 (* mv_sc x3)
      5 a$ k9 S6 F/ F- z2 e
1313.         y3 (* mv_sc y3)  )
      
1314.   (command  
      0 T0 k2 n# b! U
1315.     "LIMITS" "0,0" (list x3 y3)
      1 f. K% n" M5 u4 Z/ K
1316.     "PLINE" "0,0" (list 0 y3) (list x3 y3) (list x3 0) "0,0" "_C"
      
1317.     "RECTANG" "2828.57142857,707.14285714" "@38468.57142857,28285.71428571"
      . \* v% l5 l4 s) i- M
1318.     "RECTANG" "3111.42857142,989.99999999" "@37902.85714287,27720.00000001"
      / a3 x7 v, w! c9 D4 O9 |0 a
1319.     "ZOOM" "_a"  ))
      
1320. ;=====================================================================
      ' x1 _8 F' Y! L& m4 i
1321. (Defun c:2a ()
      
1322.         (setq mv_sc 100)
      
1323.       (setq x2  594)
      8 ]+ d' P6 o) }- }$ a
1324.       (setq y2  420)
      
1325.   (setq x2 (* mv_sc x2)
        [% N( o4 n  C! U; @) h2 U
1326.         y2 (* mv_sc y2)  )
      
1327.   (command  
      
1328.     "LIMITS" "0,0" (list x2 y2)
      , u& h5 a# i0 y+ j& d7 q3 h" q
1329.     "PLINE" "0,0" (list 0 y2) (list x2 y2) (list x2 0) "0,0" "_C"
      " C0 i) z+ S3 u& l2 W
1330.     "RECTANG" "4000,1000" "@54400,40000"
      7 i, a3 S& T! A- V6 [
1331.     "RECTANG" "4400,1400" "@53600,39200"
      4 L$ a$ U2 I* ]* W. [+ o
1332.     "ZOOM" "_a"  ))
      
1333. ;=====================================================================
      
1334. (Defun c:1a ()
      , Q% a& Q& J: y
1335.         (setq mv_sc 100)
      
1336.       (setq x1  840.0857142857)
      * e0 a3 w+ C: z% ^0 V. F
1337.       (setq y1  594)
      9 e' C+ L: k0 X3 Y% D
1338.   (setq x1 (* mv_sc x1)
      ) b: z0 e$ R2 q8 N
1339.         y1 (* mv_sc y1)  )
      
1340.   (command  
      ; B. {& t9 ^6 x
1341.     "LIMITS" "0,0" (list x1 y1)
      
1342.     "PLINE" "0,0" (list 0 y1) (list x1 y1) (list x1 0) "0,0" "_C"
      0 U# i7 i: S% X; u6 k& J
1343.     "RECTANG" "5657.14285714,1414.28571429" "@76937.14285714,56571.428571436"
      
1344.     "RECTANG" "6222.85714286,1980.00000001" "@75805.71428570,55440"
      : L) L& L3 u9 U
1345.     "ZOOM" "_a"  ))
      
1346. ;=====================================================================
      ) X% T% b' R5 ?# X9 P' y# e
1347. (Defun c:0a ()
      
1348.         (setq mv_sc 100)
      ! [& ?* x! c) ]2 O$ Z; s$ k5 s
1349.       (setq x0  1188)
      
1350.       (setq y0  840)
      % i+ S+ G' j# N# a. Q" u4 l+ o- A
1351.   (setq x0 (* mv_sc x0)
      
1352.         y0 (* mv_sc y0)  )
      : O9 ^+ j/ ]( Z) {4 l
1353.   (command  
      " ?+ n+ H" a  g0 b- e
1354.     "LIMITS" "0,0" (list x0 y0)
      
1355.     "PLINE" "0,0" (list 0 y0) (list x0 y0) (list x0 0) "0,0" "_C"
      
1356.     "RECTANG" "8000,2000" "@108800,80000"
      # J" @/ f2 h. o0 g
1357.     "RECTANG" "8800,2800" "@107200,78400"
      ' Y" O8 ]' Q+ |) o3 z
1358.     "ZOOM" "_a"  ))
      
1359. 
      
1360. ;=====================================================================
      
1361. ;==================DAT KhoGiay Theo KHO GIAY BAN VE===================
        I; w/ k- h' E
1362. ;=====================================================================
      8 h5 w- A* n4 T7 U" @) g
1363. (defun c:khogiay (/ oldlst a b c d e f g h kho TL)
      8 _! p* c7 ?! Y0 S" X, Z
1364. (command "undo" "be")
      4 Q4 q  W" ?/ w& `3 Z& }- z
1365. (setq oldlst (mapcar 'getvar (list "CMDECHO" "OSMODE" "cecolor")))
      
1366. (setvar "CMDECHO" 0)
      
1367.     (setq a (getpoint "\n chon diem chen :"))
      
1368. (if (not TL) (setq TL 1.00))
      1 @$ {" T! N6 ~6 d/ o
1369. (setq TL1 (getDIST (strcat "\nScale <" (rtos TL 2 2) ">:")))
      
1370. (if TL1 (setq TL TL1))
      ! I, p5 c- S3 \/ N: D
1371. (setvar "osmode" 0)
      
1372. (if (not (tblsearch "layer" "Defpoints")) (Command "layer" "N" "Defpoints" ""))
      
1373. (initget "0 1 2 3 4")
      - k$ H& L+ F1 d# a7 J# o
1374.        (setq kho (getkword "\Kho A0 _ Kho A1 _ Kho A2 _ Kho A3 _ Kho A4 [0/1/2/3/4]? <0>:"))
      
1375. (if (= kho "0")
      
1376.      (progn
      
1377.              (setq b (polar a 0 (* TL 1189)))
      : h9 h. j+ w' z! r
1378.                      (setq c (polar b (/ pi 2) (* TL 841)))
      
1379.                      (setq d (polar a (/ pi 2) (* TL 841)))
      & \8 A  `; K" ?0 o/ j) Z; S
1380.              (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 12 12)))))
      7 v# R! y$ @& i8 {. o9 [
1381.                      (setq f (polar e 0 (- (* TL 1189) (* TL 24))))
      6 l6 `" U' o/ m0 x* M
1382.                      (setq g (polar f (/ pi 2) (- (* TL 841) (* TL 24))))
      
1383.                      (setq h (polar e (/ pi 2) (- (* TL 841) (* TL 24))))
      
1384.   (command "Pline" e f g h "c")            
      
1385. (command "change" "last" "" "properties" "layer" "0" "")
      
1386. (setvar "cecolor" "4")
      
1387.   (command "Pline" a b c d "c")
      
1388. (command "change" "last" "" "properties" "layer" "defpoints" "")))   
      . I5 G8 Y! S9 m, k
1389. (if (= kho "1")
      
1390.      (progn
      " h9 [0 P: c$ q8 ]4 \& f! b
1391.              (setq b (polar a 0 (* TL 841)))
      % _# J( Y  D7 v, o3 @4 M
1392.                      (setq c (polar b (/ pi 2) (* TL 594)))
      6 |1 D1 {: U& D8 t' I2 |
1393.                      (setq d (polar a (/ pi 2) (* TL 594)))
      
1394.             (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 12 12)))))
      , D5 r0 k& n( k4 W
1395.                      (setq f (polar e 0 (- (* TL 841) (* TL 24))))
      
1396.                      (setq g (polar f (/ pi 2) (- (* TL 594) (* TL 24))))
      
1397.                      (setq h (polar e (/ pi 2) (- (* TL 594) (* TL 24))))
      1 ?. }1 `" i0 X1 H, H
1398.   (command "Pline" e f g h "c")            
      
1399. (command "change" "last" "" "properties" "layer" "0" "")
      2 o3 c# p. i. ]* c( e: f
1400. (setvar "cecolor" "4")
      
1401.   (command "Pline" a b c d "c")
      
1402. (command "change" "last" "" "properties" "layer" "defpoints" "")))
      2 X( j; J" B& P! R4 u* S. m" u
1403. (if (= kho "2")
      + V# a, _1 D. m6 {
1404.      (progn
      1 K% ?# r- u8 k, S  o
1405.              (setq b (polar a 0 (* TL 594)))
      
1406.                      (setq c (polar b (/ pi 2) (* TL 420)))
      
1407.                      (setq d (polar a (/ pi 2) (* TL 420)))
      & F0 ?/ G  g4 O! y0 {: D
1408.              (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 100)))))
      ' r0 Q1 M- O( C: g5 W- _$ @
1409.                      (setq f (polar e 0 (- (* TL 594) (* TL 20))))
      
1410.                      (setq g (polar f (/ pi 2) (- (* TL 420) (* TL 20))))
      + c' Q3 U- E* i: S! I3 F
1411.                      (setq h (polar e (/ pi 2) (- (* TL 420) (* TL 20))))
      & A. [% ~9 D7 l% O6 J
1412.   (command "Pline" e f g h "c")            
      
1413. (command "change" "last" "" "properties" "layer" "0" "")
      
1414. (setvar "cecolor" "4")
      
1415.   (command "Pline" a b c d "c")
      
1416. (command "change" "last" "" "properties" "layer" "defpoints" "")))
      8 ?& v; @6 R) H2 R
1417. (if (= kho "3")
      : ^, W3 z8 Z8 d6 m0 f' \. I
1418.      (progn
      ' B8 O! y) I! Q' O' }/ s2 ~* x
1419.              (setq b (polar a 0 (* tl 420)))
      
1420.                      (setq c (polar b (/ pi 2) (* TL 297)))
      
1421.                      (setq d (polar a (/ pi 2) (* TL 297)))
      
1422.              (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 100)))))
      
1423.                      (setq f (polar e 0 (- (* TL 420) (* TL 20))))
      / O. ?7 M' X' @
1424.                      (setq g (polar f (/ pi 2) (- (* TL 297) (* TL 20))))
      
1425.                      (setq h (polar e (/ pi 2) (- (* TL 297) (* TL 20))))
      
1426. (command "Pline" e f g h "c")
      
1427.   (command "change" "last" "" "properties" "layer" "0" "")
      / m; _4 I  y7 H! j& k! e( N
1428. (setvar "cecolor" "4")
      
1429. (command "Pline" a b c d "c")
      
1430.   (command "change" "last" "" "properties" "layer" "defpoints" "")))
      ; E! [  x, p- o3 l& i4 i
1431. (if (= kho "4")
      
1432.      (progn
      
1433.              (setq b (polar a 0 (* TL 297)))
      / J; ?, q# e9 D$ f
1434.               (setq c (polar b (/ pi 2) (* TL 210)))
      & _3 h+ x8 }( f8 f
1435.                      (setq d (polar a (/ pi 2) (* TL 210)))
      - B3 S+ ^" B/ ^0 }4 I# ]" s
1436.             (setq e (polar a (/ pi 4) (* TL (sqrt (* 2 81)))))
      
1437.                      (setq f (polar e 0 (- (* TL 297) (* TL 18))))
      % q2 `+ \# q; [4 N
1438.                      (setq g (polar f (/ pi 2) (- (* TL 210) (* TL 18))))
      5 S8 L+ E1 h3 N- [
1439.                      (setq h (polar e (/ pi 2) (- (* TL 210) (* TL 18))))
      & E) l( `7 K+ Z7 R0 S# L
1440.   (command "Pline" e f g h "c")            
      
1441. (command "change" "last" "" "properties" "layer" "0" "")
      
1442. (setvar "cecolor" "4")
      
1443.   (command "Pline" a b c d "c")
      
1444. (command "change" "last" "" "properties" "layer" "defpoints" "")))
      
1445. (mapcar 'setvar (list "CMDECHO" "OSMODE" "cecolor") oldlst)
      ! @$ J( K; \; }6 [" J: Y2 g, m
1446. (command "undo" "e")
      9 C! Q" [- Y$ x0 Y9 _8 M5 n
1447. (princ))
      
1448. ;=====================================================================
      / D; f& C* C7 H3 X' t7 s
1449. ;==================DAT KhoGiay Theo KHO GIAY BAN VE===================
      - t/ a  G3 }# g! d5 x$ H" Q* M' l
1450. ;=====================================================================
      
1451. 
      
1452. ;=====================================================================
      
1453. ;===================DAT Ti Le Theo KHO GIAY BAN VE====================
      
1454. ;=====================================================================
      5 n0 K: ~, v8 ]  _
1455. 
      
1456. (DEFUN C:SA6 () (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.1" "" "LT" "ACAD_ISO03W100" "" "" "LTSCALE" "5" ""
      
1457.                               "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.3" ""
      
1458.                                            "M" "MANH" "C" "9" "" "Lw" "0.1" ""
      
1459.                                        "M" "TEXT" "C" "7" "" "Lw" "0.12" ""
      
1460.                                        "M" "DIM" "C" "1" "" "Lw" "0.12" ""
      
1461.                                        "M" "THAY" "C" "7" "" "Lw" "0.2" ""
      
1462.                                        "M" "NOITHAT" "C" "3" "" "Lw" "0.12" ""
      6 Z1 d% r7 T3 `
1463.                                        "M" "HATCH" "C" "5" "" "Lw" "0.1" ""
      ) C" G& }6 r  C1 B
1464.                                        "M" "COT" "C" "1" "" "Lw" "0.3" ""
      
1465.                                        "M" "Defpoints" "C" "7" ""
      / H2 N7 P% K' \' |, |3 z
1466.                                        "M" "0" "C" "3" "" "Lw" "0.12" ""
      
1467.                                        "M" "CUA" "C" "6" "" "Lw" "0.12" ""
      ( S% Y3 t9 z- H. u
1468.                                        "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.12" ""
      
1469.                                        "M" "TIMTUONG" "C" "5" "" "Lw" "0.1" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "3" ""))
      
1470. (DEFUN C:SA5 () (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.12" "" "LT" "ACAD_ISO03W100" "" "" "LTSCALE" "10" ""
      
1471.                               "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.4" ""
      7 Y; M; h0 j3 q
1472.                                            "M" "MANH" "C" "9" "" "Lw" "0.12" ""
      
1473.                                        "M" "TEXT" "C" "7" "" "Lw" "0.12" ""
      , a1 L- ?5 M6 J' H3 t: G+ Z
1474.                                        "M" "DIM" "C" "1" "" "Lw" "0.2" ""
      5 m$ K& r! D2 I
1475.                                        "M" "THAY" "C" "7" "" "Lw" "0.2" ""
      ) S$ n9 |0 T, g+ w: p; c
1476.                                        "M" "NOITHAT" "C" "3" "" "Lw" "0.2" ""
      
1477.                                        "M" "HATCH" "C" "5" "" "Lw" "0.1" ""
      5 x) X( y% G" N4 U/ ~0 S( x
1478.                                        "M" "COT" "C" "1" "" "Lw" "0.4" ""
      " I0 X, c' y0 y" o
1479.                                        "M" "Defpoints" "C" "7" ""
      . h1 H0 p) w6 S" l) ^) f
1480.                                        "M" "0" "C" "3" "" "Lw" "0.2" ""
      - i1 p& P/ U# X9 f
1481.                                        "M" "CUA" "C" "6" "" "Lw" "0.12" ""
      
1482.                                        "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.12" ""
      9 @* A- Y  G0 H
1483.                                        "M" "TIMTUONG" "C" "5" "" "Lw" "0.15" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "5" ""))
      7 j. v: u+ F) f6 |# d
1484. (DEFUN C:SA4 () (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.2" "" "LT" "ACAD_ISO03W100" "" "" "LTSCALE" "20" ""
      
1485.                               "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.6" ""
      2 @% A5 v6 p/ v& T! w
1486.                                            "M" "MANH" "C" "9" "" "Lw" "0.2" ""
      
1487.                                        "M" "TEXT" "C" "7" "" "Lw" "0.2" ""
      , m- Q9 {) e1 |" e. p) J( b
1488.                                        "M" "DIM" "C" "1" "" "Lw" "0.25" ""
      - V" G4 K2 l" Y9 |4 b. S" S
1489.                                        "M" "THAY" "C" "7" "" "Lw" "0.35" ""
      ; r  d" g# ?( P% C
1490.                                        "M" "NOITHAT" "C" "3" "" "Lw" "0.25" ""
      
1491.                                        "M" "HATCH" "C" "5" "" "Lw" "0.15" ""
      
1492.                                        "M" "COT" "C" "1" "" "Lw" "0.6" ""
      
1493.                                        "M" "Defpoints" "C" "7" ""
      2 Q6 m# V5 L: Y8 i0 K% ^+ }
1494.                                        "M" "0" "C" "3" "" "Lw" "0.25" ""
      
1495.                                        "M" "CUA" "C" "6" "" "Lw" "0.25" ""
      
1496.                                        "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.25" ""
      : s4 T3 {3 L: K3 _  j5 q1 Q
1497.                                        "M" "TIMTUONG" "C" "5" "" "Lw" "0.2" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "10" ""))
      
1498.         
      
1499. (DEFUN C:SA3 () (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.35" "" "LT" "ACAD_ISO03W100" "" "" "" "LTSCALE" "30" ""
      7 i! D& Y: L* T( c2 c+ [
1500.                               "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.7" ""
      
1501.                                            "M" "MANH" "C" "9" "" "Lw" "0.25" ""
      
1502.                                        "M" "TEXT" "C" "7" "" "Lw" "0.2" ""
      & a! K+ v) C0 }9 s% I! \& k
1503.                                        "M" "DIM" "C" "1" "" "Lw" "0.35" ""
      
1504.                                        "M" "THAY" "C" "7" "" "Lw" "0.4" ""
      1 o6 ^8 i& p/ ?; R4 k9 j  D
1505.                                        "M" "NOITHAT" "C" "3" "" "Lw" "0.25" ""
      
1506.                                        "M" "HATCH" "C" "5" "" "Lw" "0.2" ""
      : y9 t! _3 P+ |
1507.                                        "M" "COT" "C" "1" "" "Lw" "0.7" ""
      
1508.                                        "M" "Defpoints" "C" "7" ""
      
1509.                                        "M" "0" "C" "3" "" "Lw" "0.25" ""
      / _1 ?- s9 T# x  U: I7 k
1510.                                        "M" "CUA" "C" "6" "" "Lw" "0.35" ""
      ; b' F3 N0 t& x1 ]$ U
1511.                                        "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.3" ""
      # ?' l5 V6 X/ B$ x
1512.                                        "M" "TIMTUONG" "C" "5" "" "Lw" "0.25" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "20" ""))(PRINC)
      
1513. 
      
1514. (DEFUN C:SA2 () (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.35" "" "LT" "ACAD_ISO03W100" "" "" "" "LTSCALE" "45" ""
      
1515.                               "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.7" ""
      
1516.                                            "M" "MANH" "C" "9" "" "Lw" "0.25" ""
      ) Y* w5 D3 u$ n: v+ |
1517.                                        "M" "TEXT" "C" "7" "" "Lw" "0.25" ""
      8 k; a% m* L0 L$ H" a1 d, y
1518.                                        "M" "DIM" "C" "1" "" "Lw" "0.3" ""
      
1519.                                        "M" "THAY" "C" "7" "" "Lw" "0.4" ""
      
1520.                                        "M" "NOITHAT" "C" "3" "" "Lw" "0.3" ""
      
1521.                                        "M" "HATCH" "C" "5" "" "Lw" "0.2" ""
      
1522.                                        "M" "COT" "C" "1" "" "Lw" "0.7" ""
      # |* Q) k! q/ V, Y0 O1 {
1523.                                        "M" "Defpoints" "C" "7" ""
      
1524.                                        "M" "0" "C" "3" "" "Lw" "0.35" ""
      5 A. F3 E0 n! M. u# W4 h
1525.                                        "M" "CUA" "C" "6" "" "Lw" "0.35" ""
      
1526.                                        "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.3" ""
      # ~& z3 Q; Z5 A" }, b7 c5 U
1527.                                        "M" "TIMTUONG" "C" "5" "" "Lw" "0.25" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "30" ""))
      ' h& Y7 C* e. H9 a2 X6 x
1528. 
      
1529. (DEFUN C:SA1 () (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.4" "" "LT" "ACAD_ISO03W100" "" "" "" "LTSCALE" "60" ""
      $ D. V$ Z; t6 F
1530.                               "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "0.85" ""
      
1531.                                            "M" "MANH" "C" "9" "" "Lw" "0.35" ""
      
1532.                                        "M" "TEXT" "C" "7" "" "Lw" "0.5" ""
      ) m1 h7 ~. Z5 O- @$ l/ i
1533.                                        "M" "DIM" "C" "1" "" "Lw" "0.35" ""
      + w6 k6 l( }+ ~2 v3 g& Q0 T: E
1534.                                        "M" "THAY" "C" "7" "" "Lw" "0.4" ""
      % u( I. \" a5 W& O1 v% ?. J
1535.                                        "M" "NOITHAT" "C" "3" "" "Lw" "0.35" ""
      
1536.                                        "M" "HATCH" "C" "5" "" "Lw" "0.25" ""
      : I) B* l0 w9 s9 o" x! z/ z
1537.                                        "M" "COT" "C" "1" "" "Lw" "0.85" ""
      
1538.                                        "M" "Defpoints" "C" "7" ""
      
1539.                                        "M" "0" "C" "3" "" "Lw" "0.35" ""
      3 k4 q7 s4 k4 z$ ^) A3 \
1540.                                        "M" "CUA" "C" "6" "" "Lw" "0.4" ""
      * c& d' q+ g% _, B6 k
1541.                                        "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.35" ""
      
1542.                                        "M" "TIMTUONG" "C" "5" "" "Lw" "0.3" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "40" ""))
      * W3 u1 T6 B  r: F( b, g1 b
1543.         
      . i0 l6 H" \. T6 u  y. P4 r  {
1544. (DEFUN C:SA0 () (COMMAND "-LAYER" "M" "NETDUT" "C" "8" "" "Lw" "0.5" "" "LT" "ACAD_ISO03W100" "" "" "" "LTSCALE" "85" ""
      9 \# [# Y4 n, Q( m8 Q
1545.                               "-LAYER" "M" "TUONG" "C" "4" "" "Lw" "1" ""
      
1546.                                            "M" "MANH" "C" "9" "" "Lw" "0.35" ""
      
1547.                                        "M" "TEXT" "C" "7" "" "Lw" "0.5" ""
      
1548.                                        "M" "DIM" "C" "1" "" "Lw" "0.35" ""
      7 X3 \2 |7 V3 H, E& l- p
1549.                                        "M" "THAY" "C" "7" "" "Lw" "0.5" ""
        T- j) H0 R4 u1 Z1 u) ?: w
1550.                                        "M" "NOITHAT" "C" "3" "" "Lw" "0.4" ""
      / B- w# l7 K& ^
1551.                                        "M" "HATCH" "C" "5" "" "Lw" "0.35" ""
      / O, r; J* n8 D! h  z0 w3 ?
1552.                                        "M" "COT" "C" "1" "" "Lw" "0.1" ""
      
1553.                                        "M" "Defpoints" "C" "7" ""
      * q$ _1 O; q( ]% Z2 |0 {3 \8 Q
1554.                                        "M" "0" "C" "3" "" "Lw" "0.5" ""
      " a4 g; J0 @7 d, h9 M4 Z% n, F+ m
1555.                                        "M" "CUA" "C" "6" "" "Lw" "0.5" ""
        C( G7 M  X4 f+ A/ X( w+ e
1556.                                        "M" "CUA MATDUNG" "C" "6" "" "Lw" "0.4" ""
      
1557.                                        "M" "TIMTUONG" "C" "5" "" "Lw" "0.35" "" "LT" "ACAD_ISO10W100" "" "" "LTSCALE" "55" ""))
      
1558. (DEFUN C:O   () (COMMAND "OFFSET"))
      
1559. (defun c:s1 () (command "surftab1"))
      
1560. (defun c:s2 () (command "surftab2"))
      
1561. (defun c:ep () (command "explode"))
      % ?! R- r( t& l
1562. (DEFUN C:QS () (COMMAND "AUDIT" "Y" "purge" "all" "*" "N" "QSAVE"))
      
1563. (DEFUN C:QV   () (COMMAND "QSAVE"))
      
1564. (DEFUN C:S    () (COMMAND "STRETCH" "C"))
      
1565. 
      - l/ w# }* t) l5 D. m
1566. ;************************** CAT DIM **************************
      6 h- N1 v, u; D! r3 w
1567. 
      
1568. (DEFUN C:DC (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
      0 r0 w) A% M* ]: n' X+ H) \5 z
1569.                 PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
      
1570. (SETQ CMD (GETVAR "CMDECHO"))
      / Z( [( F2 D3 H* }+ |" a( P% W
1571. (SETQ OSM (GETVAR "OSMODE"))
      
1572. (SETQ OLDERR *error*
      
1573.       *error* myerror)
      1 V" {* ?: }( d- p4 O
1574. (PRINC "Please select dimension object!")
      
1575. (SETQ SS (SSGET))
      3 g" \6 c+ n# o7 T
1576. (SETVAR "CMDECHO" 0)
      # }1 w0 p/ n$ a3 N
1577. (SETQ PT (GETPOINT "Point to trim or extend:"))
      ; B9 @$ u! I$ S' C
1578. (SETQ PT (TRANS PT 1 0))
      6 V. g5 y* w5 @: F2 H
1579. (COMMAND "UCS" "W")
      
1580. (SETQ LTH (SSLENGTH SS))
      2 o# o) m' q! k9 d
1581. (SETQ DEM 0)
      
1582. (WHILE (< DEM LTH)
      
1583.     (PROGN
      1 z! s9 R6 j/ h0 f+ b! m
1584.         (SETQ DS (ENTGET (SSNAME SS DEM)))
      
1585.         (SETQ KDL (CDR (ASSOC 0 DS)))
      6 U. Y% Q, ?) C! c/ B
1586.         (IF (= "DIMENSION" KDL)
      
1587.            (PROGN
      
1588.                 (SETQ PT10 (CDR (ASSOC 10 DS)))
      ; W1 x7 B5 f/ k$ F& ?0 @( D
1589.                 (SETQ PT11 (CDR (ASSOC 11 DS)))
      
1590.                 (SETQ PT13 (CDR (ASSOC 13 DS)))
      
1591.                 (SETQ PT14 (CDR (ASSOC 14 DS)))
      # V( J3 L) O, N1 j4 k/ q" j
1592.                 (SETQ N70 (CDR (ASSOC 70 DS)))
      
1593.                 (IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
      
1594.                    (PROGN
      
1595.                         (SETQ GOCY (ANGLE PT10 PT14))
      2 m" N7 }' P4 T% K5 I+ T
1596.                         (SETQ GOCX (+ GOCY (/ PI 2)))
      % o- `. H8 e/ t- R
1597.                    )
      
1598.                 )
      # z4 |- `, m, n7 g
1599.                 (SETVAR "OSMODE" 0)
      0 p: |- C# E% v* ?. M
1600.                 (SETQ PTI (POLAR PT GOCX 2))
      ' e: e; [) x* b
1601.                 (SETQ PT13I (POLAR PT13 GOCY 2))
      5 B3 {7 L# C& e* O
1602.                 (SETQ PT14I (POLAR PT14 GOCY 2))
      
1603.                 (SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
      ! S0 v1 i* p, D  A
1604.                 (SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
      
1605.                 (SETQ O13 (ASSOC 13 DS))
      
1606.                 (SETQ O14 (ASSOC 14 DS))
      
1607.                 (SETQ N13 (CONS 13 PT13N))
      % t! ^+ p. \9 C
1608.                 (SETQ N14 (CONS 14 PT14N))
      4 P0 W1 |5 F! c) j5 O( p# Y
1609.                 (SETQ DS (SUBST N13 O13 DS))
      
1610.                 (SETQ DS (SUBST N14 O14 DS))
      
1611.                 (ENTMOD DS)
      ; x2 B' D! N. _1 s7 b# P) N
1612.            )
      
1613.         )
      % O  Y* {5 V2 Z5 T% {( d
1614.         (SETQ DEM (+ DEM 1))
      * D9 m( w( s: F4 H
1615.     )
      
1616. )
        w) B" r$ \7 L0 w6 ]6 j- }
1617. (COMMAND "UCS" "P")
      2 N' z, X( ~6 D, R! r" b7 z5 _
1618. (SETVAR "CMDECHO" CMD)
      
1619. (SETVAR "OSMODE" OSM)
      
1620. (setq *error* OLDERR)               ; Restore old *error* handler
      : Q/ z& Z3 R2 s, ~" [% J1 s
1621. (PRINC)
      2 O9 c+ H' u, r, W2 R, D
1622. )
      8 l( H8 k2 O. I1 J
1623. 
      
1624. (DEFUN C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
      
1625.                 PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
      
1626. (SETQ CMD (GETVAR "CMDECHO"))
      
1627. (SETQ OSM (GETVAR "OSMODE"))
      
1628. (SETQ OLDERR *error*
      
1629.       *error* myerror)
      
1630. (PRINC "Please select dimension object!")
      0 v; ]# }- ~, }2 X) o
1631. (SETQ SS (SSGET))
      
1632. (SETVAR "CMDECHO" 0)
      
1633. (SETQ PT (GETPOINT "Point to trim or extend:"))
      / Y* K, h. H  r
1634. (SETQ PT (TRANS PT 1 0))
      6 H$ P0 I+ q, X* t/ l( v3 m) E
1635. (COMMAND "UCS" "W")
      
1636. (SETQ LTH (SSLENGTH SS))
      
1637. (SETQ DEM 0)
      
1638. (WHILE (< DEM LTH)
      3 X% K' [; w1 w& a% h  a
1639.     (PROGN
      
1640.         (SETQ DS (ENTGET (SSNAME SS DEM)))
      
1641.         (SETQ KDL (CDR (ASSOC 0 DS)))
      / |0 a% F  r6 N$ W# i; }
1642.         (IF (= "DIMENSION" KDL)
      
1643.            (PROGN
      
1644.                 (SETQ PT13 (CDR (ASSOC 13 DS)))
      
1645.                 (SETQ PT14 (CDR (ASSOC 14 DS)))
      ! s/ B% a5 B! u  \0 Q
1646.                 (SETQ PT10 (CDR (ASSOC 10 DS)))
      
1647.                 (SETQ PT11 (CDR (ASSOC 11 DS)))
        s9 Z' q6 P7 `2 J5 ]
1648.                 (SETQ N70 (CDR (ASSOC 70 DS)))
      ( R& b! d% h2 y
1649.                 (IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
      
1650.                    (PROGN
      5 e1 Y0 F9 p+ x8 r% O
1651.                         (SETQ GOCY (ANGLE PT10 PT14))
      2 k* B+ T+ P' Z
1652.                         (SETQ GOCX (+ GOCY (/ PI 2)))
      
1653.                    )
      
1654.                 )
      
1655.                 (SETVAR "OSMODE" 0)
      
1656.                 (SETQ PTI (POLAR PT GOCX 2))
      
1657.                 (SETQ PT10I (POLAR PT10 GOCY 2))
      
1658.                 (SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
      ! l) g" E8 i% Z8 }' W7 R. V
1659.                 (SETQ KC (DISTANCE PT10 PT10N))
      
1660.                 (SETQ O10 (ASSOC 10 DS))
      ; U/ h& P* p6 s7 ]' ]
1661.                 (SETQ N10 (CONS 10 PT10N))
      
1662.                 (SETQ DS (SUBST N10 O10 DS))
      9 g7 r# g+ m8 }4 y. c' E
1663.                 (SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
      
1664.                 (SETQ O11 (ASSOC 11 DS))
      - C3 K  p% m1 I9 u- Y
1665.                 (SETQ N11 (CONS 11 PT11N))
      2 D- p. {- i3 a9 N% j
1666.                 (SETQ DS (SUBST N11 O11 DS))
      
1667.                 (ENTMOD DS)
      
1668.            )
      . U8 M9 K: }: B! ^
1669.         )
      
1670.         (SETQ DEM (+ DEM 1))
      5 T3 f; R7 L1 x: p5 }3 t
1671.     )
      
1672. )
      
1673. (COMMAND "UCS" "P")
      2 r+ N  |1 s  B: x
1674. (SETVAR "CMDECHO" CMD)
      
1675. (SETVAR "OSMODE" OSM)
      & I5 \9 E3 j& s$ U% v7 i
1676. (setq *error* OLDERR)
      
1677. (PRINC)
      
1678. )
      
1679. 
      * o. S- ]+ f, S; J
1680. ;;; ================ BAT - TAT CHE DO GACH CHAN TEXT (TU) =================
      
1681. 
      
1682. (defun c:tu ()  (setvar "cmdecho" 0)(prompt "\nHay chon dong TEXT can gach chan ")
      - i* ?* ~. ^- L7 c1 j0 x4 ^
1683.           (prompt "\nSelect objects: ")(command "select" "au" pause)(setq sstxt (ssget "p")
      - K* {! L/ J7 s; G# W  d
1684.         sslen (sslength sstxt) ctr 0)(command ".undo" "mark")(while (< ctr sslen)(setq listxt
      
1685.         (entget (ssname sstxt ctr))txttxt (cdr (assoc 1 listxt))enttxt (cdr (assoc 0 listxt)))
      ; c: X9 d& S8 J& L# n. H' p
1686.         (if (= enttxt "TEXT")(progn(setq testxt (substr txttxt 1 3))(if (or (= testxt "%%u")
      
1687.         (= testxt "%%U"))(setq newtxt (substr txttxt 4))(setq newtxt (strcat "%%u" txttxt)))
      
1688.         (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))(entmod listxt)))
      * J# {, j5 W2 V4 Y. S- \6 T
1689.         (setq ctr (1+ ctr))  )    (setvar "cmdecho" 1)    (princ))
      
1690. 
      
1691. ;;; ================ CHEN COT (TUU) =================
      
1692. 
      
1693. (defun c:tuu ()  (setvar "cmdecho" 0)(prompt "\nHay chon dong TEXT can chen cot ")
      9 e4 s; H/ ?# D, Q# n
1694.           (prompt "\nSelect objects: ")(command "select" "au" pause)(setq sstxt (ssget "p")
      ! ^7 T+ L; }. W* [! \* M3 c+ w
1695.         sslen (sslength sstxt) ctr 0)(command ".undo" "mark")(while (< ctr sslen)(setq listxt
      
1696.         (entget (ssname sstxt ctr))txttxt (cdr (assoc 1 listxt))enttxt (cdr (assoc 0 listxt)))
      
1697.         (if (= enttxt "TEXT")(progn(setq testxt (substr txttxt 1 3))(if (or (= testxt "%%p 0,000")
      
1698.         (= testxt "%%P 0,000"))(setq newtxt (substr txttxt 4))(setq newtxt (strcat "%%P 0,000" txttxt)))
      / t: i2 T8 ?) G0 B7 s" m# ^
1699.         (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))(entmod listxt)))
      
1700.         (setq ctr (1+ ctr))  )    (setvar "cmdecho" 1)    (princ))
      # a+ v: \# D! a6 _2 C; d2 F% J0 X* H
1701. 
      
1702. ;;; ================ CHEN KY HIEU THEP (TP) =================
      $ X- s0 w4 A: {' g) C* I; q% d
1703. 
      
1704. (defun c:tp ()  (setvar "cmdecho" 0)(prompt "\nHay chon dong TEXT can chen ky hieu thep ")
      
1705.           (prompt "\nSelect objects: ")(command "select" "au" pause)(setq sstxt (ssget "p")
      
1706.         sslen (sslength sstxt) ctr 0)(command ".undo" "mark")(while (< ctr sslen)(setq listxt
      
1707.         (entget (ssname sstxt ctr))txttxt (cdr (assoc 1 listxt))enttxt (cdr (assoc 0 listxt)))
      
1708.         (if (= enttxt "TEXT")(progn(setq testxt (substr txttxt 1 3))(if (or (= testxt "%%c")
      
1709.         (= testxt "%%C"))(setq newtxt (substr txttxt 4))(setq newtxt (strcat "%%c" txttxt)))
      
1710.         (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))(entmod listxt)))
      
1711.         (setq ctr (1+ ctr))  )    (setvar "cmdecho" 1)    (princ))
      
1712. 
      7 W1 \( g$ _  r, i/ h) q. l+ M7 s% o
1713. ;=========================== TAM TUONG (TAM) =================================
      
1714. 
      
1715. (defun c:tam(/ data_m)
      
1716.             (defun import_data(/ i)(setq data_m (ssget))(if (= nil distan_m) (setq distan_m 110.0))
      ' s0 Y3 e# H' E
1717.             (princ "Distance (")(princ distan_m)(princ "):")(setq i (getreal ))(if (not (= nil i))
      # \# M7 O9 b6 u% f7 M" Y( T) G
1718.         (setq distan_m i)))(defun process(/ ent check)(defun p_check()(setq check 0)
      
1719.         (if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))(princ))(defun p_d_offset
      3 N% x& A% ?8 C  t( _0 K
1720.         (/ p1 p2 p3 p4)(defun makeline(/ e2 e5)(setq la (list (cons 0 "LINE")(cons 5 (cdr
      3 q9 ^+ L" j) O" q, S9 n* }
1721.         (assoc 5 ent)))(cons 8 (cdr (assoc 8 ent)))(cons 10 p3)(cons 11 p4)))(entmake la)(princ)
      7 h& j6 @  O/ G! b* `! P4 U, _% K
1722.         )(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))(if (not (= p1 p2)) (progn (if
      1 ?* |8 z' ~* D. u* x! f2 G* P
1723.         (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn (setq p3 (list (+ (nth 0 p1)
      
1724.         distan_m) (nth 1 p1) (nth 2 p1)))(setq p4 (list (+ (nth 0 p2) distan_m)(nth 1 p2)
      $ u0 b, X  m2 L; L# S+ l
1725.         (nth 2 p2))) (makeline) (setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1)))
      
1726.         (setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2))) (makeline)))(if (<
      
1727.         (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn (setq p3 (list (nth 0 p1) (+ (nth 1 p1)
        }0 G; [; a* ]; F% ~1 {' V
1728.         distan_m) (nth 2 p1)))(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2)))
      9 P: `, G  \: g& z* @( U
1729.         (makeline) (setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1))) (setq p4
      
1730.         (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2)))(makeline)))))(princ))(if (not
      
1731.         (= nil data_m)) (progn (setq i 0)(while (< i (sslength data_m)) (progn(setq ent (entget
      
1732.         (ssname data_m i)))(p_check)(if (= 1 check) (p_d_offset))(setq i (+ i 1))))))(princ))
      
1733.           (import_data)(ai_undo_push)(process)(ai_undo_pop)(princ))
      
1734. 
      / x1 |* }2 a8 \* @
1735. ;============ GHI CHU PHI (T1) ================
      " z* |9 p5 B3 b
1736. 
      1 p( r3 B. \6 J# Y! `
1737. (defun c:DuongDan ()(setq D1 (getpoint " Diem thu nhat: "))(setq D2 (getpoint "Diem thu hai: " D1))
      + I7 O; q$ v# F0 s* w& g; @
1738.           (if (> (car D2) (car D1)) (setq D3 (polar D2 0 16)))(if (< (car D2) (car D1)) (setq D3
      + p! }) O! p, ~1 A
1739.         (polar D2 PI 16)))(if (= (car D2) (car D1)) (setq D3 (polar D2 0 16)))(if (> (car D2)
      
1740.         (car D1)) (setq D4 (polar D3 0 3.2)))(if (< (car D2)(car D1))(setq D4 (polar D3 PI 3.2)
      ) H. H+ ]3 o4 l7 z9 V& C$ j
1741.         ))(if (= (car D2) (car D1)) (setq D4 (polar D3 0 3.2)))(if (> (car D2) (car D1))
      " T/ u- G3 x, ^! |8 g6 o9 ?& o2 A
1742.         (setq D5 (polar D2 (/ PI 9) 3)))(if (< (car D2) (car D1)) (setq D5 (polar D3 (/ PI 9)
      # l6 ^- c1 M% h  q! e8 x7 u+ f
1743.         3)))(if (= (car D2) (car D1)) (setq D5 (polar D2 (/ PI 9) 3)))(command "color" 1)
      
1744.           (command "line" D1 D2 D3 "")(command "circle" D4 "3.5")(command "color" 7 )
      & }  J/ w% [8 D: A7 U! Y+ e
1745.           (command "text" "m" D4 2.5 0 "1")(command "text" D5 2.5 0 "%%c6a150")
      3 L, q& E; M$ v6 P! o
1746.           (command "ddedit" pause))
      " K1 P5 V6 O& u9 q0 l4 `1 C, _/ }, V
1747. 
      7 E& \& R" n  _, g# I1 \
1748. ;;; ========================== Join (J) =================
      
1749. 
      
1750. (defun C:J () (Setvar "cmdecho" 0)(setq m:err *error* *error* *merrmsg*)(setq sset (ssget))
      
1751.            (if (null sset) (exit))(setq kt (getstring "\nJoin all (Y/N) <Y> ? "))
      
1752.           (setq ssl (sslength sset))(setq temp  (entget (ssname sset 0))etype (cdr (assoc 0 temp)
      ! o2 Q% o1 f) P2 U
1753.         ))(cond((or (= kt "Y") (= kt "y") (= kt ""))(progn (cond((= etype "POLYLINE")
      3 e' Q/ k1 F" o  D: d2 n) s$ d
1754.         (COMMAND "PEDIT" sset "J" "all" "" ""))(if (or (= etype "LINE") (= etype "ARC"))
      ' \8 F! L8 k( V. U
1755.            (COMMAND "PEDIT" sset "" "J" "all" "" "")))))((or (/= kt "Y") (/= kt "y") (/= kt ""))
      
1756.         (progn (cond((= etype "POLYLINE")(COMMAND "PEDIT" sset "J" sset "" ""))  
      
1757.            (if (or (= etype "LINE") (= etype "ARC"))(COMMAND "PEDIT" sset "" "J" sset "" ""))))))
      $ U! D  p3 x! E' Z- }
1758.           (setq *error* m:err m:err nil)(princ))
      
1759. 
      ( E+ d8 [: E9 m- Z: x4 e' n% Z; K
1760. ;=====================================================================
      
1761. ;;; DOOR.LSP 1.0, Copyright (C) 1998 by CAD Department, HUCE.
      
1762. ;=====================================================================
      3 h- s+ o* n$ U7 p! X
1763. 
      
1764. (defun C:D1 (/ p1 p2 p3 p4 side dis wid ang angsile old)
      # v7 F8 O+ x5 q2 V) U9 A* c
1765. (setq old (getvar "OSMODE"))
      
1766. 
      - ^4 u5 p  F8 Q% F0 q% F
1767. (setq p1 (getpoint "\nStart point:"))
      
1768. (setq p2 (getpoint p1 "\nEnd point:"))
      
1769. (setq side (getpoint p2 "\nOpen side"))
      / F% H3 q6 R: V! b, k
1770. 
      
1771. (setq dis (distance p1 p2))
        L  D  A( `2 r& i9 a
1772. (setq ang (angle p1 p2))
      
1773. (if (< ang (angle p1 side))
      0 q0 C5 D, m# ?& I+ u) S
1774.   (setq angside    (/ pi 2) )
      
1775.   (setq angside (- (/ pi 2)))
      ( _4 s% H6 A: @; s* h& {; q7 T
1776. )
      
1777. (if  (>= (- (angle p1 side) ang) pi)
      
1778.   (setq angside (- (/ pi 2)))
      
1779. )
      2 q$ F4 P) j# o; r4 S) Y
1780. (if  (>= (- ANG (angle p1 side) ) pi)
      + D4 @, s+ L9 \
1781.   (setq angside (/ pi 2))
      
1782. )
      5 T) }$ \+ U- s8 D: b
1783. 
      / q! t+ }: V* [/ U7 |9 {
1784. (setq p3 (polar p2 (+ ang angside) dis) )
      * p  ~$ l4 [3 R
1785. (setq p4 (polar p1 (+ ang angside) dis) )
      + j9 n% w& D7 p: }3 r
1786. (setq wid (/ dis 15))
      
1787. 
      ; R/ |. ~7 v; n1 V: l/ r
1788. (setvar "OSMODE" 0)
      
1789. 
      , w% o' k" l( c! b0 F
1790. (command "PLINE" p1 "A" "D" p4 p3 "L" p2
      8 w3 K+ o, e- Q( T( `# \
1791.                   (polar p2 (+ ang pi) wid)
      , t2 C# c# p3 \: n3 {- W2 u5 ^
1792.                   (polar p3 (+ ang pi) wid)
      
1793. "")
      
1794. 
      
1795. (setvar "OSMODE" old)
      ' \6 {6 @4 |# c0 J5 D) o2 h* A5 Z
1796. (princ)
      
1797. )
      7 R% l! O2 I8 L( V1 U
1798. 
      
1799. ;=====================================================================
      
1800. 
      
1801. (defun C:D2 (/ p1 p2 p3 p4 side dis wid ang angsile old)
      
1802. (defun cua1 (pt1 pt2)
      
1803.   (setq p1 pt1
      
1804.         p2 pt2)
      
1805. 
      
1806.   (setq ang (angle p1 p2))
      8 o% p5 @" g% y* s3 H2 h
1807.   (if (< ang (angle p1 side))
      ( z" i, O' a) L! B
1808.    (setq angside    (/ pi 2) )
      
1809.    (setq angside (- (/ pi 2)))
      
1810.   )
      
1811.   (if  (>= (- (angle p1 side) ang) pi)
      
1812.    (setq angside (- (/ pi 2)))
      % ], g! A8 j. X) E
1813.   )
      * x5 D1 e6 Q4 {
1814.   (if  (>= (- ANG (angle p1 side) ) pi)
      3 ]* E* Q/ P$ @
1815.    (setq angside (/ pi 2))
        J- D% ]0 [) p
1816.   )
      
1817. 
      / ^9 v1 C# i' y) Y" g
1818.   (setq p3 (polar p2 (+ ang angside) dis) )
      " [5 @- ^; G& j7 y& M" {1 d# `
1819.   (setq p4 (polar p1 (+ ang angside) dis) )
      
1820.   (setq wid (/ dis 15))
      
1821. 
      5 ^# Q! Q8 X" n: e5 Z  g" x
1822.   (command "PLINE" p1 "A" "D" p4 p3 "L" p2
      
1823.                    (polar p2 (+ ang pi) wid)
      3 ?! y4 s- l8 `* e
1824.                    (polar p3 (+ ang pi) wid)
      8 o4 w' r7 P5 s! H2 U
1825.   "")
      ; Z. J* U( ^7 D
1826. )
      ' A, Y8 J2 ?/ O, g& ?! D2 X! ~
1827. ;=====================================================================
      ) g8 z) m) P/ n: X$ J
1828. (setq old (getvar "OSMODE"))
      
1829. 
      & m3 x& ?/ Z8 N. }
1830. (setq p1 (getpoint "\nStart point:"))
      
1831. (setq p2 (getpoint p1 "\nEnd point:"))
      
1832. (setq side (getpoint p2 "\nOpen side"))
      & m/ A! Y& t% P: L
1833. 
      
1834. (setq dis (distance p1 p2))
      
1835. (setq dis (/ dis 2))
      * N; J! _  C( F7 ?7 h
1836. 
      0 P! v2 J. v1 x% S
1837. (setvar "OSMODE" 0)
      " j0 f6 m; b+ a# M, s7 N
1838. 
      
1839. (setq p1 (polar p1 (angle p1 p2) dis))
      
1840. (cua1 p1 p2)  
      
1841. 
      
1842. (setq ang (+ ang pi))
      4 B4 D* T& ?; X( D9 k: Z
1843. (setq p2 (polar p1 ang dis))
      * ]* U0 Q; j9 q) T! E8 m5 o
1844. ; (setq side (polar p1 () dis))
      % C& O! P# Y4 x; I0 t  Z
1845. (cua1 p1 p2)  
      1 p% W( m8 q% S% B0 T  J
1846. 
      , Z1 m9 V: A+ B; ~
1847. (setvar "OSMODE" old)
      . S# _5 w) d9 |) D6 v
1848. (princ)
      , t) H: \* J" _1 i" U
1849. )
      - r: W4 W/ ^1 Y1 g
1850. 
      
1851. ;=====================================================================
      
1852. ;"Glue" text strings.  All adopt first's properties.
      
1853. ;        Author:
      - t/ o1 y& K6 r& H
1854. ;                Henry C. Francis
      . R/ s, ~% y# Y; Z1 {: {
1855. ;                425 N. Ashe St.
      
1856. ;                Southern Pines, NC 28387
      0 ]1 ]4 d/ a9 J  k9 k1 P' |
1857. ;        http://www.pinehurst.net/~pfrancis
      ' s- F9 w- r9 R6 v
1858. ;        e-mail hfrancis@pinehurst.net
      
1859. ;        All rights reserved.
      
1860. (defun c:gst ( / ename ent1 ent2 old1 oldsl old10 old11 old40 old50 newstr newsl new1 new10 new11)
      
1861. (while
      ) v. K5 t5 E, q, T3 j1 q' z
1862.   (not
      
1863.     (and
      : e  S, Z* U% h& {
1864.       (setq ename1 (car(entsel "\nSelect first text string to join: ")))
      
1865.       (setq ent1 (entget ename1))
      2 ^& U6 H, M: p8 A
1866.       (eq(cdr(assoc 0 ent1))"TEXT")
      4 E* c) F* z$ D3 M! i
1867.     );and
      6 i/ o2 o  ?, Q' T3 |! {7 s8 q$ s
1868.   );not
      
1869. );while
      
1870. (setq old1 (cdr(assoc 1 ent1)))
      
1871. (while
      
1872.   (not
      
1873.     (and
      
1874.       (setq ename2 (car(entsel "\nSelect second text string to join: ")))
      8 ^- b3 j! I5 c) Q0 X
1875.       (setq ent2 (entget ename2))
      9 h" _- [% ?# h% b- Y/ B7 P3 E/ Q
1876.       (eq(cdr(assoc 0 ent2))"TEXT")
      ) m8 x3 p. i3 g2 B
1877.       (not(eq ename1 ename2))
      
1878.     );and
      . |9 b, h# n8 `" u: E  M
1879.   );not
      9 F0 b3 z- @4 [1 N+ ]7 b( R
1880. );while
      
1881. (setq old2 (cdr(assoc 1 ent2)))
      " `3 [/ P) R# e: y9 b, C0 P
1882. (setq new1 (strcat old1 " " old2)
      2 W1 o) A' W6 H& Y9 j
1883.       ent1
      
1884.         (subst (cons 1 new1)
      & g  r5 b. G4 j9 i) [0 f1 b9 C
1885.                (assoc 1 ent1)
      ; n) V' h9 ^) i7 |: _) w
1886.                ent1)
      " D* A# Q1 ]8 p- z
1887. );setq
      
1888. (entmod ent1)
      5 u, j+ \& H3 }# s% K% o+ W' o% Q
1889. (entdel ename2)
      # Q. Q7 N& e4 B! d9 c$ _" u
1890. (princ)
      " X# L1 R! X2 v( j. O, ]2 ?
1891. );defun
      2 k; C7 u5 z* k0 c  Q6 T/ W2 p
1892. 
      ' E* P8 Z4 |. R8 w3 M
1893. ;=====================================================================
      
1894. 
      $ {; f6 b2 w! u" g$ C5 P
1895. (defun c:nt (/ g1 g2 ss1 olderr nterr l i temp e1 e2 new old dd dc)
      
1896. 
      
1897.     (defun nterr (s)
      
1898.         (command "_.UCS" "" "_.UNDO" "E")
      # S; {3 M" k1 R7 N# Q5 V% b2 _
1899.         (setvar "cmdecho" 1)
      
1900.         (setvar "blipmode" 0)
      7 q, \* e0 \/ P1 d
1901.         (setq *error* olderr)
      7 _$ O% s6 |1 J7 c# J
1902.         (setq g1 nil g2 nil ss1 nil e1 nil e2 nil olderr nil
      # t4 u. F, f0 N' F3 H- z; X
1903.                 nterr nil temp nil i nil l nil new nil old nil dd nil dc nil)
      
1904.         (princ)
      - U8 d8 w( D; Q% A
1905.     )
      3 O" b' D0 e9 ~! G, W) r
1906. 
      
1907.     (defun tim_in (dt / p01 p02 ktra)
      " ?7 H3 T$ y  T/ K
1908.         (setq p01 (cdr (assoc 10 (entget dt))))
      
1909.         (setq p02 (cdr (assoc 11 (entget dt))))
        j9 P9 \6 ?/ m0 u) w7 g6 O/ H
1910.         (setq ktra T)
      
1911.         (if (and (> (car p01) (car g1)) (< (car p01) (car g2))
      
1912.                  (> (cadr p01) (cadr g1)) (< (cadr p01) (cadr g2)))
      % e2 X& H, ~# u  L
1913.             (setq ktra nil)
      
1914.         )
      - J1 [. P  N3 U% J' t4 r& r' m
1915.         (if (and (> (car p02) (car g1)) (< (car p02) (car g2))
      # j+ z2 j* N$ T9 h& I' O- A3 q. U$ R
1916.                  (> (cadr p02) (cadr g1)) (< (cadr p02) (cadr g2)))
      
1917.             (setq ktra nil)
      
1918.         )
      
1919.         ktra
      
1920.    )
      8 s; ~; m% D: Z5 H
1921. 
      8 |0 {, H4 B' C1 D
1922.    (defun timdt (dt1 dt2 / p01 p02)
      / }3 G3 A' o) o8 x$ q" w. g
1923.         (setq p01 (cdr (assoc 10 (entget dt2))))
      
1924.         (setq p02 (cdr (assoc 11 (entget dt2))))
      
1925.         (setvar "ucsicon" 0)
      
1926.         (command "_.UCS" "E" dt1)
      
1927.         (setq p01 (trans p01 0 1))
      3 v1 Q( |. t1 V9 s% S
1928.         (setq p02 (trans p02 0 1))
      
1929.         (command "_.UCS" "")
      % |1 U" P) E0 O
1930.         (setvar "ucsicon" 1)
      - H) ^2 `( O1 h' E0 k
1931.         (if (and (equal (cadr p01) 0 0.001) (equal (cadr p02) 0 0.001))
      
1932.                 T
      * u# O' F3 N3 N
1933.                 nil
      
1934.         )
      
1935.    )
      ' k# O) t! J7 u$ J* |/ J" [
1936. 
      ( ]( }/ b: W' [( \  U8 U" b, i4 l
1937.     (defun tim_out (dt / p01 p02 kt)
      
1938.         (setq p01 (cdr (assoc 10 (entget dt))))
      
1939.         (setq p02 (cdr (assoc 11 (entget dt))))
      5 \+ K" t: `; n. }' R
1940.         (if (and (> (car p01) (car g1)) (< (car p01) (car g2))
      
1941.                  (> (cadr p01) (cadr g1)) (< (cadr p01) (cadr g2)))
      , l' T& H8 P$ d- u/ l; X, O
1942.             (setq kt p02)
      
1943.         )
      % Z$ j: M5 K# C6 q: L. K& r6 Q
1944.         (if (and (> (car p02) (car g1)) (< (car p02) (car g2))
      * O; K8 G, }% S) p! [$ K: ]3 U! Q  A
1945.                  (> (cadr p02) (cadr g1)) (< (cadr p02) (cadr g2)))
      
1946.             (setq kt p01)
      
1947.         )
      7 W9 @& c- {6 x$ W: _* }
1948.         kt        
      
1949.    )
      
1950. 
      
1951.     (setvar "cmdecho" 0)
      8 U! E% p/ p) r" B$ x8 V
1952.     (setq olderr *error* *error* nterr)
      
1953.     (command "_.UNDO" "G" "_.UCS" "")
      6 S0 r  Y# U5 f  D, a9 Z' `; y3 r
1954.     (while (null ss1)
      & }5 l3 {9 r% d$ N, _3 U7 ]
1955.         (princ "\nChon tuong muon noi...")
      ( S6 z( i2 Q4 Y0 r* c3 j& D
1956.         (initget 1)
      
1957.         (setq g1 (getpoint "\n>Goc thu nhat:"))
      
1958.         (initget (+ 1 32))
      
1959.         (setq g2 (getcorner g1 "\n>Goc thu hai:"))
      , L* T: x/ y+ s+ I, T
1960.         (setq ss1 (ssget "c" g1 g2 '((0 . "LINE"))))
      
1961.         (if (null ss1) (princ "\nKhong tim thay doi tuong!"))
      
1962.     )
      
1963.    
      
1964.     (setq temp (list (min (car g1) (car g2)) (min (cadr g1) (cadr g2)))
      4 y/ v6 Q. l  `) D0 c0 Y
1965.           g2 (list (max (car g1) (car g2)) (max (cadr g1) (cadr g2)))
      
1966.           g1 temp)
      
1967.    (setq ss1 (ssget "w" g1 g2))
      
1968.    (if ss1 (command "_.ERASE" ss1 ""))
      
1969.    (setq ss1 (ssget "c" g1 g2 '((0 . "LINE"))))
      
1970.    
      
1971.     (setvar "blipmode" 0)
      , Z5 b: g8 a- C1 Y$ Q
1972.         (setq i 0 l (sslength ss1))
      # m: [" O. W8 G" i# `7 m
1973.         (while (< i l)
      + U! ^8 R4 v, ~
1974.            (if (tim_in (ssname ss1 i))
      & x! s5 M$ L' H# Z! U# V
1975.               (progn
      
1976.                     (ssdel (ssname ss1 i) ss1)
      
1977.                     (setq i 0 l (1- l))
      + F% j' p% B) i7 |/ q: u3 x
1978.               )        
      
1979.               (setq i (1+ i))
      0 g, g, K% n$ ^, U2 p
1980.            )
      
1981.         )
      
1982.         (setq l (sslength ss1))
      & |- `0 B: W1 \7 d" p* Z* ]
1983.       (while (>= l 2)
      
1984.         (setq e1 (ssname ss1 0))
      " p: m: ~# g0 _4 t' R+ x
1985.         (ssdel e1 ss1)
      
1986.         (setq e2 nil i 0 l (sslength ss1))
      ( {. U+ ^& A' H/ [/ {' z, k1 z7 K
1987.             (while (< i l)
      ' ~$ k  Z% M( B9 E: x
1988.                 (if (timdt e1 (ssname ss1 i))
      
1989.                     (progn
      : T: e7 \) N, D# a, ?
1990.                         (setq e2 (ssname ss1 i))
      
1991.                              (setq dd (tim_out e1))
      : ]1 @% s1 |+ R% s
1992.                              (setq dc (tim_out e2))
      7 q  N/ \/ H' d2 e! [7 |# U3 ]
1993.                     )
      
1994.                 )
        I/ F9 j, X1 i; I  }9 y
1995.                 (setq i (1+ i))
      
1996.             )
      
1997.             (if e2 (progn
      
1998.                         (ssdel e2 ss1)                        
      
1999.                         (command "_.ERASE" e2 "")
      ' F. q' G8 Y* K* O
2000.                         (setq temp (entget e1))
      7 }; D. Y! ^$ ^
2001.                         (setq old (assoc 10 temp))
      
2002.                         (setq new (cons 10 dd))
      3 {# G5 N/ `6 A' Q
2003.                         (setq temp (subst new old temp))
      2 y  R- X, r, B2 b; @3 S9 b. O
2004.                         (entmod temp)
      
2005.                         (setq temp (entget e1))
      
2006.                         (setq old (assoc 11 temp))
      
2007.                         (setq new (cons 11 dc))
      5 `' F* I) q" }
2008.                         (setq temp (subst new old temp))
      . k% g  E" [& V6 i9 F
2009.                         (entmod temp)
      ; q9 I% Z6 f- a; h& [
2010.                         (redraw e1)
      
2011.                         (setq l (sslength ss1))
      
2012.                    )
      . B/ ~# q! G( P5 r% G% b, o
2013.             )
      & R% L: D6 v, i2 T. [6 m' [1 J
2014.         )
        x# p$ C3 A% U" N4 {% l
2015. 
      ' x! a( X9 s# `) z+ E" @
2016.         (command "_.UCS" "" "_.UNDO" "E")
      ' B$ i! _# k4 k' Y$ G, O$ F
2017.         (setvar "cmdecho" 1)
      
2018.         (setvar "blipmode" 0)
      2 e4 S2 n* g! A- `  i
2019.         (setq *error* olderr)
      2 r5 i/ ]5 s' U# Y: b, E7 V+ {
2020.         (princ)
      
2021. )
      
2022. ;*********************************************************************
      4 }% ]& v1 e" ~9 T' D' X
2023. (defun ketthuc ()
      
2024.         (setvar        "cmdecho"        luuecho)
      
2025.         (setq *error*        luu
      1 W$ i' k: h+ M
2026.                 luu                nil        
      
2027.                 luuecho        nil
      
2028.         );setq
      / S! B1 e8 G/ B8 w: i( Q( b
2029.         (princ)
      
2030. )               
      
2031. ;*********************************************************************
      / Q" q+ u# h8 ^7 ]( A2 x3 @
2032. (defun modau ()
      
2033. (setq         luu *error
      
2034.                 luuecho        (getvar        "cmdecho")
      # q( d, I2 ?) k: L% w
2035.                 *error        (ketthuc)
      4 I: _4 ~6 ^1 B" s  O+ i
2036. )
      
2037. )
      
2038. ;*********************************************************************
      
2039. (defun xulytext (text / kytu ma sokt luusokt lui )
      $ r3 ?8 F8 @9 N/ r) w/ K( Y7 g
2040. (setq         kytu        (substr text (strlen text))
      4 X& P( h* ~# ]/ R. B! X* @
2041.                 ma        (ascii kytu)
      
2042.                 sokt        (read kytu)
        c3 R# D# z' ~, z% H- t! q! c
2043.                 lui        1
      + [6 ?3 Q7 O; C8 M) s
2044. )
      % s9 S& A: K" N, X( R# _5 V$ Y
2045. (if (numberp sokt)
      : C( K$ z+ r1 e$ ~0 l2 ?
2046.                 (progn
      
2047.                         (setq luusokt        (1+ sokt))
      - W' h) F- d/ ]% {9 A! q
2048.                         (if (and         (numberp sokt)
      # E2 B+ }( K' A
2049.                                         (> (strlen text) 1)
      3 ^4 [4 W4 b/ }2 z: e
2050.                             )        
      6 }: a  @' H. t# W" r
2051.                            (progn
      2 D; x( ~  z2 J9 h/ A! h
2052.                                 (setq         kytu        (substr text (1- (strlen text)))
      
2053.                                                 sokt        (read kytu)
      
2054.                                                                                 )
      
2055.                                 (if         (numberp sokt)
      6 L! j2 g8 f' b) [
2056.                                         (setq luusokt (1+        sokt)
      
2057.                                                         lui         2
      9 k) Y! w* C& x
2058. 
      
2059.                                                 )
      : {  j, I+ u, \: }0 J! m
2060.                                 )
      7 B/ f& C4 C5 e" n& g( b
2061.                             );progn        
      ; I# T+ S$ v2 j& D. b1 o) v- w( P
2062.                         )
      & V( v- S9 T, @8 K/ u4 k, q
2063.                         (if (= luusokt        100)        (setq         luusokt        0))
      0 a) D- e7 N/ I# j; B
2064.                         (setq         kytu                (rtos luusokt 2 0)
      
2065.                                        
      ( ~9 @! Y/ i/ K" s3 o; ~
2066.                                         text        (strcat        (substr text 1 (- (strlen text) lui))  kytu)
      
2067.                         )
      4 e8 R' [/ u$ d4 V+ G
2068.                 );progn                        
      * }. E3 s9 g4 ^
2069.                 (if   (or         (= kytu "z")
      
2070.                                 (= kytu "Z")
      
2071.                         )
      
2072.                         (setq         text                (strcat         text        "0")
      
2073.                                 textxl                "0"
      6 l+ c8 ^) |+ M- H1 S1 \, G% B9 T
2074.                         )
      - \7 _2 z; E1 @1 a+ w0 @( X
2075.                         (setq                ma        (1+        ma)
      
2076.                                         text        (strcat        (substr text 1 (1- (strlen text)))  (chr ma))
      
2077.                         )
      1 B# W* f( Q" p3 X+ t
2078.                 );if
      7 f& F9 R' ^* x
2079. );if
      + A! y4 y6 x; ?5 G% ?
2080. )
      
2081. ;*********************************************************************
      
2082. (defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
      
2083. ;Neu doi tuong la text thi tiep tuc
      5 _# L; M2 b; d# l* C* ]
2084. (setq         doituong         (entget  tendoituong)
      - s2 \' G( p+ `
2085.         kieu                (cdr (assoc         0        doituong))
      
2086.         canle                (cdr (assoc         72        doituong))
      0 D% m8 l5 G9 b
2087. )        
      
2088. (if (or (= kieu                "TEXT")
      
2089.         (= kieu         "MTEXT")        
      + O3 V/ F" c# |" ~/ G1 W/ C  v% U
2090.     )         
      
2091.         (progn
      
2092.                 (setq        textxl        (xulytext textxl)
      , {8 @  {& B1 Y; t1 Q# o
2093.                         text        (cons 1 textxl)
      4 e$ \, T% F  ^. x
2094.                         vitri10         (cdr (assoc 10 doituong))
      
2095.                         vitri10         (list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
      
2096.                         vitri10                (cons 10 vitri10)
      ; ^: c' ]0 X  b0 T
2097.                         vitri11         (cdr (assoc 11 doituong))
        c! U. `3 ]( ]  X- X
2098.                         vitri11         (list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
      3 V3 p" m" _* N: w4 I
2099.                         vitri11                (cons 11 vitri11)
      ) g: d# S' S3 F8 ?5 m- S; P6 M2 O
2100.                         dem        0
      
2101.                         dsach        nil
      
2102.                 )
      
2103.                 (foreach tam         doituong
      " p* C0 J7 f8 E/ k( j
2104.                         (cond
      
2105.                                 ((= (car tam)        1)        (setq dsach         (append dsach (list text))))
      $ U" q0 B' ^" V
2106.                                 ((= (car tam)        10)        (setq dsach         (append dsach (list vitri10))))
      ; y( H+ V1 A5 Q5 o  Y3 b
2107.                                 ((= (car tam)        11)        (setq dsach         (append dsach (list vitri11))))
      
2108.                                 ((setq dsach         (append dsach (list tam))))
      ' @6 b$ z& r! z
2109.                         )
      7 k  r6 S1 D1 h5 @! q
2110.                 )
      
2111.                 (entmake dsach)
        Q/ Z7 k' h$ M1 a7 M4 @1 @
2112.         );progn
      + T' U5 w* W; t0 A. Z. b. W/ v
2113. );if
      
2114.         );
      
2115. ;*********************************************************************
      + k8 _1 f* s7 d6 p$ O/ s; s
2116. ;sao doi tuong cu sang vi tri moi
      
2117. 
      5 M1 L# w: f  u+ u) |
2118. (defun copy_dt (tendoituong )
      
2119. (command "copy" tendoituong "" goc toi )
      6 m) N+ l# `! f
2120. );defun
        x  t& }, b* t  q
2121. 
      
2122. ;*********************************************************************
      3 M$ \9 h( s9 x+ l3 f
2123. 
      
2124. (defun c:ct ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
      
2125. ; Khoi dau cua chuong trinh
      2 P+ p, Q- J; f
2126. (princ "\nCopy Inteligent...\n")
      
2127. (setq         luuecho        (getvar        "cmdecho")
      % j, Q# z7 [9 r2 ~7 A! s4 ?
2128.         luu        *error*
      
2129.         *error*        ketthuc
      
2130.         cumdt         (ssget)
      0 ~2 r4 l' Q3 j. N
2131.         dodai         (sslength cumdt)
      6 q; w: E% q- u6 K8 I' ^
2132.         goc                (getpoint "\nSelect base point:")
      , ^) ]+ f9 i, F( C3 P0 i5 V
2133.         thoat                nil
      
2134.         dem                0
      
2135.         textxl                nil
      6 ^1 j1 t6 @* ~
2136. );
      
2137. (setvar "cmdecho" 0)
      4 |* J! u# N! b* I
2138. ; Loc ra duoc ong text de xu ly
      
2139. (while        (and         (= thoat        nil)
      
2140.                 (< dem        dodai)
      * X# E2 S5 Y7 p8 `$ h
2141.         )
      & y( ^1 m1 `! e5 Q7 m# W/ {1 [
2142.         (setq         ten        (ssname cumdt dem)
      
2143.                 dem        (1+         dem)
      
2144.                 doituong (entget ten)
      8 ]% f. G* U$ y5 d. a
2145.                 kieu         (cdr (assoc         0        doituong))                        
      ) ~5 I' g1 _, u0 |$ H8 I9 f# J
2146.         )
      
2147.         
      # h+ W+ l0 T+ D# N! K
2148.         (if (or (= kieu                "TEXT")
      7 W; c# u; d/ _. @
2149.                 (= kieu         "MTEXT")        
      8 E) ^9 A* u. @* C
2150.                 )
      # a, I9 e) X/ h
2151.                 (setq         thoat        T
      
2152.                         textxl         (cdr (assoc 1 doituong))         
      # \$ e* S  V  d7 I, g0 [
2153.                 )
      
2154.         )
      ; K$ r4 E2 t" d( d$ L
2155. );
      3 O& B$ e& ^9 X# Y( M% ]6 t' N
2156. (while T
      
2157. (setq        toi                (getpoint "\nSelect next point: " goc)
      7 p! N1 k9 l0 Z5 K
2158.         vitrilech         (list         (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
      2 q5 O. I% v. s& U" H+ Y2 H$ @
2159.         dem                0
      & O5 e1 K. m7 |. `6 }2 E
2160. )
      : l6 J0 o, ^# {9 K, `3 r- ]' f
2161. (while        (< dem dodai)
      $ v3 |! `7 m! p* D* L/ l
2162.         (setq         ten        (ssname cumdt dem)
      
2163.                 dem        (1+         dem)
      
2164.                 doituong (entget ten)
      
2165.                 kieu         (cdr (assoc         0        doituong))                        
      ! u* X4 C' M. m$ Z3 C$ i$ l2 p3 ^
2166.         )
      
2167. 
      & f7 }" i- s! R4 }
2168.         (if (or (= kieu                "TEXT")
      0 K: |7 I2 E! A$ i
2169.                 (= kieu         "MTEXT")        
      
2170.                 )
      6 s) T1 ]5 c/ w# ~9 r2 f
2171.                 (doitext        ten)
      3 z7 b- G& T* g0 D7 V
2172.                 (copy_dt        ten)
      
2173. 
      
2174.         );if
      
2175. )
      
2176. );while
      4 C% A8 o' m- O
2177. (ketthuc)
      
2178. );defun
      
2179. (princ "Type \"DG\" to start")
      + N- {- M* {- ^/ T7 O" n. K
2180. ;Note: bien toan cuc: textxl vitrilech
      
2181. 
      / J5 z( D7 w$ F) C
2182. ;=====================================================================
      
2183. ;;; PLJOINFUZZ.LSP
      3 k+ G2 b$ O/ s% E  ^* M/ Z
2184. ;;; Joins lines, arcs and polylines using a fuzz distance
      
2185. ;;; If only one object is selected it tries to join to all objects that are possible
      
2186. ;;; By Jimmy Bergmark
      
2187. ;;; Copyright (C) 2003-2004 JTB World, All Rights Reserved
      ! `3 s. x( T; V. L* m; @$ s
2188. ;;; Website: www.jtbworld.com
      
2189. ;;; E-mail: info@jtbworld.com
      
2190. ;;; Tested on AutoCAD 2002,2004 and 2005
      
2191. ;;; Latest revision made 2004-11-11
      
2192. ;;; Minor code cosmetic change made 2004-11-13
      
2193. ;;; Bug corrected 2004-12-23
      - _2 {; q6 d' W7 f5 }
2194. 
      4 R5 P2 j0 v5 E/ U- l- G, D! b; f
2195. (defun c:jf () (c:pljoinfuzz)) ; this line can be commented out if there is an existing command called jf
      $ _! ^, b, F  E; U, f0 {" u
2196. (defun c:pljoinfuzz (/ ss1 entLine objType oldcmdecho oldpeditaccept fuzz okObjects)
      
2197.   (setq oldcmdecho (getvar "cmdecho"))
      ) F+ c) a5 H0 {. v  Y( h
2198.   (setq oldpeditaccept (getvar "PEDITACCEPT"))
      
2199.   (setvar "cmdecho" 0)
      
2200.   (setq A2k4 (>= (substr (getvar "ACADVER") 1 2) "16"))
      1 b+ C0 c% l4 N& C
2201.   (if A2k4 (setvar "PEDITACCEPT" 0))
      
2202.   (setq        okObjects '((0 . "LINE,ARC,POLYLINE,LWPOLYLINE")))
      7 o0 r( O7 v& P5 j9 \9 T0 C  [. K
2203.   (princ "\nSelect object to join: ")
      
2204.   (setq ss1 (ssget okObjects))
      ) v# `) c, D0 E! q
2205.   (setq fuzz (getdist "\nFuzz distance <0>: "))
      # b( {; i1 a% Y5 q/ _
2206.   (if (= fuzz nil) (setq fuzz 0))
      " y7 g. F9 n8 g4 o' R; G
2207.   (if (/= ss1 nil)
      / U) \3 Y( _7 k. O* m9 J  q% ^
2208.       (progn
      ; N) Y, f: J& {. W: N( A2 g
2209.         (setq objType (cdr (assoc 0 (entget (setq entLine (ssname ss1 0))))))
      
2210.         (if (= (sslength ss1) 1) (setq ss1 (ssget "X" okObjects)))
      
2211.         (if (member objType '("LINE" "ARC"))
      
2212.           (command "_.pedit" "_M" ss1 "" "_Y" "_J" "_J" "_B" fuzz "")
      2 V! T) E8 {$ u6 h/ m: j6 b# ]( ~( u
2213.           (command "_.pedit" "_M" ss1 "" "_J" "_J" "_B" fuzz "")
      $ A' J  L* g' f! o4 u$ \6 z3 u+ z
2214.         )
      
2215.       )
      . Q; @! P. r, c% @. G& T9 N( C
2216.   )
      
2217.   (setvar "cmdecho" oldcmdecho)
      
2218.   (if A2k4 (setvar "PEDITACCEPT" oldpeditaccept))
      
2219.   (princ)
      % n2 \" R5 a, Z2 m3 u5 o7 }
2220. )
      * u/ B5 ]. ]* R+ W
2221. 
      # p+ p" j/ B. \. B# U* T4 S
2222. ;===========================VE CAO TRINH===========================
      , c7 M( m; I: \2 W; y& N/ o
2223. 
      
2224. (DEFUN C:Cotcao (/ CMD PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 NPI TX DX DY TL OSM OLL
      ' B. @" o5 i* j) M! N$ J
2225.                 CRST RSIZE TSIZE STR PRMT FCH NBC OLDERR)
      3 |6 N* P/ P+ k. U
2226. (SETQ OLDERR *error*
      
2227.       *error* loisb)
      
2228. (command "layer" "m" "dim" "c" "" """")
      
2229. (SETQ CMD (GETVAR "CMDECHO"))
      6 _* I* @% \& I
2230. (SETQ NBC (GETVAR "CLAYER"))
      6 ]2 U. ]9 y& _1 }1 {) a
2231. (SETQ OSM (GETVAR "OSMODE"))
      , N  A6 M2 O5 C
2232. (SETVAR "CMDECHO" 0)
      . g4 I$ ?2 R! [0 k' x+ ^
2233. (SETQ PT1 (GETPOINT "\nDiem cao trinh:"))
      
2234. (SETQ TX (GETSTRING "\nCao trinh:"))
      
2235. (SETQ FCH (SUBSTR TX 1 1))
      
2236. (IF (= FCH "@") (SETQ TX (STRCAT "%%P" (SUBSTR TX 2 (- (STRLEN TX) 1)))))
      
2237. (SETQ CRST (GETVAR "TEXTSTYLE"))
      
2238. (SETQ RSIZE (CDR (ASSOC 40 (TBLSEARCH "STYLE" CRST))))
      
2239. (SETQ TSIZE (GETVAR "TEXTSIZE"))
      
2240. (SETQ STR (RTOS TSIZE 2))
      ! X2 v) Y7 ^) k- y
2241. (SETQ PRMT (STRCAT "\nText height <" STR ">:"))
      8 ^! ^3 {! o1 h# F+ ^
2242. (IF (= RSIZE 0)
      , ?3 W% r0 w& J( {/ o; [9 _' c
2243.   (PROGN
      
2244.         (INITGET 4)
      
2245.         (SETQ TSIZE (GETREAL PRMT))
      ) b! R* ]; O# _- `, T* ?
2246.         (IF (= TSIZE NIL) (SETQ TSIZE (GETVAR "TEXTSIZE"))
      . K. k- J( l. B8 R
2247.                           (SETVAR "TEXTSIZE" TSIZE))
      
2248.   )
      
2249. )
      
2250. (PRINC)
      : v5 P( _$ `5 i5 }
2251. (SETQ TL (/ (GETVAR "TEXTSIZE") 2))
      ' t$ c% r+ R" B' S% U; {
2252. (SETVAR "OSMODE" 0)
      ; Y) E# e" ^5 G* w. h' w
2253. (SETQ DX (CAAR (CDR (TEXTBOX (LIST (CONS 1 TX))))))
      
2254. (SETQ NPI (/ PI 2))
      % m1 |8 i! `% M4 I* Z7 j$ s  X
2255. (SETQ PT4 (POLAR PT1 NPI (* 1 TL)))
      
2256. (SETQ PT2 (POLAR PT4 PI (* 2 TL)))
      
2257. (SETQ PT3 (POLAR PT4 0 (* 2 TL)))
      9 ]5 n/ b1 [& l
2258. (SETQ PT5 (POLAR PT4 NPI (* 5 TL)))
      
2259. (SETQ PT6 (POLAR PT2 NPI  TL))
      " a6 j/ Q3 l8 a' t0 y0 G
2260. (SETQ PT7 (POLAR PT6 0 (+ (* 3.7 TL) DX)))
      
2261. (SETQ PT8 (POLAR PT6 NPI (* 1 TL)))
      
2262. (SETQ PT8 (POLAR PT8 0 (* 2.5 TL)))
      ' v6 b: J. J! u' P
2263. (SETQ PT9 (POLAR PT1 pi (* 2 TL)))
      # Z0 _0 v* u4 I
2264. (SETQ PT10 (POLAR PT1 0 (* 2 TL)))
      % w) y! S9 F" f: W  Q# _% D4 `
2265. (COMMAND "COLOR" "7" "")
      - y' s$ P4 ?7 [
2266. (COMMAND "STYLE" "COTES"  "Verdana" "" "" "" "" "")
        C- K, x1 h. P5 n1 n
2267. (IF (= RSIZE 0)(COMMAND "TEXT" PT8 TSIZE 0 tX) (COMMAND "TEXT" PT8 0 TX))
      9 B. @+ E9 _0 V( w2 t. r
2268. (COMMAND "COLOR" "BYLAYER" "")
      
2269. (COMMAND "SOLID" PT1 PT2 PT4 "" "" "pLINE"  PT1 pt3 pt2  "")
      
2270. (COMMAND "COLOR" "BYLAYER" "")
      2 g$ s1 `' `  @' g
2271. (COMMAND "pLINE" PT1 PT5 "" "pLINE" PT6 PT7 "" "pLINE" pt9 pt10"")
      : s. Y7 O0 k7 |# g/ J
2272. (SETVAR "CLAYER" "0")
      6 p8 |: A& y$ R+ L* [( Z3 e
2273. (command "ddedit" pause)
      
2274. (COMMAND "COLOR" "BYLAYER" "")
      
2275. (SETVAR "CMDECHO" CMD)
      0 m( `: X1 L' y; T8 x! p
2276. (SETVAR "CLAYER" NBC)
      
2277. (SETVAR "OSMODE" OSM)
      
2278. (PRINC)
      2 Z3 l: Y# h+ n% w9 P) L3 |2 ^
2279. )
      
2280. 
      5 ~6 c* t3 l/ H( w2 j
2281. ;;; =========================== VE NET CAT CHEO (GC) =============================
      3 _) ~- Y- i, n- y- J
2282. 
      
2283. (Defun c:G1(/ p1 p2 p3 p4 p5 p6 p11 p12 l ang)
      
2284.         (setq x (getvar "osmode"))
      6 @  j, u; [& `& n9 o! B* ^
2285.         (setq p1 (getpoint "First point : ")
      4 U- u, H  Z/ H* f. E1 q
2286.               p2 (getpoint p1 "Second point : "))
      
2287.         (setq l (distance p1 p2))
      9 g9 i: O; F' v* e7 V- e8 X1 C
2288.         (setq p11 (polar p1 (angle p2 p1) (/ l 5))
      7 ^' v6 f+ a' i8 [. h: h
2289.               p12 (polar p2 (angle p1 p2) (/ l 5)))
      3 u+ C1 j" U5 v" r3 h4 F  N- e, k6 x
2290.         (setq ang (angle p1 p2))
      ) _/ R2 W9 p- S4 v; i0 |$ O- g
2291.         (setq p3 (polar p1 ang (/ l 2.5))
      8 u0 u& h( L! ]7 L  d
2292.               p4 (polar p3 (+ (/ pi 2) ang) (/ l 5))
      9 s/ A3 Z, e" f4 K
2293.               p5 (polar p3 ang (/ l 5))
      
2294.                 p6 (polar p5 (- ang (/ pi 2)) (/ l 5)))
      + y+ a. ]/ F/ H# s3 L! C5 D* l
2295.         (setvar "osmode" 0)
      2 \* }$ d3 R2 ~2 }3 I
2296. (command "pline" p11 p3 p4 p6 p5 p12 "")
      
2297. (setvar "osmode" x)
      ( D; R, Z5 M9 A0 D9 v
2298. )
      ' X8 B% u3 J) V9 ]6 |% _5 D
2299. ;----------------------------------------------------------------------------------
      ! Z( Y8 ~1 j( Q
2300. (Defun C:G2 (/  ps1  ps2  pf1  pf2  pf3  pf4  pf5  pf6
      + Z" V# U- v4 Y% [' t* C6 b5 I8 r
2301.    pf7  pf8  sb   sh   se   ang  old_osmode);   (setq old_osmode (getvar "OSMODE"))
      
2302.    (setq ps1 (getpoint "\Chon diem thu nhat: "))
      8 Y& C( F* m: H' r; ]
2303.    (setq ps2 (getpoint ps1 "\nChon diem tiep theo: "))
      
2304.    (setq sb 50.0 sh 200.0 se 20.0)
      ' J8 @: K- D& e* g) ^6 r
2305.    (setq ang (angle ps1 ps2))
      - F: k4 u, s# {
2306.    (setq pf1 (polar ps1 ang (- 0.0 se)))
      
2307.    (setq pf2 (polar ps1 ang (/ (- (distance ps1 ps2) sb) 2.0) ))
      3 W0 o' n! Y1 F5 i
2308.    (setq pf3 (polar pf2 (+ ang (/ pi 2)) (/ sh 2.0)))
      0 ^  f3 r& I3 I
2309.    (setq pf5 (polar pf2 ang sb))
      
2310.    (setq pf4 (polar pf5 (- ang (/ pi 2)) (/ sh 2.0)))
      + f# Z" T6 m. l9 w' C
2311.    (setq pf6 (polar ps2 ang se))
      
2312.    (setvar "OSMODE" 0)
      
2313.    (setvar "BLIPMODE" 0)
      3 p/ E5 _9 c) `% T0 ^
2314.    (command "PLINE" pf1 pf2 pf3 pf4 pf5 pf6 "")
      * }, s6 _3 ^! G- d" q% j) `
2315.    (setvar "OSMODE" 703)
      
2316.    (princ) )
      
2317. ;----------------------------------------------------------------------------------
      ; U' S2 l" i5 x6 N5 t/ o  k( ]7 L. @! Z
2318. (Defun C:G3 (/  ps1  ps2  pf1  pf2  pf3  pf4  pf5  pf6
      # _, B" z! S- x0 h0 K  K
2319.    pf7  pf8  sb   sh   se   ang  old_osmode);   (setq old_osmode (getvar "OSMODE"))
      0 `3 ^* l  @6 ]
2320.    (setq ps1 (getpoint "\Chon diem thu nhat: "))
      
2321.    (setq ps2 (getpoint ps1 "\nChon diem tiep theo: "))
      
2322.    (setq sb 100.0 sh 150.0 se 20.0)
      + N$ O, {( Z7 s9 n
2323.    (setq ang (angle ps1 ps2))
      
2324.    (setq pf1 (polar ps1 ang (- 0.0 se)))
      
2325.    (setq pf2 (polar ps1 ang (/ (- (distance ps1 ps2) sb) 2.0) ))
      ! g) w& K5 h4 ^1 L# {% w
2326.    (setq pf3 (polar pf2 (+ ang (/ pi 2)) (/ sh 2.0)))
      
2327.    (setq pf5 (polar pf2 ang sb))
      1 A2 n3 ]: Y, j7 ?7 H. R; j' c
2328.    (setq pf4 (polar pf5 (- ang (/ pi 2)) (/ sh 2.0)))
      
2329.    (setq pf6 (polar ps2 ang se))
      
2330.    (setvar "OSMODE" 0)
      - F5 A, @( t% W% }
2331.    (setvar "BLIPMODE" 0)
      
2332.    (command "PLINE" pf1 pf2 pf3 pf4 pf5 pf6 "")
      % e7 T' k8 F5 e
2333.    (setvar "OSMODE" 703)
      
2334.    (princ) )
      
2335. ;----------------------------------------------------------------------------------
      ; o5 `& t$ D: w5 `+ s% Q
2336. (Defun C:G4 (/  ps1  ps2  pf1  pf2  pf3  pf4  pf5  pf6
      5 ^. w7 W9 h( j" `2 z% _# Y" a/ t' m
2337.    pf7  pf8  sb   sh   se   ang  old_osmode);   (setq old_osmode (getvar "OSMODE"))
      " |2 r$ I3 [6 D1 t, E! o) X
2338.    (setq ps1 (getpoint "\Chon diem thu nhat: "))
      : F0 y0 Y) s$ _# C% F5 a0 p# I* X& Z
2339.    (setq ps2 (getpoint ps1 "\nChon diem tiep theo: "))
      
2340.    (setq sb 100.0 sh 250.0 se 20.0)
      
2341.    (setq ang (angle ps1 ps2))
      ! X' F  b  X) |' R" ]. o
2342.    (setq pf1 (polar ps1 ang (- 0.0 se)))
      " F1 X7 B4 x) x4 z  F' m* S
2343.    (setq pf2 (polar ps1 ang (/ (- (distance ps1 ps2) sb) 2.0) ))
      1 `8 q% T& x3 f8 J. g) V
2344.    (setq pf3 (polar pf2 (+ ang (/ pi 2)) (/ sh 2.0)))
      
2345.    (setq pf5 (polar pf2 ang sb))
      
2346.    (setq pf4 (polar pf5 (- ang (/ pi 2)) (/ sh 2.0)))
      
2347.    (setq pf6 (polar ps2 ang se))
      
2348.    (setvar "OSMODE" 0)
      1 a$ @0 o3 _. y2 Y* }" g5 x( l
2349.    (setvar "BLIPMODE" 0)
      
2350.    (command "PLINE" pf1 pf2 pf3 pf4 pf5 pf6 "")
      * P: B  f& G+ H2 I1 q% {- v1 w
2351.    (setvar "OSMODE" 703)
      - I6 f1 I3 T7 s( q
2352.    (princ) )
      
2353. 
      
2354. ;==================================================================================
      
2355. (defun c:ang (/ ent pt1 pt2 ang)
        k9 i0 [1 y0 T: I7 n# B4 h: X
2356.    (setq cmd (getvar "cmdecho"))
      * L3 Z' `' D  g$ Q3 l5 e7 R
2357.   (setvar "cmdecho" 1)
      + ]8 _* H, m5 t( E" j
2358.   (prompt (strcat"\nThay doi truc toa do theo duong thang chon truoc"))
      
2359.   (setq ent (entsel "\nChon duong thang:"))
      
2360.   (if ent
      
2361.    (progn
      ; c. V! A! @3 m8 m* E
2362.     (setq ent (entget (car ent)))
      
2363.     (setq pt1 (cdr (assoc 10 ent)))
        N7 I* m2 ^5 l5 @
2364.     (setq pt2 (cdr (assoc 11 ent)))
      
2365.     (setq ang (angle pt1 pt2))
      1 j' c( {! s4 ~) {9 c. p9 l1 S2 v
2366.     (setq ang (/ (* ang 180.0) pi))
      
2367.     (setvar "cmdecho" 0)
      
2368.     (command "setvar" "snapang" ang)
      % q( ]$ X( g# ?, g
2369.     (princ "\nGoc cua truc toa do moi : ")
      
2370.     (princ ang)
      
2371.    )
      
2372.   )
      
2373.   (setvar "cmdecho" cmd)
      ! Z8 A4 X( k( d
2374.   (princ)
      " T0 i- ^) _6 g! h9 a; u
2375. )
      
2376. ;==================================================================================
      ( l& r( s& E* w6 u7 d
2377. ;==============================   KY HIEU DOI XUNG   ==============================
      
2378. ;==================================================================================
      
2379. 
      
2380. (DEFUN C:DX (/ CMD OSM OLDERR PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 PT9
      
2381.                 SZ G45 G135 G90 G180 SS loi)
      
2382. (defun loi (s)
      7 z+ B8 H* F1 w
2383. (if (= s "Function cancelled")
      
2384.      (princ)
      2 N0 Y7 w4 h6 p' m
2385.      (princ (strcat "Error:" s))
        f9 G/ p1 [7 E
2386. )
      
2387.          (SETVAR "CMDECHO" CMD)
      / S: A) o8 g' n  s1 p
2388.          (SETVAR "OSMODE" OSM)
      
2389.         (SETQ *error* OLDERR)
      
2390.          (PRINC)
      
2391. )
      
2392. (SETQ CMD (GETVAR "CMDECHO"))
      + ^! I* g  o2 g1 L
2393. (SETQ OSM (GETVAR "OSMODE"))
      8 G2 h( S& h) N
2394. (SETVAR "CMDECHO" 0)
      ' E& r! A# R" ~& x- k; a
2395. (SETQ OLDERR *error*
      8 G: b6 H' W- w/ @( o) T
2396.         *error* loi)
      
2397. (SETQ SZ (GETREAL "Size <1>:"))
      ( P9 G' o: j9 U
2398. (IF (= SZ nil) (SETQ SZ 100))
      # @: B0 ^- N/ X' c# l/ v) U
2399. (SETQ G45 (/ PI 4))
      ; {8 k& Z- l* H) V! U
2400. (SETQ G135 (* 3 (/ PI 4)))
      5 D3 T9 C$ ^! e- X9 P3 L9 {
2401. (SETQ G90 (- G45 (/ PI 2)))
      1 k) G+ R' y* e+ X0 e+ P
2402. (SETQ G180 (+ G135 (/ PI 2)))
      6 g6 @6 X7 q9 X# ~6 p: V
2403. (SETQ PT1 (GETPOINT "\nDiem doi xung:"))
      3 e$ f6 Z6 f* L+ {1 j$ y: I
2404. (SETVAR "OSMODE" 0)
      % {! r: y$ F4 \! x8 y: h* d: I
2405. (SETQ PT2 (POLAR PT1 G45 (* 2 SZ)))
      + i$ y% s+ N8 g1 R
2406. (SETQ PT3 (POLAR PT2 G90 (* 2 SZ)))
      ! z$ T' P  q, i, |, T
2407. (SETQ PT4 (POLAR PT1 G45 (* 1 SZ)))
      
2408. (SETQ PT5 (POLAR PT1 G135 (* 2 SZ)))
      4 K( S8 c# h6 y' G/ E3 u
2409. (SETQ PT6 (POLAR PT5 G180 (* 2 SZ)))
      : d: I  U2 @) z9 E: r) a+ {# I
2410. (SETQ PT7 (POLAR PT1 G135 (* 1 SZ)))
      . T, R  U0 p% {
2411. (SETQ PT8 (POLAR PT1 G45 (* -0.7 SZ)))
      
2412. (SETQ PT9 (POLAR PT1 G135 (* -0.7 SZ)))
      / [8 m1 d0 d5 Z  `3 Z0 m) h4 r
2413. (PRINC "\nGoc quay:")
      0 r& Y8 {, a2 M. c& K
2414. (SETQ SS (SSADD))
      
2415. (command "layer" "m" "Dim" "c" "" """")
      
2416. (COMMAND "COLOR" "1" "")
      % d0 M' a+ O/ S, X" c9 w
2417. (COMMAND "LINE" PT8 PT2 "")
      
2418. (SETQ SS (SSADD (ENTLAST) SS))
      * H9 |. H% b# E1 c5 ~/ k
2419. (COMMAND "LINE" PT9 PT5 "")
      & t. C7 s# M" g2 ^+ _) S
2420. (SETQ SS (SSADD (ENTLAST) SS))
      0 i4 V) `( W. N8 @
2421. (COMMAND "COLOR" "1" "")
      
2422. (COMMAND "SOLID" PT2 PT3 PT4 "" "")
      # U: t& u$ N; k. j3 _
2423. (SETQ SS (SSADD (ENTLAST) SS))
      " k6 M! ~4 v# d- t% @, D
2424. (COMMAND "SOLID" PT5 PT6 PT7 "" "")
      4 w' _9 |5 _  ]3 ]2 _
2425. (SETQ SS (SSADD (ENTLAST) SS))
      # P# P+ H5 N5 {& [: m4 }
2426. (COMMAND "ROTATE" SS "" PT1 PAUSE)
      
2427. (COMMAND "COLOR" "BYLAYER" "")
      - S" o/ f( T$ O9 g- s3 O- _
2428. (SETVAR "CMDECHO" CMD)
        a3 O- ?! H" M4 e* U
2429. (SETVAR "OSMODE" OSM)
      
2430. (SETQ *error* OLDERR)
      3 W" ^3 p& |# y9 W) w+ q. }3 O& [7 `7 B
2431. (PRINC)
      : m* ?* ~' W: d3 Q
2432. )
      
2433. 
      
2434. ;==================================================================================
      0 Q$ v! U# Q$ R% J7 |
2435. ;=================================   KY HIEU TRUC   ===============================
      / l9 K# L5 d$ K9 v4 P/ [, V, K( u
2436. ;==================================================================================
      ) I1 P: C/ V1 X# ]! v7 P
2437. 
      
2438. (defun C:vetruc ()
      
2439. (setq bk (getvar "USERR3"))
      * O; K$ \( |, d* d! g
2440. (if (= bk 0)
      0 ?& M8 U( J& K* }) \1 t
2441.   (progn
      4 n4 J; A1 ~3 D- _
2442.     (setq cont "1")
      
2443.     (setvar "USERR3" 1)
      4 c! e+ s% @2 n' U. I" m* a2 j+ M
2444.     )
      / d* _6 D) s, f9 [; D) d
2445.         (setq cont (rtos bk))
      
2446. )
      
2447. (setq pt1 (getpoint "\n Nhap diem dat:"))
      ) a4 W5 C% w% L! m, S. I
2448. (command "layer" "m" "Dim" "c" "" """")
      
2449. (command "osnap"  "")
      4 q4 S& ?5 l0 A( D' u
2450. (COMMAND "COLOR" "7" "")
      : T* D5 p' u9 P% k8 \7 a
2451. (command "circle" pt1 150 "")
      8 ?- M& ]+ A# M
2452. (setq pt2 (polar pt1 0 150))
      + U7 e# D$ k0 S+ ]* t
2453. (setq pt3 (polar pt1 (/ pi 1) 150))
      * S% u: v" @, W) `
2454. (setq pt4 (polar pt1 0 300))
      ( Q7 y% u* P0 o. y
2455. (setq pt5 (polar pt1 (/ pi 1) 300))
      4 J: R/ n; ]% g  E( R
2456. (setq pt6 (polar pt1 (- 0 (/ pi 2)) 150))
      
2457. (setq pt7 (polar pt1 (- 0 (/ pi 2)) 300))
      + m, T! O' d4 U4 |2 |) {
2458. (setq pt8 (polar pt1 (/ pi 2) 150))
      ; K% P* S! i# E" e+ ^+ j
2459. (setq pt9 (polar pt1 (/ pi 2) 300))
      ! s- k, ?9 g+ q6 i! u4 a. `& A
2460. (setq pt10 (polar pt1 0 150))
      
2461. (setq pt11 (polar pt1 (/ pi 4) 150))
      % H, Q( h: U, A& X* u; I2 \
2462. (COMMAND "COLOR" "BYLAYER" "")
      ; o: a& u. Z% g% n- P2 Q
2463. (command "line" pt2 pt4 "")
      
2464. (command "line" pt6 pt7 "")
      1 Q4 ~- \: r+ Q/ `
2465. (command "line" pt3 pt5 "")
      / A6 }4 Z2 {3 O+ F5 n( |# ^0 J4 Z
2466. (command "line" pt8 pt9 "")
      
2467. (setq dk (strcat "\n Size:<"cont">"))
      ( x! W6 ?6 z  l' \" w
2468. (setq bk (getreal dk))
      2 ^% r  T% W. Y
2469. (if (= bk nil)
      
2470. (progn
      
2471.   (setq bk (getvar "USERR3"))
      % E& \& N) W6 ?) j3 p  o  t+ Z
2472.         )
      
2473.   (setvar "USERR3" bk)
      
2474.   )
      ( _! F! O- z1 m3 {
2475. (command "scale" pt4 pt5 pt7 pt9 pt11"" pt1 bk"")
      ' M) r5 f6 S! H% c' x0 C0 E
2476. (COMMAND "COLOR" "7" "")
      4 m( I. F, ~5 K+ t7 V
2477. (COMMAND "STYLE" "Truc"  "impact" "" "" "" "" "")
      ) L8 z7 d/ A! w
2478. (command "text" "j" "mc" pt1 (* 150 bk) pt10 "A" "")
      9 Z6 E0 P) m$ D2 }
2479. (COMMAND "COLOR" "BYLAYER" "")
      * h/ n6 A! x6 u3 |' d2 Z
2480. )
      & P4 g- U" C7 A" s/ e- H; _) L. g/ X
2481. 
      
2482. ;=====================================================================
        ^8 @6 O3 _: t+ Q
2483. ;CA - Reverses the case of text.  (Upper to Lower and Lower to Upper.)
      ! W/ a4 I- M; r# E: e" a. N
2484. ;
      
2485. ;Jeffery P Sanders
      
2486. ;
      
2487. (defun C:CA(/ en enlist tx newtx cnt tp asc note)
      4 \6 a" D" H4 q+ s6 B" D6 H
2488. (setvar "cmdecho" 0)
      
2489. (if(setq en(entsel))
      
2490.    (progn
      0 t& O- |7 K; I/ W
2491.       (setq enlist(entget(car en)))
      ' M. F1 W% a4 I4 F6 O
2492.       (if(= "TEXT"(cdr(assoc 0 enlist)))
      
2493.         (progn
      
2494.           (setq tx(cdr(assoc 1 enlist))
      
2495.              newtx "" cnt(strlen tx)
      ! m/ {. N, P7 n  ]/ \* `5 t; \
2496.               note "\n...CASE Reversed. \n "
      
2497.           )
      
2498.           (while (> cnt 0)
        P. x" P2 e, K
2499.              (setq tp(substr tx cnt 1))
      0 {4 u6 U0 k4 V
2500.              (setq asc(ascii tp))
      
2501.              (if (> asc 96)
      
2502.                (setq tp(strcase tp))
      . w+ Y* e" l7 F9 R
2503.                (setq tp(strcase tp T))
      
2504.              )
      
2505.              (setq newtx(strcat tp newtx))
      6 I; X! T( G8 j1 u, ]
2506.              (setq cnt(- cnt 1))
      
2507.           )
      . n, Y" l( E7 j* Y
2508.           (setq enlist(subst(cons 1 newtx)(assoc 1 enlist)enlist))
      
2509.           (entmod enlist)
      
2510.         )
      & c2 r0 q  O: G  U
2511.         (setq note "\n....Text Only Please. \n ")
      ( d  _( \) P" g9 @8 @  v7 V
2512.       )
      1 u. T# Y- E" g' }/ G4 m0 @
2513.    )
      ' b8 a6 Y! Z/ f, H* w
2514.    (setq note "\n....Nothing Selected. \n ")
      
2515.   )
        a; \# H9 w. e" f+ B- n! Q
2516.   (setvar "cmdecho" 1)
      
2517.   (princ note)
      
2518.   (princ)
      1 X( v6 G' c% g: J( _+ Z
2519. )
      8 y) L1 _* r0 \7 r
2520. 
      5 P8 Q  M2 R& N/ q  e4 ?% X
2521. ;=====================================================================
      
2522. ;==================== NEW TEXT STYLE UPDATE ==========================
      
2523. ;=====================================================================
      
2524. 
      2 c; N* Y1 v+ [2 J9 A
2525. (defun c:nS (/ tdt ssdt sodt index)
      
2526. (defun ObjName (ssdt /)
      % U1 y" Q7 r9 Z4 I' X4 h
2527. (cdr (assoc '0 (entget ssdt)))
      2 e7 h) W, x( C; F) D: t; A# ~- R
2528. )
      
2529. (defun MoPL (ssdt /)
      
2530. (= (cdr (assoc '70 (entget ssdt))) 0)
      ( l$ N, k2 N: H, g( {
2531. )
      : z7 `& \; f! t7 _: |
2532. (defun NoiPL (ssdt /)
      
2533. (if (MoPL ssdt)
      
2534. (command ".PEDIT" ssdt "J" "All" "" "X")
      
2535. )
      
2536. )
      % S7 w  R) i9 H3 p- N' J
2537. (defun NoiLC (ssdt /)
      
2538. (command ".PEDIT" ssdt "Y" "J" "All" "" "X")
      , n" y: Q; x) m, B7 n! S- I
2539. )
      6 o8 Q% D6 [- V4 Z8 G; i1 e0 b
2540. (setq
      , T2 u" G+ {, [
2541. tdt (ssget)
      * s9 O  g0 Q/ u! B9 H4 d( G& T! L
2542. sodt (sslength tdt)
      
2543. index 0
      
2544. )
      # c! p+ `# {, x1 U3 U) q' j
2545. (repeat sodt
      
2546. (setq
      2 ^  |! M* C% `# U
2547. ssdt (ssname tdt index)
      
2548. index (1+ index)
      
2549. )
      / E# w$ s' E: F  m1 K5 e& ?+ R' N
2550. (if (or (= (Objname ssdt) "LWPOLYLINE")
      ' {  c; p( z, G' E4 f5 F
2551. (= (Objname ssdt) "POLYLINE")
      
2552. )
      
2553. (NoiPL ssdt)
      0 N9 |. H3 M# [6 P! j9 j
2554. )
      ' S4 R8 p( b  B# S4 F; ^. j& j
2555. (if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
      
2556. (NoiLC ssdt)
      ( a/ g1 p& T' u4 C1 M% N
2557. )
      
2558. )
      
2559. (princ)
      & m" F$ |/ r; ]. {/ b3 m
2560. )
      
2561. 
      7 H% t, d8 Q- X  G1 C9 S/ @7 h
2562. ;=====================================================================
      " P2 x# _1 l+ Q$ ^# L; |+ [" d
2563. ;;; AREAM.LSP
      
2564. ;;; Function: Calculates the total area of selected objects
      
2565. ;;; By Jimmy Bergmark
      # _) N4 I' W% }) C, b/ w
2566. ;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
        Q' y0 X& ?+ Z- N' j) n6 ?
2567. ;;; Tested on AutoCAD 2000
      
2568. 
      
2569. (defun c:ea (/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area)
      & e7 f. @& B* G" O/ U' e
2570.   (defun errexit (s)
      6 ^5 s: z5 }, p  d7 i' G
2571.     (restore)
      
2572.   )
      
2573. 
      
2574.   (defun undox ()
      7 w4 X& z, e  n8 s" j
2575.     (command "._undo" "_E")
      
2576.     (setvar "cmdecho" oldcmdecho)
      
2577.     (setq *error* olderr)
      
2578.     (princ)
      
2579.   )
      , J  U8 X. [1 O) u2 g& s5 ?
2580. 
      + f9 U0 D3 M  e  Q, X
2581.   (setq olderr  *error*
      % E2 z9 a4 K0 e7 {
2582.         restore undox
      
2583.         *error* errexit
      
2584.   )
      
2585.   (setq oldcmdecho (getvar "cmdecho"))
      ) R+ \; j' ~2 q8 w* F% }3 L/ P
2586.   (setvar "cmdecho" 0)
      
2587.   (command "._UNDO" "_BE")
      8 w( n/ L2 d- ~9 G7 M/ N- N
2588.   (if (setq ss1 (ssget '((-4 . "<OR")
      , ?" Q( u2 C) \
2589.                          (0 . "POLYLINE")
      
2590.                          (0 . "LWPOLYLINE")
      , `5 `' |7 H# q1 _% a
2591.                          (0 . "CIRCLE")
      
2592.                          (0 . "ELLIPSE")
      
2593.                          (0 . "SPLINE")
      ( Q' ]" q7 ]' D9 R& W
2594.                          (0 . "REGION")
      & E6 D; Z2 f) i1 r, p  R
2595.                          (-4 . "OR>")
      % C+ I2 a. T4 h* L* Y! c+ G; a
2596.                         )
      8 L- h+ _5 ^( d  u
2597.                 )
      
2598.       )
      % P# j8 B# x5 h! f2 V9 O+ i
2599.     (progn
      
2600.       (setq nr 0)
      ( m" ]& `) [% Y# f! Q( ?
2601.       (setq tot_area 0.0)
      
2602.       (setq en (ssname ss1 nr))
      
2603.       (while en
      
2604.         (command "._area" "_O" en)
      ( I4 F+ }$ S, t  m
2605.         (setq tot_area (+ tot_area (getvar "area")))
      : E- t. w; J7 d
2606.         (setq nr (1+ nr))
      
2607.         (setq en (ssname ss1 nr))
      
2608.       )
      
2609.       (princ "\nTotal Area = ")
      ' v2 q% F! y* [+ h3 T) l% m7 C
2610.       (princ tot_area)
      ' u2 n, E0 F" H1 o4 d9 V
2611.     )
      
2612.   )
      . D7 F6 z2 j! J# g, o
2613.   (restore)
      , k' I" }7 D! i; _  R+ c/ ?
2614. )
      
2615. 
      * |3 G$ Y6 M# A
2616. ;=====================================================================
      
2617. ;;; By Jimmy Bergmark
      6 T0 O/ x1 c9 T( M# a
2618. ;;; Copyright (C) 2008 JTB World, All Rights Reserved
      
2619. ;;;
      4 B. J" O9 B2 r
2620. ;;; Created: 2008-03-31
      # Q5 n! j/ o2 K. A$ d: S" b8 ?
2621. ;;;
      
2622. ;;; Convert Attribute definitions to mtext
      % m5 N. ?2 ]" u& A6 E( O; |0 m. ^
2623. ;;;
      
2624. 
      
2625. (defun c:ATB (/ eset1 blkcnt en enlist tag1 ht pnt vl space)
      % S! W; |: d1 T0 U% x2 D
2626.   (setq        eset1  (ssget (list (cons 0 "ATTDEF")))
      
2627.         blkcnt 0
      : r- w0 P0 W' {$ X' \1 z7 ]. K! f0 k
2628.   )
      " g: ^* L: a4 C* g- n! V% x
2629. 
      
2630.   (if eset1
      / u3 H' }) q: F: B5 W8 N  n8 f
2631.     (while (<= blkcnt (- (sslength eset1) 1))
      ! w/ y3 S6 D- w3 o  h8 e  |
2632.       (setq en           (ssname eset1 blkcnt)
      
2633.             enlist (entget en)
      . n: T% W5 Y# F- r) f) D
2634.             ht           (cdr (assoc 40 enlist))
      5 K! W; v" r! D1 N% [$ I
2635.             pnt           (assoc 10 enlist)
      " z( M  c% B, t+ l+ {* l
2636.             pnt           (subst (+ ht (caddr pnt)) (caddr pnt) pnt)
      ; _% T( B, t1 c, M6 j" Z
2637.             space  (cdr (assoc 67 enlist))
      # S5 ?- V7 U( K" I1 y' b
2638.       )
      
2639.       (setq vl (list
      
2640.                  (cons 0 "MTEXT")
      
2641.                  (cons 100 "AcDbEntity")
      7 G0 i: e* T. X) x+ t) u
2642.                  (cons 100 "AcDbMText")
      3 I9 _! \0 {3 K  C
2643.                  (assoc 7 enlist)
      
2644.                  (assoc 8 enlist)
        C$ V4 J5 ?- ^' E. U, V" U3 D
2645.                  pnt
      
2646.                  (assoc 40 enlist)
      
2647.                  (cond ((assoc 62 enlist))
      / e7 K8 Y  z& `0 b$ D! p, B) l  ]( [
2648.                        ((cons 62 256))
      * S) `* G8 ]& _
2649.                  )
      
2650.                  (cons 1 (cdr (assoc 2 enlist)))
      
2651.                  (if (= space nil)
      
2652.                    (cons 67 0)
      
2653.                    (cons 67 space)
      7 ~4 Y2 d/ F: I3 Q9 r8 C& u/ N
2654.                  )
      
2655.                )
      * \9 v0 n( ?- O, o' C' N3 C; N
2656.       )
      ' K  \6 N- J9 H/ k# {2 v* z% [
2657.       (entdel en)
      
2658.       (entmake vl)
      
2659.       (setq blkcnt (1+ blkcnt))
      7 S+ e3 H! h3 R, {3 C8 W( \5 k0 D
2660.     )
      
2661.   )
      
2662. )
      3 \& d0 b1 A- ^4 R* _
2663. 
      4 Q/ J% U, t! P* b% y+ v
2664. ;=====================================================================
      
2665. 
      
2666. (defun c:xxx ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
      * i5 t' X+ N( @8 ~/ h0 }' K
2667. ; Khoi dau cua chuong trinh
      4 t  J9 R' {/ A3 ^5 ]; L  @
2668. (princ "\nCopy Inteligent...\n")
      
2669. (setq         luuecho        (getvar        "cmdecho")
      * h2 f! w6 L& w! G$ m4 }
2670.         luu        *error*
      + ?3 A. Y- U0 h* u
2671.         *error*        ketthuc
      
2672.         cumdt         (ssget)
      . \9 J2 Z9 H$ s4 y
2673.         dodai         (sslength cumdt)
      
2674.         goc                (getpoint "\nSelect base point:")
      
2675.         thoat                nil
      " d* T' `4 G3 m7 K2 q
2676.         dem                0
      
2677.         textxl                nil
      ' ]8 ?  N, b3 P; z0 N% {
2678. );
      4 ]' h, H5 s# M* ^
2679. (setvar "cmdecho" 0)
      7 L9 E6 T1 x1 y& |; J# g! `
2680. ; Loc ra duoc ong text de xu ly
      
2681. (while        (and         (= thoat        nil)
      8 Y3 q! K$ I# G# j9 ?: t
2682.                 (< dem        dodai)
      
2683.         )
      / p$ F2 [/ {4 L* J
2684.         (setq         ten        (ssname cumdt dem)
      - C" p. M6 s' w. I5 j' i
2685.                 dem        (1+         dem)
      
2686.                 doituong (entget ten)
      5 s4 S8 V- c6 v6 B: B" j6 z" t
2687.                 kieu         (cdr (assoc         0        doituong))                        
      
2688.         )
      
2689.         
      1 r  l7 W. X, z. \# n
2690.         (if (or (= kieu                "TEXT")
      % {2 a$ i9 t0 U& l, u
2691.                 (= kieu         "MTEXT")        
      
2692.                 )
      : i- X) l5 J8 }; d" Y
2693.                 (setq         thoat        T
        q/ d' h2 G9 X( m1 U
2694.                         textxl         (cdr (assoc 1 doituong))         
      ' f8 v$ B8 z9 \  U
2695.                 )
      8 u2 a: @1 _) `2 X7 d! C# P5 [- p
2696.         )
      
2697. );
      3 O: \3 t6 d/ o- h& B* n! B& C
2698. (while T
      
2699. (setq        toi                (getpoint "\nSelect next point: " goc)
      
2700.         vitrilech         (list         (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
      
2701.         dem                0
      
2702. )
      * j9 B* ^! A2 \6 W6 X9 O8 V: u
2703. (while        (< dem dodai)
      7 W9 ]4 I6 `4 d6 _7 S7 J4 d
2704.         (setq         ten        (ssname cumdt dem)
      
2705.                 dem        (1+         dem)
      # W0 {0 D# d' t* u0 e9 I& L; L
2706.                 doituong (entget ten)
      
2707.                 kieu         (cdr (assoc         0        doituong))                        
      
2708.         )
      
2709. 
      
2710.         (if (or (= kieu                "TEXT")
      
2711.                 (= kieu         "MTEXT")        
      , o* i$ u& K" g& M: I0 e
2712.                 )
      
2713.                 (doitext        ten)
      ! ~: C' }# W# l0 {1 m
2714.                 (copy_dt        ten)
      . L. W1 {! A! w" U
2715. 
      
2716.         );if
      % ~3 l6 s% j+ }4 n) _0 d" P
2717. )
      
2718. );while
      ) Z( J. I! M+ b6 o: `8 H
2719. (ketthuc)
      
2720. );defun
      * v5 S& t8 k. D8 x( \) _( r
2721. (princ)
      
2722. 
      / W( g# s  {5 ?3 k4 i6 H3 A: |) N
2723. ;=====================================================================
      , p; z0 g$ Q3 X6 u9 f
2724. ;;; By Jimmy Bergmark
      
2725. ;;; Copyright (C) 2008 JTB World, All Rights Reserved
      
2726. ;;;
      5 K- [  Y' X$ X# v3 m
2727. ;;; Created: 2008-03-31
      
2728. ;;;
      0 a/ x, ~- I+ D4 J- q, E
2729. ;;; Convert Attribute definitions to text
      : _2 G. L! x/ ]
2730. ;;;
      
2731. 
      
2732. (defun c:ATT (/ eset1 blkcnt en enlist vl space)
      
2733.   (setq        eset1  (ssget (list (cons 0 "ATTDEF")))
      
2734.         blkcnt 0
      
2735.   )
      7 [; O+ B2 A, v8 Y' Y$ U+ ~7 i
2736. 
        l0 J, ]. C* M1 ~* {
2737.   (if eset1
      2 G4 Q! p9 d; d3 U4 j  o% _' h
2738.     (while (<= blkcnt (- (sslength eset1) 1))
      
2739.       (setq en           (ssname eset1 blkcnt)
      
2740.             enlist (entget en)
      2 \! _. q8 V5 |2 c+ B5 |4 C
2741.             space  (cdr (assoc 67 enlist))
      : b: f+ b6 c$ q2 ?/ W# K
2742.       )
      7 G. n9 M0 ~7 F0 `9 N
2743.       (setq vl (list
      
2744.                  (cons 0 "TEXT")
      
2745.                  (cons 100 "AcDbEntity")
      
2746.                  (cons 100 "AcDbText")
      
2747.                  (assoc 7 enlist)
      & c7 e- \' B$ z4 H
2748.                  (assoc 8 enlist)
      
2749.                  (assoc 10 enlist)
      ( s6 ], M9 ^2 r
2750.                  (assoc 40 enlist)
      
2751.                  (cond ((assoc 62 enlist))
      
2752.                        ((cons 62 256))
      
2753.                  )
      8 e7 m1 e5 M- T" _
2754.                  (cons 1 (cdr (assoc 2 enlist)))
      
2755.                  (if (= space nil)
      
2756.                    (cons 67 0)
      
2757.                    (cons 67 space)
      
2758.                  )
      5 [+ [# Y5 F# G: u) K
2759.                )
      & V1 k* a3 A7 t% Z6 @" a5 h! W
2760.       )
      7 _* t" o  j, f+ S5 L, M, ^7 E
2761.       (entdel en)
      
2762.       (entmake vl)
      7 I& _' @- _, U/ C; D7 @% z1 }9 D
2763.       (setq blkcnt (1+ blkcnt))
      * c* V) ]2 g& d9 [/ J0 C
2764.     )
      ) R6 ~  [0 [) X9 W. G
2765.   )
      $ z: c- @0 v' I0 R
2766. )
      ) ?: a) z0 [6 N  F  x; S
2767. ;=====================================================================
      0 R  u, W. p/ M  _: M( d
2768. ;============================ Doi Truc ===============================
      . f1 O1 D# w7 v+ S: v
2769. ;=====================================================================
      
2770. 
      : k7 o7 Y+ x- r  o
2771. ;=====================================================================
      
2772. ;=============== FUNCTIONS GA 1+3+5+7+9+11+13+15+17+19 ===============
      ( n9 S$ s4 V& f4 ]% d! G: ~
2773. ;=====================================================================
      ; g1 W; V. d% r2 Q0 ?( X  x+ ^. h
2774. (defun c:ga1 ()
      
2775. (setq a (getpoint "\nChon diem: "))
      
2776. (setq b (getpoint a"\nChon diem: "))
      
2777. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2778. (command ".circle" c a)
      0 @+ X, n1 ^1 s# n! H# L, i  m) p
2779. (command ".line" a c "")
      . Y$ l" u% \6 P- K8 b# p' p1 f
2780. (command ".array" "last" "" "p" c "1" "" "")
      5 o6 W8 r/ `2 j* D
2781. (princ))
      ( {3 |8 W3 E3 K) c/ h8 g7 H5 v8 F
2782. 
      
2783. (defun c:ga3 ()
      
2784. (setq a (getpoint "\nChon diem: "))
      ' e4 f' Y% q% V* ^# |
2785. (setq b (getpoint a"\nChon diem: "))
      5 B. L$ O0 n8 `2 w& B; m9 I
2786. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2787. (command ".circle" c a)
      , C$ x1 w) _4 I2 H1 b
2788. (command ".line" a c "")
      0 ]* ^. A! U$ P0 z9 @
2789. (command ".array" "last" "" "p" c "3" "" "")
      6 v3 y, A( g3 ?
2790. (princ))
      
2791. 
      
2792. (defun c:ga5 ()
      
2793. (setq a (getpoint "\nChon diem: "))
      3 U$ }6 @) s. F6 q4 u+ f
2794. (setq b (getpoint a"\nChon diem: "))
      
2795. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2796. (command ".circle" c a)
      
2797. (command ".line" a c "")
      
2798. (command ".array" "last" "" "p" c "5" "" "")
      
2799. (princ))
        j4 e; z% L" K8 c' H
2800. 
      
2801. (defun c:ga7 ()
      
2802. (setq a (getpoint "\nChon diem: "))
      # r$ [- e0 ?$ y5 ?* f3 T! D
2803. (setq b (getpoint a"\nChon diem: "))
      8 q7 p0 y' L2 O* S3 a! C+ [
2804. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      * W( u  z* j4 P+ }: P
2805. (command ".circle" c a)
      , m! H, L4 \! G( ]+ @+ e  U; g
2806. (command ".line" a c "")
      . H% p) u  |6 a
2807. (command ".array" "last" "" "p" c "7" "" "")
      
2808. (princ))
      
2809. 
      , Q7 N# i3 P! k  c8 [
2810. (defun c:ga9 ()
      $ z* P3 w, o4 k" @3 _0 O. M
2811. (setq a (getpoint "\nChon diem: "))
      
2812. (setq b (getpoint a"\nChon diem: "))
      * C) C, ~2 Z) E% C" T' q" X6 H
2813. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      & p1 ^; x5 {0 a
2814. (command ".circle" c a)
      
2815. (command ".line" a c "")
      
2816. (command ".array" "last" "" "p" c "9" "" "")
      2 q) k3 Z2 |9 _! h
2817. (princ))
      
2818. 
        b2 b, W- e. M: r6 r) A
2819. (defun c:ga11 ()
      
2820. (setq a (getpoint "\nChon diem: "))
      
2821. (setq b (getpoint a"\nChon diem: "))
      ! n  s$ Q& R% n1 }1 _- ?, D1 {) v
2822. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      7 u$ q. _  a: m7 B7 ?6 Q9 r( G
2823. (command ".circle" c a)
      
2824. (command ".line" a c "")
      + `* [5 R+ H" ?" z+ T
2825. (command ".array" "last" "" "p" c "11" "" "")
      ; D$ N" u) e$ K, ]# P* l
2826. (princ))
        ^2 ^3 s" v" ~, K" H3 s
2827. 
      
2828. (defun c:ga13 ()
      / f/ X0 }: u* j3 Q5 ?6 m
2829. (setq a (getpoint "\nChon diem: "))
      2 g: y0 m( t  q% ]8 y
2830. (setq b (getpoint a"\nChon diem: "))
      " Q; O. N# q! l+ A
2831. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2832. (command ".circle" c a)
      
2833. (command ".line" a c "")
      7 {6 t6 a- E: R) ?2 J3 f
2834. (command ".array" "last" "" "p" c "13" "" "")
        `# L4 g0 l5 ~) u6 I. `9 ^
2835. (princ))
      / S) u; G4 X2 q' R5 o4 v
2836. 
      9 L4 k% L2 C. `6 V- U5 T
2837. (defun c:ga15 ()
      
2838. (setq a (getpoint "\nChon diem: "))
      
2839. (setq b (getpoint a"\nChon diem: "))
      ( V, ^. P% j- e  g0 Y3 e
2840. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2841. (command ".circle" c a)
      
2842. (command ".line" a c "")
      
2843. (command ".array" "last" "" "p" c "15" "" "")
      * r) Y5 D/ ~- T# d
2844. (princ))
      ) k3 i0 }* K' w( \8 j
2845. 
      ; n" s3 r$ V6 X
2846. (defun c:ga17 ()
      
2847. (setq a (getpoint "\nChon diem: "))
      
2848. (setq b (getpoint a"\nChon diem: "))
      ! A1 e! n1 r. J. {
2849. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2850. (command ".circle" c a)
      
2851. (command ".line" a c "")
      
2852. (command ".array" "last" "" "p" c "17" "" "")
      . D2 ~" V) o; ?* t$ J7 x
2853. (princ))
      
2854. 
      
2855. (defun c:ga19 ()
      
2856. (setq a (getpoint "\nChon diem: "))
      1 l6 j6 a, m- x) S
2857. (setq b (getpoint a"\nChon diem: "))
      
2858. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      4 ^3 z9 ?5 I2 {( x) Y: F
2859. (command ".circle" c a)
      ; R# \+ Y: c  E7 ^' ]
2860. (command ".line" a c "")
      4 X  T8 `& F8 v
2861. (command ".array" "last" "" "p" c "19" "" "")
      5 F& E' g+ x- q1 n
2862. (princ))
      + k. }; ?  e0 B; Z' K  j+ J* b
2863. 
      : Z& A) M* w/ ~. S. d- l
2864. ;=====================================================================
      
2865. ;============== FUNCTIONS GA 2+4+6+8+10+12+14+16+18+20 ===============
      4 }' W3 C( u# J  w8 J( _
2866. ;=====================================================================
      
2867. (defun c:ga2 ()
      
2868. (setq a (getpoint "\nChon diem: "))
      
2869. (setq b (getpoint a"\nChon diem: "))
        @+ ^: s& r% _+ v, |: h+ r
2870. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2871. (command ".line" a c "")
      - |/ g! ~/ v, \: x  H4 {
2872. (command ".array" "last" "" "p" c "2" "" "")
      3 Q" V, z, u& d
2873. (command ".circle" c a)
      9 `- n/ p% ?  [
2874. (princ))
      
2875. 
      
2876. (defun c:ga4 ()
      
2877. (setq a (getpoint "\nChon diem: "))
      
2878. (setq b (getpoint a"\nChon diem: "))
      9 T1 o, k+ I  O3 W2 r, t, S
2879. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      : [( V& V5 Q: }# I
2880. (command ".line" a c "")
      7 X# S9 f0 l9 K! h
2881. (command ".array" "last" "" "p" c "4" "" "")
      
2882. (command ".circle" c a)
      4 F$ R) s& S  J" U
2883. (princ))
      $ J+ Y8 J( O2 J- l
2884. 
      
2885. (defun c:ga6 ()
      " U& A9 c: P2 k, |" n
2886. (setq a (getpoint "\nChon diem: "))
      
2887. (setq b (getpoint a"\nChon diem: "))
      
2888. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
        F4 j- r/ Z9 a1 t) z3 b
2889. (command ".line" a c "")
      2 j) M/ ~: R0 Q! O
2890. (command ".array" "last" "" "p" c "6" "" "")
      
2891. (command ".circle" c a)
      
2892. (princ))
      0 y% g, v1 S0 |- I  I  }8 i; j
2893. 
      
2894. (defun c:ga8 ()
      
2895. (setq a (getpoint "\nChon diem: "))
      
2896. (setq b (getpoint a"\nChon diem: "))
      
2897. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2898. (command ".line" a c "")
      
2899. (command ".array" "last" "" "p" c "8" "" "")
      
2900. (command ".circle" c a)
      4 M" f( h# j" R9 j
2901. (princ))
      
2902. 
      
2903. (defun c:ga10 ()
      5 O! g! F- b3 Q
2904. (setq a (getpoint "\nChon diem: "))
      3 [) m! `/ T& t# K+ ]; \; @
2905. (setq b (getpoint a"\nChon diem: "))
      0 g2 y$ g+ B9 C* k8 l" N7 I
2906. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2907. (command ".line" a c "")
      $ v* Q1 o" i+ d6 [( u8 ~! a+ t
2908. (command ".array" "last" "" "p" c "10" "" "")
      2 ?6 x2 S$ e3 E( e
2909. (command ".circle" c a)
      + n- G; N" f/ ~
2910. (princ))
      
2911. 
      ' W$ h4 V' P' \8 u# F5 h, O
2912. (defun c:ga12 ()
      
2913. (setq a (getpoint "\nChon diem: "))
      * y4 t+ B- R0 U
2914. (setq b (getpoint a"\nChon diem: "))
      , p! d5 _4 B  g. n% a2 |, V
2915. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2916. (command ".line" a c "")
      % W6 X$ I& k0 h" Z) H; I+ ]0 m
2917. (command ".array" "last" "" "p" c "12" "" "")
      ' d( p: P7 O% }3 p( f6 L
2918. (command ".circle" c a)
      2 O$ l, G6 p: `) o; x
2919. (princ))
      3 H5 N. S$ i% R6 |" T0 r8 n9 s6 C
2920. 
      
2921. (defun c:ga14 ()
      + y& N6 y" a( G& Q8 o
2922. (setq a (getpoint "\nChon diem: "))
      
2923. (setq b (getpoint a"\nChon diem: "))
      
2924. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      % A6 r! [+ s2 g3 D6 S& r
2925. (command ".line" a c "")
      
2926. (command ".array" "last" "" "p" c "14" "" "")
      
2927. (command ".circle" c a)
      % J# s. E" `. e# D$ P9 d" K
2928. (princ))
      5 r1 i! f) H( B
2929. 
        W$ a  B) I3 f  s/ G
2930. (defun c:ga16 ()
      / E$ h. Y" S" u( f
2931. (setq a (getpoint "\nChon diem: "))
      0 `! S2 `8 P, L
2932. (setq b (getpoint a"\nChon diem: "))
      $ m" u' P) I7 z2 r. ?0 |2 H2 K3 n
2933. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2934. (command ".line" a c "")
      * J8 r; P! U0 k) {5 d
2935. (command ".array" "last" "" "p" c "16" "" "")
      # Y7 g$ A3 |7 x; A- _
2936. (command ".circle" c a)
      
2937. (princ))
      
2938. 
      
2939. (defun c:ga18 ()
      
2940. (setq a (getpoint "\nChon diem: "))
      
2941. (setq b (getpoint a"\nChon diem: "))
      , \9 Z# o# Z5 R- t
2942. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      " t3 P+ B9 k4 Z6 j( A
2943. (command ".line" a c "")
      
2944. (command ".array" "last" "" "p" c "18" "" "")
      8 U' \, K; W: w& [
2945. (command ".circle" c a)
      
2946. (princ))
      1 a, E& |2 w  }
2947. 
      ' {) [/ R* z3 h, J
2948. (defun c:ga20 ()
      ) [& P1 E; ~$ C# K
2949. (setq a (getpoint "\nChon diem: "))
      ' Y; }9 C& H! D: P0 q' j
2950. (setq b (getpoint a"\nChon diem: "))
      4 p' b! T, A% n7 b
2951. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2952. (command ".line" a c "")
      
2953. (command ".array" "last" "" "p" c "20" "" "")
      
2954. (command ".circle" c a)
      
2955. (princ))
        ]0 \: O/ W, D3 F
2956. 
      
2957. ;=====================================================================
      
2958. ;============== FUNCTIONS GA TUY THICH : EVERYTHING IF ===============
      - g7 X' G' k; e
2959. ;========================== 06-11-2016 ~ 18h00 =======================
      7 |& m6 S; x9 J5 j% r( O
2960. ;=====================================================================
      / C, i) h) V# @6 n9 f: e  u
2961. (defun c:ga ()
      5 C/ F0 J2 R' @% a# R& W* W
2962. (setq a (getpoint "\nChon diem: "))
      % f9 Q' g$ w8 |: `' I& w
2963. (setq b (getpoint a"\nChon diem: "))
      ( ?- i; l" U* |; z3 ?) ^3 i
2964. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      * g9 W3 C5 C9 T6 \; q) |% G4 F
2965. (command ".circle" c a)
      . o) \! q  Z9 }6 P
2966. (command ".line" a c "")
      
2967. (command ".array" "last" "" "p" c "NUM" "" "")
      
2968. (princ))
      $ K( i  ]9 J0 F6 W
2969. 
      
2970. ;=====================================================================
      
2971. ;=========== FUNCTIONS HOA THI TUY THICH : EVERYTHING IF =============
      
2972. ;========================== 06-11-2016 ~ 18h40 =======================
      
2973. ;=====================================================================
      
2974. 
      - E! a# G; p& L! g
2975. (defun c:hoathi ()
      ) Y9 V1 n3 c2 G8 r4 l
2976. (setq a (getpoint "\nChon diem: "))
      
2977. (setq b (getpoint a"\nChon diem: "))
      4 x3 _5 N! X" u$ j) H
2978. (setq c (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2979. (command ".line" a c "")
      
2980. (command ".array" "last" "" "p" c "NUM" "" "")
      4 _: O) Y9 u8 W, O+ g
2981. (princ))
      
2982. 
      + |* {- s: {# m7 y
2983. ;=====================================================================
      - G; u2 q; _  {5 O% I- R$ V/ J. a' e
2984. ;============= FUNCTIONS CUNG TUY THICH : EVERYTHING IF ==============
      : N0 j; E; m8 v1 K6 W+ U
2985. ;========================== 03-11-2024 ~ 19h33 =======================
      . m, D% q5 F- R' Y7 j9 o2 c4 }/ k
2986. ;=====================================================================
      5 l: W- k. V/ b$ p4 @( g: Y
2987. 
      
2988. (defun c:cung ()
      # H% \- w" C; V0 v7 a
2989. (setq a (getpoint "\nChon diem: "))
      
2990. (setq b (getpoint a"\nChon diem: "))
      3 V( R. n  ?) R! t3 ]
2991. (setq c (getpoint a"\nChon diem: "))
      
2992. (setq d (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
2993. (command ".arc" a b c "")
      9 H! l8 J! Q2 O4 V9 A0 w
2994. (command ".array" "last" "" "p" c "NUM" "" "")
      . F+ w" o/ C) D6 l; C6 H% M& x
2995. (princ))
      & Z) l* l- b; j: N1 X9 m( h
2996. 
      5 b/ S1 q1 q! O4 }. R# b; R, ^
2997. ;=====================================================================
        d# M$ x/ |3 l9 w/ C) k4 x; }1 [
2998. ;============ FUNCTIONS HECLOIC TUY THICH : EVERYTHING IF ============
      ) D# w1 u; V- ~3 T) d# m4 c: e
2999. ;========================== 03-11-2024 ~ 20h02 =======================
      
3000. ;=====================================================================
      5 M' }% H( Z7 t
3001. 
      
3002. (defun c:hecloic ()
      
3003. (setq a (getpoint "\nChon diem: "))
      % W) \2 ^0 k# g  j. G( w' o3 u  R
3004. (setq b (getpoint a"\nChon diem: multi "))
      
3005. (setq c (getpoint a"\nChon diem: "))(princ)
      
3006. (setq d (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
3007. (command ".arc" a b c "")
      5 K- l; I, }8 x
3008. (command ".array" "last" "" "p" c "NUM" "" "")
      . ?0 A5 ~4 |# L+ }% a
3009. (princ))
      ! e+ i2 V; \; h- t
3010. 
      
3011. ;=====================================================================
        c7 \& ]( `; _% g4 z8 f! ?' V) g
3012. ;============== FUNCTIONS GAY TUY THICH : EVERYTHING IF ==============
      6 X5 z" @3 j8 Z$ P* |. i  `0 c
3013. ;========================== 03-11-2024 ~ 19h38 =======================
      - F- l+ |% c) W/ w* B
3014. ;=====================================================================
      
3015. 
      
3016. (defun c:gay ()
      ' P& a7 r4 o/ x, z! y2 W
3017. (setq a (getpoint "\nChon diem: "))
      
3018. (setq b (getpoint a"\nChon diem: "))
      
3019. (setq c (getpoint a"\nChon diem: "))(princ)
      
3020. (setq d (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      / |( O; \/ ]3 A/ H4 v8 T9 N
3021. (command ".pline" a b c "")
      
3022. (command ".array" "last" "" "p" c "NUM" "" "")
      ! ~  a3 T3 @) M) P+ b8 L* P. a
3023. (princ))
      & M0 J  |# G& z; @
3024. 
      
3025. ;=====================================================================
      0 u2 f: u/ W( e) o4 p, _
3026. ;============ FUNCTIONS HECLOIT TUY THICH : EVERYTHING IF ============
      
3027. ;========================== 03-11-2024 ~ 20h02 =======================
      ! T8 o. v9 P) G
3028. ;=====================================================================
      
3029. 
      $ p7 R& _. q( C3 ]) L' f
3030. (defun c:hecloit ()
      8 L  j* x+ U0 w3 E( A9 X/ z
3031. (setq a (getpoint "\nChon diem: "))
      / z+ b  P$ [; q% U3 ^$ j, Y
3032. (setq b (getpoint a"\nChon diem: multi "))
      
3033. (setq c (getpoint a"\nChon diem: "))(princ)
      
3034. (setq d (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2)))
      
3035. (command ".pline" a b c "")
      
3036. (command ".array" "last" "" "p" c "NUM" "" "")
      
3037. (princ))
      
3038. 
        T% N8 `' y! O+ A
3039. 
      
3040. ;;; ============================ Merge Hatch =============================
      
3041. 
      # J$ P; q1 v6 m8 l! ?+ R) \0 B
3042. (defun c:mh (/ ss entht sl i dt dtht)
      
3043. 
      3 z' Z7 r; n* u/ @. ]
3044.   (princ "\nMerge Hatch - free lisp from CADViet.com")
      
3045. 
      
3046.   (setq
      7 o7 ?' B, V) I
3047.     ss (ssget '((0 . "HATCH")))
      
3048.     sl (if ss
      " @% K3 }( C8 C- s- z
3049.          (sslength ss)
      
3050.          0
      4 H& s% Y, _: t  o  h
3051.        )
      ( n) q9 z9 a4 [; o; H- l
3052.     i  0
      4 r7 \; D; I4 a! _, |! {
3053.     l  0
      
3054.   )
      ) g  \# B8 C! d
3055. 
      " t4 U. [2 k8 g5 d( I! L
3056.   (repeat sl
      ) Z# Z* W5 e% l0 y- U3 P
3057.     (setq
      7 d4 V; X# n5 _7 i- ?/ R
3058.       entht (ssname ss i)
      , @3 X* A* E) q
3059.       dtht  (getbdata entht)
      ( ~3 r8 b' G; z; F+ l
3060.       dt    (append dt dtht)
      
3061.       l            (+ l (cdr (assoc 91 (entget entht))))
      
3062.       i            (1+ i)
      5 n; [! N% k0 Q% r9 F: B1 m
3063.     )
      
3064.   )
      7 K4 \: R" T: {% e; B
3065. 
      1 J% B& |8 B" F; o
3066.   (setq        ent  (ssname ss 0)
      
3067.         ss   (ssdel ent ss)
      4 M: m/ n( a% k& R( S. ^4 U
3068.         tt   (entget ent)
      
3069.         duoi (member (assoc 75 tt) tt)
      
3070.         dau  (reverse (member (assoc 91 tt) (reverse tt)))
      
3071.         tt   (append dau dt duoi)
      & N- c5 X" i9 T0 Z1 \" N% k
3072.         tt   (subst (cons 91 l) (assoc 91 tt) tt)
      ( J& X& ]* y, O, y' y" I- @6 u
3073.   )
      % {1 l2 V: Y1 c9 q% p8 r
3074.   (entmod tt)
      
3075. 
      7 y( h( ]+ q7 N. A, z" c
3076.   (command ".erase" ss "")
      5 v* ^3 w, L% h
3077.   (princ)
      
3078. )
      5 x# O: v) r; T# U3 y
3079. 
      
3080. (defun getbdata        (ent)
      
3081.   (setq        tt (entget ent)
      ; g' F' i( |4 B3 b" b1 N& `
3082.         tt (cdr (member (assoc 75 tt) (reverse tt)))
      
3083.         tt (cdr (member (assoc 91 tt) (reverse tt)))
      # q1 q: l' d7 r! q. x
3084.   )
      ) c; [# K5 b$ M  {7 [
3085. )
      
3086. 
      4 G; M( d; ~- e) n1 m
3087. 
      
3088. (princ)
      
3089. 
      
3090. ;;; =========================== CAC LENH LAYER ==============================
      
3091. ;;; =========================== Layer hien hanh =============================
      
3092. 
      
3093. (defun layset (/ LAY) (setvar "cmdecho" 0)
      
3094. (setq LAY (entsel "\nPick vao doi tuong muon Layer hien hanh la Layer cua doi tuong do : "))
      
3095. (if LAY     (progn     
      
3096.   (setq LAY (cdr (assoc 8 (entget (car LAY)))))
      
3097.   (command "_.layer" "set" LAY "") (princ (strcat "\nLayer : " LAY " da la hien hanh."))  )
      + S$ G6 L  N$ C  [
3098.              (progn
      
3099.       (if (not ddlop) (load "ddlop"))  (if (setq LAY (ddlop))
      : Q) u$ n# l$ X3 |. {* a( P2 p
3100.              (progn
      
3101.             (command "_.LAYER" "ON" LAY "THAW" LAY "SET" LAY "")  (princ (strcat "\nLayer : " LAY " da la hien hanh.")) ) ) ) )(princ) )
      2 t9 e/ l; D  H" N9 S: W0 J# |) ^
3102. (defun c:LLL     () (layset))(defun c:LAYSET () (layset))
      % V' [4 ^# `: {
3103. 
      - `8 G7 Z9 H6 c4 i! ?5 N
3104. ;;; ================== Cap nhat doi tuong vao layer hien hanh ==================
      
3105. 
      9 [4 f& N3 \6 R. V4 V
3106. (Defun LAYCUR (/ SS CNT LAY)  (setvar "cmdecho" 0)
      
3107.   (if (not (setq SS (ssget "i")))
      " i/ X5 O( j% e4 X! E3 j
3108.     (progn (prompt "\nChon doi tuong cap nhat vao layer hien hanh: ")
      
3109.       (setq SS (ssget))    )  )
      / Q1 w; a4 A6 k% {( y
3110.   (if SS    (progn
      
3111.    (setq CNT (sslength SS)) (princ (strcat "\n" (itoa CNT) " doi tuong tim thay."))                  (command "_.move" SS "")                     
      8 q" o& m  r: x3 I
3112.       (if (> (getvar "cmdactive") 0)               
      " f; O3 v( S4 U/ T* C
3113.         (progn
      
3114.           (command "0,0" "0,0") (setq SS  (ssget "p") CNT (- CNT (sslength SS))    )   )
      
3115.           (setq SS nil)     )  (if (> CNT 0)                                 
      # D5 R9 O' T0 y: y9 H! I! M
3116.           (princ (strcat "\n" (itoa CNT) " doi tuong tren layer LOCK.")) ) ) )
        N6 I8 j- i- a. x9 O% m% y
3117.   (if SS    (progn
      
3118.       (setq LAY (getvar "CLAYER")) (command "_.chprop" SS "" "_la" LAY "")
      
3119.       (if (= (sslength SS) 1)
      
3120.         (prompt (strcat "\n1 doi tuong da cap nhat vao layer : " LAY " (layer hien hanh)."))
      
3121.         (prompt (strcat "\n" (itoa (sslength SS)) " doi tuong da cap nhat vao layer : " LAY " (layer hien hanh).")) ) ))  (princ) );end
      ; z8 b: f; L5 ?) v( R' m8 E
3122. (defun c:LAYCUR () (laycur)) (defun c:LHH    () (laycur))
      
3123. 
      
3124. ;;; =========================== Layer Iso ===================================
      : T" C1 L" p. k4 i% X
3125. 
      ' ]8 I! ^1 a  b& s; j* S
3126. (Defun LAYISO (/ SS CNT LAY LAYLST VAL)  (setvar "cmdecho" 0)
      - U0 z, X+ a* l* [) F4 E7 R+ p
3127.   (if (not (setq SS (ssget "i")))    (progn
      
3128.       (prompt "\nChon doi tuong tren layer(s) muon lam viec doc lap: ")
      
3129.       (setq SS (ssget))    )  )
      
3130.   (if SS    (progn      (setq CNT 0)
      
3131.       (while (setq LAY (ssname SS CNT))
      
3132.         (setq LAY (cdr (assoc 8 (entget LAY))))
        m. {0 k7 T) M. z$ I7 F5 F  g$ G+ V
3133.         (if (not (member LAY LAYLST))
      6 T1 T% N. @% z8 }
3134.           (setq LAYLST (cons LAY LAYLST))        )
      ) x( o" a8 k: ^+ `+ j
3135.         (setq CNT (1+ CNT))      )
      ; p" y5 f4 V1 [; G$ _" b. ^- V: h
3136.       (if (member (getvar "CLAYER") LAYLST)
      
3137.         (setq LAY (getvar "CLAYER"))
      ' a" J9 \- t( v4 d( ~7 Z3 j
3138.         (setvar "CLAYER" (setq LAY (last LAYLST)))      )
      
3139.       (command "_.LAYER" "_OFF" "*" "_Y")
      
3140.       (foreach VAL LAYLST (command "_ON" VAL))
      2 h) g# I- F; X5 L. M
3141.       (command "")            (if (= (length LAYLST) 1)
      
3142.         (prompt (strcat "\nLayer " (car LAYLST) " da tach ra."))
      # v2 h' R( A1 _# d- q9 K
3143.         (prompt (strcat "\n" (itoa (length LAYLST)) " layers da tach ra. "
      8 {) \1 A. H' V
3144.                         "Layer " LAY " la hien hanh."   )  )  )  )  )  (princ) )
      5 f. M, y+ I5 K4 x
3145. (defun c:LAYISO () (layiso)) (defun c:LI () (layiso))
      
3146. 
      * z8 }& D1 W% T* v5 H
3147. ;;; =========================  Layer Match ==================================
      - n' @1 Z/ ?8 l( \5 w
3148. 
      / d0 ?- Z/ ~! e+ O/ f7 e2 t
3149. (Defun LAYMCH (/ SS CNT LOOP LAY ANS)
      ! m. W2 I( f; D% A+ W
3150.   (setvar "cmdecho" 0)
      
3151.   (if (not (setq SS (ssget "i")))    (progn
      ' o$ x' T! A) l9 f3 X
3152.       (prompt "\nChon doi tuong muon thay doi Layer : ")
      
3153.       (setq SS (ssget))    )  )
      
3154.   (if SS    (progn
      ) b2 Z% E5 O4 C* D9 B  W1 g* B
3155.       (setq CNT (sslength SS))
      
3156.       (princ (strcat "\n" (itoa CNT) " found."))  (command "_.move" SS "")                        
      
3157.       (if (> (getvar "cmdactive") 0)   (progn
      3 ^7 ^' k. z' Y; Y
3158.           (command "0,0" "0,0")  (setq SS  (ssget "p")
      
3159.                 CNT (- CNT (sslength SS))    )    )
      
3160.         (setq SS nil)      )  (if (> CNT 0)                                    
      3 c% V# o& h/ A* y: K1 ]
3161.           (princ (strcat "\n" (itoa CNT) " tren layer LOCK.")) ) )  )
      
3162.   (if SS    (progn
      " J9 D2 L. L( b8 ]
3163.       (initget "Ten")  (setq LAY  (entsel "\nTen layer/<Pick doi tuong>: ")  LOOP T  )
      * w1 ~& e: b, _7 r3 [# |
3164.     (while LOOP        (cond
      & |* A) ?' A" ?4 [% z# s; `3 b" T- N
3165.           ((not LAY)
      + B6 l+ o0 ]7 y% g
3166.             (prompt "\nKhong chon doi tuong.")
      
3167.             (prompt "\nSu dung layer hien hanh? <Y> ")
      
3168.             (setq ANS (strcase (getstring)))
      ) ]6 V; U( c+ R. U7 p( ^: c: l
3169.             (if (or (= ANS "") (= ANS "Y") (= ANS "YES"))
      ( ?% P% ~  @6 l- l( o9 r' [( a% b( |
3170.               (setq LAY  (getvar "clayer")  LOOP nil )  )  )
      : R; P  N' u2 \0 |' j
3171.           ((listp LAY)  (setq LOOP nil) )
      / n) X. n, x' z" B( p: x2 j$ A1 m
3172.           ((= LAY "Ten")
      6 Q: v. c! I+ \# b+ P' ?$ ~
3173.             (setq LAY (getstring "\n>Nhap ten layer: "))
      
3174.             (cond
      
3175.               ((tblsearch "LAYER" LAY)  (setq LOOP nil)   )
      
3176.               ((/= LAY "")
      6 }1 {& N) Z1 W; ?* G, o* e; \
3177.                 (prompt "\nLayer chua co trong ban ve. Tao layer moi? <Y>: ")
      # ^" y6 z4 L# @( y6 z' Y2 V6 i
3178.                 (setq ANS (strcase (getstring)))
      
3179.                 (if (or (= ANS "") (= ANS "Y") (= ANS "YES"))
      6 a$ ^1 d6 p* }0 \. d! w
3180.                     (progn
      , r9 i$ y, C8 u( O
3181.                         (command "_.LAYER" "NEW" LAY "")
      
3182.                         (setq LOOP nil)   )
      
3183.                     (prompt "\nLoi ten layer.")   )   )  )  )   )
      
3184.         (if LOOP  (progn (initget "Ten")
      
3185.             (setq LAY  (entsel "\nTen layer/<Pick doi tuong>: ")) ) ) ); while LOOP
      6 p2 H. _/ L' k
3186.         (if (listp LAY)
      
3187.         (setq LAY (cdr (assoc 8 (entget (car LAY)))))      )
      . M3 `) E& y% ^. n) k7 h9 F
3188.       (command "_.chprop" SS "" "_la" LAY "")
      , b) h6 W+ z7 A# R9 \
3189.       (if SS  (prompt (strcat "\n" (itoa (sslength SS)) " doi tuong thay doi toi layer " LAY )) )
      
3190.       (if (= LAY (getvar "clayer"))
      
3191.         (prompt " (layer hien hanh).")  (prompt ".") ) ) )  (princ) )
      
3192. (defun c:LAYMCH () (laymch)) (defun c:CLL    () (laymch))
      9 q8 H. i& E' p. i% r
3193. 
      8 v2 x7 B1 ?  n
3194. ;;; ============================ Layer OFF =================================
      
3195. 
      
3196. (DEFUN C:LJ (/ SSET SSL ENT LAY I MODE)
      
3197.    (SETQ SSET (SSGET))
      
3198.    (IF (/= NIL SSET)
      
3199.     (PROGN
      
3200.      (SETQ SSL (SSLENGTH SSET))
      
3201.      (SETQ LAY "")
      0 O/ g# S# o$ i( J& }
3202.      (SETQ I 0)
      
3203.      (SETQ MODE 0)
      , i9 A% ^. o7 M& y- [- ?: F; ]
3204.      (WHILE (< I SSL)
      
3205.                  (SETQ ENT (ENTGET (SSNAME SSET I)))
      
3206.           (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
      
3207.           (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) ))
      8 Q5 m$ ~4 _, V& s# h: |' s
3208.           (SETQ I (+ I 1))
      
3209.      )
        D4 o8 N+ p9 f/ s8 f0 \' z1 t" g4 o
3210.      (COMMAND "LAYER" "OFF" LAY "")
      
3211.      (IF (= MODE 1) (COMMAND "") )
      - j) J6 N, m$ I/ W- H
3212.     )
      8 }& F7 d9 C# [. p$ ~1 V$ U2 M; a8 T
3213.    )
      
3214.    (PRINC)
      
3215. )
      
3216. 
      
3217. ;;; ================================ Layer ON ==============================
      
3218. 
      
3219. (Defun LAYON ()  (setvar "cmdecho" 0)
      - k8 S" d. b2 N' M
3220. (setq Lay loff1) (setq Loff1 Loff2) (setq Loff2 Loff3) (setq Loff3 Loff4) (setq Loff4 Loff5) (setq Loff5 Loff6) (setq Loff6 "0")
      * l( O, x$ f" f7 Z/ y
3221.   (Command "LAYER" "ON" Lay "") (princ (strcat "\n      Layer : " LAY " da ON."))  (princ))
      
3222. (defun c:LAYON () (layon)) (defun c:LOO   () (layon))
      
3223. (Defun C:LO () (setvar "cmdecho" 0)  (Command "_.LAYER" "_ON" "*" "") (princ "\nDa ON toan bo cac Layer !") (princ))
      
3224. 
      
3225. ;;; ============================== Layer Freeze ===========================
      / P( A: {9 q8 u
3226. 
      
3227. (Defun LAYFRZ (/ LAY TEMP)(setvar "cmdecho" 0)
      8 A" C$ Z2 w! C$ D. b# o# K/ ^
3228. (prompt "\nChon doi tuong tren layer(s) muon FREEZE: ") (SETQ SSET (SSGET))
      
3229. (IF (/= NIL SSET) (PROGN
      
3230.      (SETQ SSL (SSLENGTH SSET))  (SETQ LAY "") (SETQ I 0) (SETQ MODE 0)
      9 a7 E/ K) U6 }6 v" W& S" E
3231.      (WHILE (< I SSL)
      9 {$ |$ C5 G1 G1 \0 f
3232.        (SETQ ENT (ENTGET (SSNAME SSET I)))
      
3233.        (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
      7 @0 b* o0 m$ d3 X! V0 g9 o
3234.        (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) )) (SETQ I (+ I 1)))
      % N; o+ M0 B6 |' x
3235.      (COMMAND "LAYER" "FREEZE" LAY "")
      
3236.      (IF (= MODE 1) (COMMAND ""))))
      
3237. (setq Lff6 Lff5) (setq Lff5 Lff4) (setq Lff4 Lff3) (setq Lff3 Lff2) (setq Lff2 Lff1) (setq Lff1 LAY)
      
3238. (princ (strcat "\n      Layer " LAY " da FREEZE."))(setvar "cmdecho" 1) (princ) )
      
3239. (defun c:LAYFRZ () (layfrz)) (defun c:LF     () (layfrz))
      
3240. 
      
3241. ;;; ============================== Layer Thaw ===============================
      
3242. 
      : `9 h9 U8 {, a# y
3243. (Defun LAYTHW ()
      
3244.   (setvar "cmdecho" 0)
      
3245. (setq Lay lff1) (setq Lff1 Lff2) (setq Lff2 Lff3) (setq Lff3 Lff4) (setq Lff4 Lff5) (setq Lff5 Lff6) (setq Lff6 "0")
      ; L3 E2 R. R1 ^/ {5 T3 e
3246.   (Command "_.LAYER" "_THAW" LAY "")
      ; u$ s; F; k1 E
3247.            (princ (strcat "\n     Layer : " LAY " da THAW."))
      9 b, {# ]8 c5 J  r2 s
3248.            (princ) )
      1 M3 b) l, M( G3 K7 P; @  c8 C) a
3249. (defun c:LAYTHW () (laythw)) (defun c:LW    () (laythw))
      
3250. 
      ; N5 u! e3 ]5 x' i8 I) k# F
3251. ;;; ============================== Layer Lock ==============================
      
3252. 
      2 e7 _6 P$ W4 ~5 Q9 e1 A
3253. (Defun LAYLCK (/ LAY)
      
3254.   (setvar "cmdecho" 0)
      
3255.   (setq LAY (entsel "\n>Pick doi tuong tren layer muon LOCK: "))
      
3256.   (if LAY
      
3257.     (progn
      # p. u- K9 z# o3 h0 `; y
3258.       (setq LAY (cdr (assoc 8 (entget (car LAY)))))
      # M" F" a7 O& o
3259.       (Command "_.LAYER" "_LOCK" LAY "")
      
3260.       (princ (strcat "\nLayer " LAY " da LOCK."))    )  )  (princ) )
      & M& `  P. h0 L5 Q9 H  u. L
3261. (defun c:LAYLCK () (laylck)) (defun c:LK     () (laylck))
      
3262. 
      
3263. ;;; ============================== Layer UnLock ==============================
      
3264. 
      
3265. (Defun LAYULK (/ LAY)
      7 R) n/ T! ~$ X" Z
3266.   (setvar "cmdecho" 0)
      
3267.   (setq LAY (entsel "\n>Pick doi tuong tren layer muon UNLOCK: "))
      
3268.   (if LAY
      
3269.     (progn
      7 i6 _! D! q# K9 A  J; L
3270.       (setq LAY (cdr (assoc 8 (entget (car LAY)))))
      " D! ?5 q( o9 r% Q* S# B6 r, Q
3271.       (Command "_.LAYER" "_UNLOCK" LAY "")
      
3272.       (princ (strcat "\nLayer " LAY " da UNLOCK."))    )  )  (princ) )
      
3273. (defun c:LAYULK () (layulk)) (defun c:LU    () (layulk))
      
3274. 
      1 h$ a3 J6 R  }; ?- Q5 q" c$ t( Z
3275. ;;;===================== Delete all objects of Layer ========================
      
3276. 
      
3277. (defun DELAYER (/ ocmd L S)
      ) E1 g; g& N& E* h( i( L( c
3278.   (setq ocmd (getvar "CMDECHO"))
      $ H1 _# k* r) F/ {5 n: N; D' E
3279.   (setvar "CMDECHO" 0)
      
3280.   (setq L (strcase (getstring "\nLayer(s) to delete: ")))
      
3281.   (setq S (ssget "X" (list (cons 8 L))))
      * A7 S' n7 @8 N2 o
3282.   (if S
      
3283.     (command "ERASE" S "")            
      7 l0 \, s9 A) f- O' w, u
3284.     (princ "Layer empty or not a valid layer name.")  )
      7 [' S8 b2 W9 l( H4 o- W# t
3285.   (setq S nil)                        
      
3286.   (setvar "CMDECHO" ocmd)            
      
3287.   (princ) )
      
3288. (defun c:DELAYER  () (delayer)) (defun c:DELLAYER () (delayer)) (defun c:DEL      () (delayer))
      ) A; B$ V# c+ w  D' F! c
3289. 
      
3290. ;;; ========================= HET CAC LENH LAYER ===========================
      5 {2 V8 m. A) r
3291. 
      
3292. ;;;====================== EXTEND NHIEU DOI TUONG ===========================
      
3293. 
      ! N  M! N5 m! F: c( E
3294. (Defun C:EET ()
      6 A( U& i" O, x5 x9 P0 k( M
3295.   (Setq CVAR (Getvar "CMDECHO"))  (Setvar "CMDECHO" 0)
      
3296.   (Prompt "Chon doi tuong dich cua EXTEND :")  (Setq CUTEDG (Ssget))
      % p$ e* J, ?* ~: |: U& {% ~
3297.   (Prompt "Chon doi tuong de Extend :")  (Setq SS (SSget))  (Setq LEN (SSlength SS))
      
3298.   (Setq I -1)
      . \, \$ J. A1 [  X* d! s% y
3299.   (Setq SIDE (getpoint"Chon phia de EXTEND"))  (Command "EXTEND" CUTEDG "")
      
3300.   (Repeat LEN
      9 C- Z6 r3 L# f2 b
3301.    (Setq I (1+ I))
      
3302.    (Command (List(SSname SS I) SIDE))  )  (Command "")
      
3303.   (Setvar "CMDECHO" CVAR)  (Princ "Da Extend xong moi ban lam tiep")  (Princ) )
      
3304. 
      
3305. ;;; ===============  EXTEND 1 DOI TUONG THEO KHOANG CACH ===============
      ( f' M/ d$ u( p5 D
3306. 
      % ?  E* I/ B8 L9 D8 E  Y, Q0 d
3307. (defun c:ETT ()  (setq os (getvar "osmode"))  (setvar "osmode" 512)
      ! {) n: _, L& q& Y
3308.   (setq pt1 (getpoint "\nKich vao 1 dau doan thang can EXTEND  "))
      . C' x8 Z2 l$ q+ }
3309.   (setvar "osmode" os)
      5 ^$ e& b# V4 |5 g3 W- x/ j
3310.   (setq dis (getdist pt1 "\nKhoang cach can EXTEND :"))
      
3311.   (command "circle" "endpoint" pt1 dis)  (command "extend" "last" "" pt1 "")  (command "erase" "last" "") (princ))
      
3312. 
      ) e, J: n6 i2 _% L
3313. ;; ================ Change width of polylines =========================
      
3314. 
      
3315. (DEFUN wp (/ a b sophantu sodem list1 ha:wid)
      3 o( j; \, C- U/ S6 C( N, W, T% H
3316. (PRINC "\n         Chon doi tuong can thay doi do day (Width) !")
      
3317. (setq b (ssget))
      ( ?1 g8 [; B' i7 M" E. p8 ?+ M5 ~, T! T
3318. (setq sophantu (sslength b))
      / e' ~/ X8 N8 V! v+ o
3319. (if (null ha:wid) (setq ha:wid (getvar "tracewid")))
      
3320. (princ "\nDo rong polyline <")
      - X) F" ?  u0 z( d0 s
3321. (princ ha:wid)
      & e: O9 ~6 Y* m3 X$ D/ {1 \
3322. (princ ">: ")
      
3323. (initget 4)
      * }- K2 S4 @- `, k  Y. o: k5 Y9 x
3324. (setq ha:wid (getdist))
      
3325. (if (null ha:wid) (setq ha:wid (getvar "tracewid")))
      
3326. (setvar "tracewid" ha:wid)
      
3327. (setvar "cmdecho" 0)
      
3328. (setq sodem 0)
      ) T  m6 p4 E% F/ a
3329. (repeat sophantu
      
3330.   (setq a (ssname b sodem))
        u' t( O2 [0 h
3331.   (setq list1 (assoc 0 (entget a)))
      
3332.     (cond
      
3333.      ((= (cdr list1) "POLYLINE") (command "_Pedit" a "w" ha:wid ""))
      
3334.      (PROGN (command "_Pedit" a "" "w" ha:wid ""))    )
      7 K3 f0 V$ R5 C% a5 L
3335. (setq sodem (1+ sodem)) )(SETVAR "cmdecho" 1)(princ))
      6 V3 u3 _/ ~+ g: h+ m/ T' R
3336. (defun c:wp () (wp)) (defun c:pw () (wp))
      
3337. 
      
3338. ;; ================ Change radius of circles ==========================
      
3339. 
      ! P7 c3 V; p& n; K' ]* j% `+ G% Z
3340. (DEFUN C:CHR (/ SSET SSL M RD I)   (PRINC "\nSelect Circles :")   (SETQ SSET (SSGET))
      
3341.    (IF (/= NIL SSET) (PROGN  (SETQ SSL (SSLENGTH SSET))  (INITGET 4 "")  (SETQ RD (GETDIST "\nNew radius : "))
      
3342.    (IF (/= RD NIL)  (PROGN (SETQ I 0)
      # u9 Y0 a0 B) f
3343.    (WHILE (< I SSL) (SETQ M (ENTGET (SSNAME SSET I) ) )
      
3344.    (IF (= (CDR (ASSOC '0 M)) "CIRCLE") (PROGN
      ; a" E8 @" J0 e  A
3345.   (SETQ M (SUBST (CONS 40 RD) (ASSOC 40 M) M))  (ENTMOD M) ) )  (SETQ I (+ I 1)) )      )   ))) (PRINC) )
      
3346. 
      ! m8 E: V7 n6 h+ r$ ^
3347. ;;; ============================== TEXT Hight ===============================
      0 r  L) _. A- c" ]  G
3348. 
      
3349. (defun texthght (/ ent hght)
      
3350.   (setvar "cmdecho" 1)
      . {; }, ]7 d% L: T
3351.   (prompt (strcat"\nSelect text entity with required text height"))
      
3352.   (prompt (strcat"\n."))
      5 A# D& ^6 @' j9 z
3353.   (setq ent (entget (car (entsel))))
      
3354.   (setq hght (cdr (assoc 40 ent)))
      2 F, O1 Z& z1 q( U* {8 H. ^3 b
3355.   (prompt (strcat"\nText height now set at "))(prin1 hght)
      
3356.   (prompt (strcat"\n."))
      
3357.     (setvar "cmdecho" 1)
      9 G8 q- x) K( u3 F0 F( G5 o/ V3 y
3358.     (command "DTEXT" PAUSE hght "") )
      9 Q! R% V' M/ o6 P6 G
3359. (defun c:teh () (texthght))  (defun c:texthght () (texthght))
      ( A3 c9 T' f$ A. z5 G9 U. P
3360. 
      5 H/ _/ j4 ^: G- B# W' e
3361. ;;; ================ BAT -TAT CHE DO GACH CHAN TEXT =================
      # a9 ]4 T& m2 Z
3362. 
      % p0 N6 M8 V: @( L2 Q  A7 }* o
3363. (defun c:tuu ()  (setvar "cmdecho" 0)
      
3364.     (prompt "\nHay chon dong TEXT can gach chan ")
        l( |8 z- @# t9 m: y* i  u4 u4 J! n
3365.     (prompt "\nSelect objects: ")
      
3366.     (command "select" "au" pause)
      
3367.     (setq sstxt (ssget "p")
      & g2 s8 P" N$ V* ^1 b/ z
3368.           sslen (sslength sstxt)
      1 \2 z+ L1 V! m" D$ a; A
3369.           ctr 0    )
      
3370.     (command ".undo" "mark")
      
3371.     (while (< ctr sslen)
      
3372.            (setq listxt (entget (ssname sstxt ctr))
      
3373.                  txttxt (cdr (assoc 1 listxt))
      
3374.                  enttxt (cdr (assoc 0 listxt))   )
      
3375.            (if (= enttxt "TEXT")
      
3376.                (progn
      
3377.                    (setq testxt (substr txttxt 1 3))
      ! X* Y. t, H+ L
3378.                    (if (or (= testxt "%%u") (= testxt "%%U"))
      
3379.                        (setq newtxt (substr txttxt 4))
        B8 E1 x2 h6 ^# l; E$ _" h# w
3380.                        (setq newtxt (strcat "%%u" txttxt))    )
      
3381.                    (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
      5 d! U, X# M- D" K2 p8 c/ }
3382.                    (entmod listxt)                ) )
      
3383.             (setq ctr (1+ ctr))  )    (setvar "cmdecho" 1)    (princ))
      
3384. 
      
3385. ;;; ================ BAT -TAT CHE DO GACH CHAN TEXT =================
      ) ~: c% |$ F: [+ Y6 n0 e- Y3 O
3386. 
      0 y! v& b; [2 E: S/ J9 w, |. N4 b- B
3387. (defun c:tob ()  (setvar "cmdecho" 0)
      
3388.     (prompt "\nHay chon dong TEXT can gach tren dau ")
      
3389.     (prompt "\nSelect objects: ")
      
3390.     (command "select" "au" pause)
      
3391.     (setq sstxt (ssget "p")
      
3392.           sslen (sslength sstxt)
      : i6 n  N, o4 j% E1 Q& H
3393.           ctr 0    )
      
3394.     (command ".undo" "mark")
      
3395.     (while (< ctr sslen)
      5 S9 k9 V4 _; T- F
3396.            (setq listxt (entget (ssname sstxt ctr))
      
3397.                  txttxt (cdr (assoc 1 listxt))
      ; B* @* t/ z8 {; P
3398.                  enttxt (cdr (assoc 0 listxt))   )
      ( W' n& j( k2 i$ A6 E' M/ n
3399.            (if (= enttxt "TEXT")
      , B% ~& ]6 }9 k8 q* Q; ^
3400.                (progn
      
3401.                    (setq testxt (substr txttxt 1 3))
      
3402.                    (if (or (= testxt "%%o") (= testxt "%%o"))
      $ W5 M7 k. X# B
3403.                        (setq newtxt (substr txttxt 4))
      . ]1 @1 B+ l1 Q1 H
3404.                        (setq newtxt (strcat "%%o" txttxt))    )
      
3405.                    (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
      
3406.                    (entmod listxt)                ) )
      
3407.             (setq ctr (1+ ctr))  )    (setvar "cmdecho" 1)    (princ))
      ; v9 y2 F! B) h' Y! x1 O2 u* S. {
3408. 
      
3409. ;;; ========================== Tim & thay the TEXT ==========================
      . i4 s: d" c+ E( S8 x4 ?+ `0 e, q
3410. 
      
3411. (defun frstring (str search replace / str1 str2 index find)
      0 K  G; u- O6 S9 g
3412. (setq index 0) (while  (<= index (- (strlen str) (strlen search)))  (setq index (1+ index))
      9 m9 u' H- l. p# c- ^
3413. (setq find (substr str index (strlen search)))  (if (= find search) (progn    (setq str1 (substr str 1 (1- index)))
      + [! l* m, t: |) N
3414. (setq str2 (substr str (+ index (strlen search))))  (setq str (strcat str1 replace str2)) )  ) ) (setq str str))
      
3415. (defun hai (/ dial)
      
3416. (setq dial (load_dialog "hai.dcl"))       ;;goi dialog
      & d" Q5 O1 z6 o* s9 t
3417. (if (not (new_dialog "find" Dial)) (exit)) ;;
      . E1 Y5 x- D/ ~# }4 ?
3418. (mode_tile "find" 2); Tao dau nhac tai hop thoai
      ( k7 i1 k; S* U; y6 w
3419. (action_tile "find" "(hai1)")
      
3420. (action_tile "replace" "(hai2)")
      
3421. (action_tile "cancel" "(done_dialog) (exit)")
      
3422. (start_dialog)      
      
3423. (unload_dialog dial))
      
3424. (defun hai1 () (SETQ str1 (get_tile "find")))
      
3425. (defun hai2 () (SETQ str2 (get_tile "replace")))
      . d0 W% u4 |+ Y- s( Y7 L
3426. 
      3 h; [5 G0 o. r- R6 c
3427. (defun c:TTT (/ a str str1 str2 newstr taphop sodem)
      
3428. (hai)
      
3429. (if (or (null str1) (null str2)) (princ "\nDu lieu khong hop le")
      ! [7 r0 S, z0 y( `% x9 w# p# S6 `
3430.   (progn
      
3431.    (setq taphop (ssget '((0 . "TEXT"))))
      6 p7 q. d, {" K" B5 ~
3432.    (setq sodem 0)
      + K7 ]9 \+ p( ]
3433.    (if taphop
      ( T  y" t6 t0 M. l( _2 ]3 Y8 K
3434.     (progn
      
3435.      (Repeat (sslength taphop)
      & S* B. R& E# [
3436.       (setq a (entget (ssname taphop sodem)))
        H" g' X7 A2 j' r0 y5 [9 l
3437.       (setq str (cdr (assoc 1 a)))
      ' A: P3 Z' f$ \, x) T
3438.       (setq newstr (frstring str str1 str2))
      
3439.       (setq a (subst (cons 1 newstr) (assoc 1 a) a))
      2 o' r; Y* H+ s! {7 f6 Q0 U6 T
3440.       (entmod a)
      2 a* p3 g, c8 O3 W6 k8 X
3441.       (setq sodem (1+ sodem))     )    )
      
3442.     (princ "\nNone "TEXT" selected")   )  ) ) (setq *error* olderr) (princ))
      
3443. 
      
3444. ;;;=============================  CHTEXSTY.LSP =============================
      $ T, O0 w2 M8 K4 u5 c2 G; s- U4 V' ~: Y
3445. 
      % e* s) m( V- V( E
3446. (Defun C:TXS () (Setvar "Cmdecho" 0) (Initget 1 "SE ST ")
      
3447. (Setq G (Strcase (Substr (Getkword "STyle/<SElection>:")1 2)))
      
3448. (Cond ((= G "SE") (Setq A (Ssget)) (Setq B (Sslength A))
      5 ~5 o. k  H; t2 P. n( R0 b% D
3449. (Initget 1) (Setq C (Getstring "\nEnter new text style: "))
      6 Z2 K% j+ \  ~' \9 _$ n# ^0 V4 i
3450. (Extang C) (While (> B 0) (Setq B (1- B)) (Setq D (Ssname A B))
      
3451. (Setq D (Entget D)) (Setq E (Assoc 7 D)) (Setq F (Cons 7 C))
      
3452. (Setq D (Subst F E D)) (Setq H (Assoc 51 D)) (Setq I (Cons 51 J))
        Y1 x/ @; a# M
3453. (Entmod (Subst I H D))) (Setq A nil)) ((Or (= G "ST") (= G ""))
      
3454. (Initget 1) (Setq A (Strcase (Getstring
      
3455. "\nEnter text style to change: "))) (Initget 1)
      
3456. (Setq C (Getstring "\nEnter new text style: "))(Setq D (Entnext))
      / }. h5 a$ t6 W+ q+ q% |
3457. (Extang C) (While D (Princ ".") (Setq E (Entget D)) (If
      # k- s+ Y+ c' F6 l% K
3458. (And (= "TEXT" (Cdr (Assoc 0 E))) (= A (Cdr (Assoc 7 E))))
      1 A6 L6 i) G" ]4 a' ^- _5 V6 z2 C
3459. (Progn (Setq F (Assoc 7 E)) (Setq G (Cons 7 C))
      
3460. (Setq E (Subst G F E)) (Setq H (Assoc 51 E)) (Setq I (Cons 51 J))
      % M2 f2 C* P4 R. F3 l1 p. L
3461. (Entmod (Subst I H E)))) (Setq D (Entnext D))))) (Princ))
      
3462. 
      
3463. (Defun Extang (A) (Setq A (Tblsearch "STYLE" A))
      6 q# h) [: H6 b" U8 E* e( ]: K0 q
3464. (Setq J (Cdr (Assoc 50 A))))
      % |7 o( B7 I# m8 f( y
3465. 
      ) g) v/ ^) `1 Z4 u' Y4 b0 _( _
3466. ;;; ============================ DRAW CLOUD =============================
      
3467. 
      
3468. (defun CLOUD (/ pt1 pt2 arc1 cnt ss la)    (setvar "cmdecho" 0)
      8 I; h- Y5 T9 z/ E! e! c
3469.     (prompt "\nVe cloud (may) khong khep kin - Tu khep kin ve diem dau!")
      - q7 _8 v' m8 i$ n  T" w9 \
3470.     (setq la (getvar "clayer"))
      3 o0 }8 S& [6 V
3471.     (command "layer" "m" "cloud" "c" "5" "" "")
      
3472.     (setq pt1 (getpoint "\nEnter first point of Cloud: "))
      + L6 m6 i9 b) ~: `6 e- t
3473.     (if pt1 (prompt "\nProceed in a COUNTER-CLOCKWISE direction..."))
      
3474.     (setq cnt 1 ss (ssadd))
      
3475.     (while pt1 (setq pt2 (getpoint "\nEnter next point - and close: "))
      
3476.     (if pt2 (progn (command "arc" pt1 "e" pt2 "r" (/ (distance pt1 pt2) 1.75))
      4 b) m6 K+ O7 Y  N7 ^: j
3477.     (if (= cnt 1) (setq arc1 (entlast) cnt 2) (ssadd (entlast) ss)) ))
      
3478.     (setq pt1 pt2) ) (setvar "highlight" 0) (if (> (sslength ss) 0)
      + q* d$ N/ Y; _& R; E" f
3479.     (command "pedit" arc1 "y" "j" ss "" "x")
      
3480.     (if arc1 (command "pedit" arc1 "y" "x")) ) (setvar "highlight" 1)
        w. R9 J8 a0 Q7 }% Z3 t# [, ]: F% t
3481.     (command "layer" "s" la "")    (setvar "cmdecho" 1)    (princ))  
      
3482. (DEFUN C:CLOUD () (CLOUD)) (DEFUN C:CLO () (CLOUD))
      
3483. 
      # s; x* S1 P4 o& k, C3 m1 v* T, f
3484. ;;; ================================ Funtion-Dulieu ========================
      
3485. ;;; ================================ Funtion-Dulieu ========================
      / O; u7 ~0 l% p9 F0 |
3486. ;;; ================================ Funtion-Dulieu ========================
      ' R2 Q+ t4 |0 ^% [
3487. 
      
3488. (defun ha:nhap (kytu thamso) (princ kytu) (princ thamso) (princ ">: ") (setq key (getint)) (if key (setq thamso key)) (princ thamso) )
      ) O7 z, I8 I$ c  a
3489. (defun ha:thoat () (reinit) (setq Temp "Da thoat khoi chuong trinh"))
      
3490. (defun khoangcach (kh khq11 khq12 / h0 h1) (setq h1 (polar kh (angle '(0 0) (vectophap khq11 khq12)) 500)) (setq h0 (inters khq11 khq12 kh h1 nil)) (distance kh h0))
      4 k1 p6 f7 t; z2 a: J& o' Z
3491. (defun hacat (hacat1 hacat2 / hacat3 chon) (if (and (/= hacat1 nil) (/= hacat2 nil)) (progn   (setq hacat3 (polar hacat1 (angle hacat1 hacat2) (/ (distance hacat1 hacat2) 2)))   (setq chon (ssget hacat3))   (command "break" chon hacat1 hacat2)  ) ) (princ) )
      ; I) t- t9 Y1 g( o7 E: h
3492. (defun hauon (hauon1 hauon2) (command "fillet" hauon1 hauon2))
      
3493. (defun init () (setvar "blipmode" 0) (setvar "cmdecho" 0) (setvar "angbase" 0))
      
3494. (defun reinit () (setvar "cmdecho" 1) (setvar "osmode" 0))
      
3495. (defun tichvecto (vecto1 vecto2) (apply '+ (mapcar '* vecto1 vecto2)))
      
3496. (defun vectophap (v01 v02 / vectochiphuong) (setq vectochiphuong (mapcar '- v01 v02)) (list (cadr vectochiphuong) (* -1 (car vectochiphuong))))
      
3497. (defun ha:giaodiem (dc1 p1 p2 / hc hc1 diem1) (setq diem1 (vectophap p1 p2)) (setq hc1 (polar dc1 (angle '(0.0 0.0) diem1) 100)) (setq hc (inters p1 p2 dc1 hc1 nil)))
      
3498. (defun dtr (dtr) (* pi (/ dtr 180.0)))
      3 V5 }" W# d0 |' ]/ e, n6 o
3499. (defun rtd (rtd) (* 180.0 (/ rtd pi)))
      8 y$ D4 Y" y" Y* L4 K
3500. 
      " y+ M- [* [" U" O: l
3501. ;;;==============================PROGRAME===============================
      
3502. ;;;=====================EditDiM Hien Hop Thoai Dep======================
      
3503. ;;;==============================PROGRAME===============================
      , d8 U' w9 J6 s) q3 B+ z
3504. 
      
3505. ;;Dth Edit Text, Dimtex & Attributes(Chu Co Thuoc Tinh)
      ' l$ o+ R' t7 t; k2 k5 P/ t
3506. ;;Chay Cung Du Lieu.Lsp & Hai.Dcl
      6 u5 D5 o' Y' {. ^& h, I! b
3507. (Defun Hai_Edim (Chon / Dial State Str Oldlis Dimdefault Pt10 Pt13 Pt14 St Ang Dis Pt Hc)
      
3508.   (Setq Oldlis (Entget (Car Chon))
      
3509.         Pt10 (Cdr (Assoc 10 Oldlis))
      3 o  H/ W7 O, n+ Q# b6 G* q
3510.         Pt13 (Cdr (Assoc 13 Oldlis))
      
3511.         Pt14 (Cdr (Assoc 14 Oldlis))
      1 u% ~! E0 U, z
3512.         St  (Cdr (Assoc 70 Oldlis))
      : H8 ]3 s+ j. W' p  E. k
3513.         Dimdefault (Cdr (Assoc 1 Oldlis))
      3 T6 h* ]7 J; _- @% O0 ^
3514.         )
      
3515.   (Cond
      
3516.     ((Or (= 32 St)(= 0 St)(= 160 St))
      
3517.      (Progn
      # i+ p$ b* X5 r! b; f& u1 A
3518.        (Setq Ang (Cdr (Assoc 50 Oldlis))
      
3519.              Pt (Polar Pt13 Ang 500)
      + `3 {6 C; j, d3 _' s; \: z
3520.              Hc (Lay_Hinh_Chieu Pt10 Pt13 Pt)
      ; M9 M- [- h$ l
3521.              Dis (Rtos (Distance Pt13 Hc))
      4 p" J0 v% r0 e/ ?1 Y
3522.              )
      
3523.        )
      
3524.      )
      ' f- `, c6 R9 M+ H0 b
3525.     ((Or (= 33 St)(= 1 St))
      
3526.      (Progn(Setq Dis (Rtos (Distance Pt13 Pt14)))))
      7 C( `3 f) u  C6 H5 k/ d& J
3527.     );;End Cond
      
3528.   (If (= Dimdefault "") (Setq Dimdefault "<>"))
      
3529.   (Setq Dial (Load_Dialog "Hai.Dcl"))
      : X3 ~( I3 x. Z( Y  Y2 ^
3530.   (If (Not (New_Dialog "eddim" Dial)) (Exit))
      ; L6 i; X+ x* e/ s% v: {
3531.   (If (Or (= 32 St)(= 0 St)(= 160 St)(= 33 St)(= 1 St))
      : Y! g! Y# U) y5 r8 B: b
3532.     (Set_Tile "text" Dis))
      + Z$ X6 j  t' o% Y
3533.   (Set_Tile "ha:edim" Dimdefault)
      
3534.   (Mode_Tile "ha:edim" 2); Tao Dau Nhac Tai Hop Thoai
      
3535.   (Action_Tile "ha:edim" "(Setq Str (Get_Tile \"ha:edim\"))(Done_Dialog 3)")
      , a1 r/ L5 m3 Z6 ^: {2 ~! p" A1 N7 e
3536.   (Setq State (Start_Dialog))(Unload_Dialog Dial)
      
3537.   (If (And Str (= 3 State))
      
3538.     (Progn
      
3539.       (Setq Oldlis (Subst (Cons 1 Str) (Assoc 1 Oldlis) Oldlis))(Entmod Oldlis)))
      
3540.   )
      * X6 N" H( q+ r( c
3541. (Defun C:EH (/ Chon Name )
      0 T3 O! S/ y# D5 x* U
3542.   (Defun *Error* (Msg)
      
3543.     (Princ "\nerror: ")(Princ Msg)(Princ "  ")
      / I, R5 u  w* s. J; m9 x8 o7 K. l; m
3544.     (Start_Dialog)(Unload_Dialog Dial)
      2 l2 W% U' \4 N8 w( A" u
3545.     (Setq *Error* Olderr)(Princ)
      
3546.     )
      3 P- h# z: J) r3 M4 O
3547.   (Setq Olderr *Error*)
      
3548.   (Setq Chon T)
      0 O2 t1 o+ w) a
3549.   (While Chon
      
3550.     (Setq Chon (Entsel "\n\n\nSelect Text, Dimtext Or Attributes To Edit..."))
      
3551.     (If Chon
      0 k- b! x  E. g
3552.       (Progn
      
3553.         (Setq Name (Cdr (Assoc 0 (Entget (Car Chon)))))
      ' d/ s$ Q; m" f) L" h
3554.         (Cond
      " y7 W9 k4 I$ M' Q; h
3555.           ((= Name "INSERT")(Command "Ddatte" Chon))
      + J, q5 s# K; k' E. L
3556.           ((Or (= Name "TEXT") (= Name "ATTDEF") (= Name "TOLERANCE") (= Name "MTEXT"))(Command "Ddedit" Chon ""))
      
3557.           ((= Name "DIMENSION") (Hai_Edim Chon))
      
3558.           )
      
3559.         );End Cond
      
3560.       );End Progn
      
3561.     );End While
      ! z1 C# \4 ]# [- A7 }. E; B. p' {
3562.   (Setq Olderr *Error*)(Princ)
      
3563.   );End Program
      ) [# m# T. K* Y7 K7 x: N$ B
3564. 
      
3565. ;;;====================DDeditDim=====================
      
3566. ;;;=====================Hai.DCL======================
      
3567. ;;;====================DDeditDim=====================
      - F& _5 b/ ?4 }6 h. J4 I7 x
3568. 
      8 T+ ?9 P# G# ?  j; ~& j# u
3569. ;;Dth Edit Text, Dimtex & Attributes(Chu Co Thuoc Tinh)
      
3570. ;;Chay Cung Du Lieu.Lsp & Hai.Dcl
      
3571. (Defun Hai_Edim (Chon / Dial State Str Oldlis Dimdefault Pt10 Pt13 Pt14 St Ang Dis Pt Hc)
      
3572.   (Setq Oldlis (Entget (Car Chon))
      
3573.         Pt10 (Cdr (Assoc 10 Oldlis))
      / _% B& h) U+ e: r1 o& X
3574.         Pt13 (Cdr (Assoc 13 Oldlis))
      
3575.         Pt14 (Cdr (Assoc 14 Oldlis))
      
3576.         St  (Cdr (Assoc 70 Oldlis))
      
3577.         Dimdefault (Cdr (Assoc 1 Oldlis))
      
3578.         )
      
3579.   (Cond
      
3580.     ((Or (= 32 St)(= 0 St)(= 160 St))
      
3581.      (Progn
      ) _$ g% N, k  L0 r4 _0 z- T
3582.        (Setq Ang (Cdr (Assoc 50 Oldlis))
      ! D  Z* J! ~9 {1 e, x. n, q
3583.              Pt (Polar Pt13 Ang 500)
      " a1 k; f* K6 e% T. u
3584.              Hc (Lay_Hinh_Chieu Pt10 Pt13 Pt)
      2 E+ @0 i5 t! x5 |/ ]4 ]
3585.              Dis (Rtos (Distance Pt13 Hc))
      
3586.              )
      
3587.        )
      
3588.      )
      3 ]: B- t- L; z# O0 n6 r
3589.     ((Or (= 33 St)(= 1 St))
      - q$ _% w! H) U% m% q: G. l
3590.      (Progn(Setq Dis (Rtos (Distance Pt13 Pt14)))))
      6 L) P& {0 J0 x+ ]& `- y
3591.     );;End Cond
      
3592.   (If (= Dimdefault "") (Setq Dimdefault "<>"))
      
3593.   (Setq Dial (Load_Dialog "Hai.Dcl"))
      
3594.   (If (Not (New_Dialog "eddim" Dial)) (Exit))
      
3595.   (If (Or (= 32 St)(= 0 St)(= 160 St)(= 33 St)(= 1 St))
      
3596.     (Set_Tile "text" Dis))
      ( `2 U. ~# i! a: k$ `
3597.   (Set_Tile "ha:edim" Dimdefault)
      ) m7 y$ K. Q2 s. [. i7 l- p8 P
3598.   (Mode_Tile "ha:edim" 2); Tao Dau Nhac Tai Hop Thoai
      
3599.   (Action_Tile "ha:edim" "(Setq Str (Get_Tile \"ha:edim\"))(Done_Dialog 3)")
      6 p9 t  c; {) Z$ R% y3 `3 F- Z# R; [
3600.   (Setq State (Start_Dialog))(Unload_Dialog Dial)
      
3601.   (If (And Str (= 3 State))
      
3602.     (Progn
      ' }# G0 t% o# E1 D! f# M1 U
3603.       (Setq Oldlis (Subst (Cons 1 Str) (Assoc 1 Oldlis) Oldlis))(Entmod Oldlis)))
      8 C! i6 I& @1 x& d" K
3604.   )
      7 V# U" f* h( X9 a7 k) s
3605. (Defun C:EH (/ Chon Name )
      
3606. 
      " i# f; \- A& B: x1 w9 a- _
3607. ;;;********************Du Lieu********************
      
3608. 
      
3609. (Defun Ha:Thoat () (Reinit) (Setq Temp "Da Thoat Khoi Chuong Trinh"))
      + L- i6 O/ i8 p* G# D3 u( W* ]
3610. (Defun Hacat (Hacat1 Hacat2 / Hacat3 Chon)
      - G1 b7 T, ?: u/ m  C- g
3611.   (If (And (/= Hacat1 Nil) (/= Hacat2 Nil))
      
3612.     (Progn
      1 F4 S" E; E' ]. A* g
3613.       (Setq Hacat3 (Polar Hacat1 (Angle Hacat1 Hacat2) (/ (Distance Hacat1 Hacat2) 2)))
      ! O% N/ y# E! \, T. \& O
3614.       (Setq Chon (Ssget Hacat3))
      
3615.       (Command "Break" Chon Hacat1 Hacat2)
      & v! y1 g; \! I+ G" j- [
3616.       )
      
3617.     )
      
3618.   (Princ)
      2 V9 a& q3 i4 U2 ~' I/ n
3619.   )
      
3620. ;;
      - e1 M$ w% G1 {- ~' h# k
3621. (Defun Hauon (Hauon1 Hauon2)(Command "Fillet" Hauon1 Hauon2))
      
3622. ;;
      
3623. (Defun Taolop (Mau Lop / A)(Setq A(Tblsearch "Layer" Lop))(If (Null A)(Command "Layer" "_N" Lop "_C" Mau Lop "")) (Setvar "Clayer" Lop))
      
3624. ;;
      7 I) V# d0 P" ^
3625. (Defun Init ()(Setvar "Blipmode" 0)(Setvar "Cmdecho" 0)(Setvar "Angbase" 0))
      
3626. ;;
        F) d7 @# ]3 z; m$ H$ P
3627. (Defun Reinit ()(Setvar "Cmdecho" 1))
      
3628. ;;
      
3629. (Defun Tichvecto (Vecto1 Vecto2)(Apply '+ (Mapcar '* Vecto1 Vecto2)))
      
3630. ;;
      " S3 `8 L! q6 h1 ]6 D4 y( Z
3631. ;;Cho 2 Diem Tinh Ra Vec To Phap
      7 n2 G8 U; x+ d' F
3632. (Defun Vectophap (V01 V02 / Vectochiphuong)(Setq Vectochiphuong(Mapcar '- V01 V02)) (List (Cadr Vectochiphuong) (* -1 (Car Vectochiphuong))))
      ! M+ A! c! t1 \& z. }5 ]$ T
3633. ;;Xac Dinh Vi Tri Hinh Chieu 1 Diem Len 1 Duong Thang
      : y+ F7 x$ P7 t" p
3634. ;;Da Biet 2 Diem Thuoc Duong Thang
      
3635. (Defun Lay_Hinh_Chieu (Dc1 P1 P2 / Hc Dc2)
      
3636.   (Setq Dc2 (Polar Dc1 (+ (/ Pi 2) (Angle P1 P2)) 100)
      
3637.         Hc (Inters P1 P2 Dc1 Dc2 Nil)))
      ' V& l# C7 U7 Q, [  B( |
3638. ;;Xac Dinh Khoang Cach Tu 1 Diem Len 1 Duong Thang
      
3639. ;;Da Biet 2 Diem Thuoc Duong Thang
      . k5 a# g  N& W" ^: Z& m
3640. (Defun Khoangcach (Dc1 P1 P2 / Dc2 Hc)
      
3641.   (Setq Dc2 (Polar Dc1 (+ (/ Pi 2) (Angle P1 P2)) 100)
      ( v+ N8 _8 v" |0 t. K  Y. t
3642.         Hc (Inters P1 P2 Dc1 Dc2 Nil))
      6 j# }7 b/ h1 z# [$ D, B6 k& P
3643.   (Distance Dc1 Hc)
      
3644.   )
      
3645. (load "nhapcua.lsp")
      * l" r7 `& f+ T+ u( J8 {% @& |9 x
3646.   (Defun *Error* (Msg)
      4 V+ j4 F: ~7 b8 w
3647.     (Princ "\nerror: ")(Princ Msg)(Princ "  ")
      
3648.     (Start_Dialog)(Unload_Dialog Dial)
      3 M! R+ T5 l( z8 b4 g- }
3649.     (Setq *Error* Olderr)(Princ)
      
3650.     )
      5 l% z( J) I( y
3651.   (Setq Olderr *Error*)
      % F, d+ E+ d! T, J3 S3 G
3652.   (Setq Chon T)
      
3653.   (While Chon
      ) N9 b+ }. }5 {% g# o
3654.     (Setq Chon (Entsel "\n\n\nSelect Text, Dimtext Or Attributes To Edit..."))
      4 R3 A: q7 j) A/ }
3655.     (If Chon
      ( |# H+ W4 K1 @7 y. n
3656.       (Progn
      
3657.         (Setq Name (Cdr (Assoc 0 (Entget (Car Chon)))))
      ; H5 l% o- H1 j  _9 {
3658.         (Cond
      
3659.           ((= Name "INSERT")(Command "Ddatte" Chon))
      
3660.           ((Or (= Name "TEXT") (= Name "ATTDEF") (= Name "TOLERANCE") (= Name "MTEXT"))(Command "Ddedit" Chon ""))
      
3661.           ((= Name "DIMENSION") (Hai_Edim Chon))
      
3662.           )
      
3663.         );End Cond
      % Z/ r0 g  m  |3 k5 Z
3664.       );End Progn
      
3665.     );End While
      
3666.   (Setq Olderr *Error*)(Princ)
      9 b  S; O# ?: q& d( ~- ]) f! |
3667.   );End Program
      7 v$ \- v4 I: Y
3668. 
      6 [3 n- a' B3 @3 V
3669. ;===================HAI DCL Nhapcua.LSP De chay Hop Thoai EditDiM===================
      , D- x9 e) I* T, s# j
3670. ;====================================Nhapcua.LSP====================================
      
3671. ;===================HAI DCL Nhapcua.LSP De chay Hop Thoai EditDiM===================
      
3672. 
      ; Z- L7 B9 |' K- T
3673. 
      ; p2 Q5 o1 A# x, j
3674. 
      
3675. ;*******************;*******************;*******************;*******************
      
3676. ;****K E T C A U****;****K E T C A U****;****K E T C A U****;****K E T C A U****
      * f5 Y5 \  |- L; p& D
3677. ;*******************;*******************;*******************;*******************
      3 D% c4 J6 D! Q! F2 f
3678. 
      : n, m/ s! L8 k3 T( _& j
3679. ;VE HINH BINH HANH
        U( N! Q! W9 A) x  h5 N
3680. 
      
3681. (defun c:binhhanh (/ p1 p2 p3)
      * Q8 W$ k7 Q' t
3682. (setq p1 (getpoint "\n Nhap diem thu nhat:"))
      
3683. (setq p2 (getpoint p1 "\n Nhap diem thu hai:"))
      / V; d! f0 f  f5 H& N$ F' R5 F" s4 W
3684. (setq om (getvar "osmode"))
      
3685. (setvar "osmode" 0)
      ' M4 {6 Z% B8 \# V3 z& n: O# }
3686. (command "line" p1 p2 "")
      $ E) A+ q( {4 t
3687. (setvar "osmode" om)
      % m0 i% p2 V, r5 ^5 c; j9 X
3688. (setq p3 (getpoint p2 "\n Nhap diem thu ba:"))
      
3689. (setq a (angle p2 p1))
      $ s7 F) u( j3 W4 s/ S0 T6 r
3690. (setq d (distance p1 p2))
      % q3 p% k9 C4 h0 J
3691. (setq p4 (polar p3 a d))
      2 T/ E, z! g7 L9 K/ i/ }* I, f
3692. (command "OSNAP" "none")
      
3693. (command "erase" "l" "")
      8 x% N- z% x; \2 ^% p/ n( j. R
3694. (command "pline" p1 p2 p3 p4 p1 "")
      
3695. (setvar "osmode" om)
      " \) L0 t. T" g: B# y
3696. )
      $ l' Y4 i" h' n' o+ c
3697. 
      ' x% f6 e( F: X' Z
3698. ;VE LUOI COT
      / y4 O- R/ `' z. H; H3 d
3699. 
      
3700. (defun c:LuoiCot ()
      
3701. (setq om (getvar "osmode"))
      5 S9 r$ P3 D& |4 Y+ O6 i1 }
3702. (setvar "osmode" 0)
      ) T6 Q( N( G, I- O+ d
3703. (setq tile (getreal "\nCho biet Ti Le ve 1/x, x="))
      ' s% Y% I2 b- P/ ?
3704. (setq p0 (getpoint "\n Chon Basic Point:"))
      + K" j# T5 y$ [* w% R
3705. (setq nc (getreal "\n Nhap chieu ngang cua cot : "))
      " V% O7 o: k: Y" {) g  n
3706. (setq dc (getreal "\n Nhap chieu doc cua cot : "))
      
3707. (setq p1         (polar         (polar p0 pi (/ (* nc hstl) 2 tile) )    (* pi 1.5)    (/ (* dc hstl) 2 tile)  )  )
      
3708. (setq p2         (polar         (polar p0 0 (/ (* nc hstl) 2 tile) )    (* pi 0.5)    (/ (* dc hstl) 2 tile)  )  )
      , U# V3 y9 O% \  S# f( a
3709. (command "rectang" p1 p2)
      3 p7 N; h6 r9 d; h. O$ N' _4 w4 ^/ h
3710. (command "hatch" "solid" "l" "")
      
3711. (setq bcn (getreal "\n Buoc cot theo phuong ngang : "))
      ; T' A5 D. N+ {( p3 H6 @( ~; a% ~
3712. (setq nn (getint "\n So buoc cot phuong ngang : "))
      
3713. (setq w1         (polar         (polar p1 pi (/ (* nc hstl) 2 tile) )    (* pi 1.5)    (/ (* dc hstl) 2 tile)  )  )
      
3714. (setq w2         (polar         (polar p2 0 (/ (* nc hstl) 2 tile) )    (* pi 0.5)    (/ (* dc hstl) 2 tile)  )  )
      5 B0 Z' k. G7 ^/ f! g
3715. (command "select" "w" w1 w2 "")
      + g+ [; }, ~- c' x4 V+ _6 f
3716. (command "array" "p" "" "r" "1" (+ nn 1) (/ (* bcn hstl) tile) )
      
3717. (command "line" (polar p0 pi (/ (* 1000 hstl) tile)) (polar p0 0 (/ (* (+ (* bcn nn) 1000) hstl) tile) ) "")
      ) `. a1 L7 {2 H5 w, E4 |3 I- V
3718. (setq w1 (polar (polar p0 pi (/ (* hstl 2000) tile)) (* pi 1.5)  (/ (* hstl 2000) tile) ))
      " V: }/ t$ d' h" w, m! C+ m/ o
3719. (setq w2 (polar (polar p0 0 (/ (* (+ (* bcn nn) 2000) hstl) tile) ) (* pi 0.5)  (/ (* hstl 2000) tile) ))
      
3720. (command "zoom" "w" w1 w2)
      
3721. (command "select" "w" w1 w2 "")
      4 H  r- D$ g& l2 @" @  Y
3722. (setq bcd (getreal "\n Buoc cot theo phuong doc : "))
      2 Y8 w! }& y$ A9 l8 F3 Q# Z3 F& D
3723. (setq nd (getint "\n So buoc cot phuong doc : "))
      ' A: x( [! _( d, s# E
3724. (command "array" "p" "" "r" (+ nd 1) "1" (/ (* hstl bcd) tile) )
      
3725. (command "line" (polar p0 (* pi 1.5) (/ (* hstl 1000) tile))  (polar p0 (* pi 0.5)  (/ (* (+ (* bcd nd) 1000) hstl) tile))  "")
      
3726. (command "array" "l" "" "r" "1" (+ nn 1) (/ (* hstl bcn) tile) )
      7 o5 u+ r9 ~2 T! W4 G
3727. (setq w2 (polar w2 (* pi 0.5) (/ (* (+ (* bcd nd) 2000) hstl) tile))  )  
      6 `) D, \6 A7 C7 T
3728. (command "zoom" "w" w1 w2)
      0 y# x* M* v; v3 C3 A/ O7 r
3729. (setvar "osmode" om)
      . f5 e- [6 x$ g5 d) l: Y
3730. )
      " @. U0 [$ \( T$ `1 r& l2 l
3731. 
      ( Y% t: |0 y0 T
3732. ;VE CUA DI
      
3733. 
      0 w0 s; C6 o! o# h" Y& V* _; S
3734. (defun c:cuadi ()
      
3735. (setq om (getvar "osmode"))
      
3736. (setvar "osmode" 0)
      
3737. 
      & y8 \$ u- R" U; S
3738. (setq tile (getreal "\nCho biet Ti Le ve 1/x, x="))
      # C5 \! R7 b( m" y. v) G
3739. (setq b (getreal "\n Nhap be rong cua : "))
      
3740. (setvar "osmode" om)
      
3741. (while (< 0 1)
      
3742. (progn
      & R8 W& @7 C' A  c: p
3743. (setq p0 (getpoint "\n Chon Basic Point:"))
      ' H3 F! O* S  B' S- {! d6 M
3744. (setq p1 (getpoint p0 "\n Chon diem de xac dinh huong cua cua:"))
      
3745. (command "osnap" "none")
      
3746. (setq p2 (getpoint p0 "\n Chon diem de xac dinh huong mo cua:"))
      / w7 G& v7 E+ I$ _1 ]0 @; h6 R
3747. (setq a1 (angle p0 p1))
      
3748. (setq p1 (polar p0 a1 (/ (* hstl b) tile)))
      % T4 y. z2 f" b) E5 n
3749. (setq a2 (angle p0 p2))
      
3750. (if (< (- a2 a1) pi) (setq a3 (+ (/ pi 2) a1)) (setq a3 (- a1 (/ pi 2))) )
      
3751. (command "pline" p0 "w" "0" "0" p1 (polar p1 a3 (/ (* hstl 40) tile)) (polar p0 a3 (/ (* hstl 40) tile)) p0 "")
      : l0 V# ]6 e5 A% U) y" f
3752. (command "rotate" "l" "" p0 (/ (* (- a3 a1) 180) pi))
      
3753. (command "arc" "ce" p0 p1 "a" (/ (* (- a3 a1) 180) pi))
      
3754. (setvar "osmode" om)
      7 W3 g, q' D$ R# p
3755. ))
      
3756. )
      
3757. 
      
3758. ;VE CUA SO
      * d  {5 r* |( y! Y' w, z
3759. 
      # L6 o0 T4 @; f. t5 k/ k
3760. (defun c:cuaso ()
      9 ?! j  g* M7 B0 _; F
3761. (setq om (getvar "osmode"))
      , p* j4 o% k# v
3762. (setvar "osmode" 0)
      2 o& {4 A% R9 _" x7 r) \$ @, P3 E7 T
3763. 
      
3764. (setq tile (getreal "\nCho biet Ti Le ve 1/x, x="))
      1 d( b: U0 b8 b0 T- {
3765. (setvar "osmode" om)
      $ y: W4 g  _% M& |+ d
3766. (while (< 0 1)
      
3767. (progn
      
3768. (setq p0 (getpoint "\n Chon Basic Point:"))
      6 @3 r1 a' _+ m" S
3769. (setq p1 (getpoint p0 "\n Chon diem de xac dinh be rong cua:"))
      
3770. (command "osnap" "none")
      
3771. (setq p2 (getpoint p1 "\n Chon 1 diem o trong nha de xac dinh huong cua so:"))
      
3772. (setq b (distance p0 p1))
      * z5 `: p6 G* m1 E3 H, O$ Y
3773. (if (< b  (/ (* hstl 600) tile)) (setq du 50))
      
3774. (if (> b  (/ (* hstl 600) tile)) (setq du 150))
      ' |! d; y: G  a; o! y
3775. (if (> b (/ (* hstl 1800) tile)) (setq du 200))
      ! Y" m* ^" b+ c. N, H+ l
3776. (setq a1 (angle p0 p1))
      / I1 |* s8 Z% A$ I
3777. (setq a2 (angle p0 p2))
      
3778. (if (> a2 pi) (setq a2 (- a2 (* pi 2)) )  )
      % t% i- P' q7 j7 i( n9 A' D
3779. (if (> (- a2 a1) 0) (setq a3 (+ (/ pi 2) a1))  )
      & `9 k- |, j& M  [
3780. (if (> (- a1 a2) 0) (setq a3 (- a1 (/ pi 2)))  )
      
3781. (command "pline" p0 "w" "0" "0" p1 "")
      4 m. ?4 R5 ^/ o8 g/ V5 j
3782. (command "pline" (polar p0 a3 (/ (* hstl 50) tile)) (polar p1 a3 (/ (* hstl 50) tile)) "")
      
3783. (command "pline" (polar p0 a3 (/ (* hstl 100) tile)) (polar p1 a3 (/ (* hstl 100) tile)) "")
      - q+ t; G+ [8 a+ q; r5 g- D1 }
3784. (command "pline" (polar p0 a1 (* (- du) (/ hstl tile))) (polar (polar p0 a1 (* (- du) (/ hstl tile))) a3 (* -100 (/ hstl tile)))
      $ C& `, e+ S; p4 L  S3 g1 t
3785.                 (polar (polar p1 a1 (* du (/ hstl tile))) a3 (* -100 (/ hstl tile))) (polar p1 a1 (* du (/ hstl tile))) "")
      0 e2 g3 C4 }' t; D4 r+ W
3786. (setvar "osmode" om)
      
3787. ))
      1 I: Y. r1 F4 Q
3788. )
      
3789. 
      % c" O) F  ^- a5 E3 _
3790. ;;;=== General Utility Functions ===
      
3791. 
      
3792. ;   R12 compatibility - In R12 (acad_helpdlg) was an externally-defined
      $ I/ g) v2 g8 n4 G( E  U( i  \- n
3793. ;   ADS function.  Now it's a simple AutoLISP function that calls the
      
3794. ;   built-in function (help).  It's only purpose is R12 compatibility.  
      
3795. ;   If you are calling it for anything else, you should almost certainly
      & c' [1 d6 b4 i0 I: j/ l
3796. ;   be calling (help) instead.
      / }4 S7 ^8 i& w$ ~4 Q0 q
3797. 
      
3798. (defun acad_helpdlg (helpfile topic)
      
3799.   (help helpfile topic)
      $ A: s% L, R& X: y$ S
3800. )
      
3801. 
      $ ^& m3 B( {1 y" Z+ V3 R( M
3802. 
      
3803. (defun *merr* (msg)
      
3804.   (setq *error* m:err m:err nil)
      ( x% p. L4 ^) C) N" T7 H) w
3805.   (princ)
      
3806. )
      
3807. 
      
3808. (defun *merrmsg* (msg)
      ) j6 }) g: |4 s) o2 L  L
3809.   (princ msg)
      
3810.   (setq *error* m:err m:err nil)
      # t% r* t2 {9 g3 u
3811.   (princ)
      
3812. )
      6 s: p6 z8 \  D9 s; I* c
3813. 
      6 w/ W: @. t* k- k+ z& [- a
3814. ;; Loads the indicated ARX app if it isn't already loaded
      & [( T7 U) C% ~
3815. ;; returns nil if no load was necessary, else returns the
      1 k3 C( h9 O: p5 j1 E( Q
3816. ;; app name if a load occurred.
      
3817. (defun verify_arxapp_loaded (app)
      
3818.   (if (not (loadedp app (arx)))
      
3819.       (arxload app f)
      * u* x/ x6 x, ]. K
3820.   )
      
3821. )
      0 ^  F. G) _" T& p2 e4 i
3822. 
      & l6 N4 |  b" q0 u9 Q5 I4 b
3823. ;; determines if a given application is loaded...
      
3824. ;; general purpose: can ostensibly be used for appsets (arx) or (ads) or....
      2 \$ A& W/ a* w- T
3825. ;;
      
3826. ;; app is the filename of the application to check (extension is required)
      ) X, j! M( }) N; B( D
3827. ;; appset is a list of applications, (such as (arx) or (ads)
      
3828. ;;
      
3829. ;; returns T or nil, depending on whether app is present in the appset
      $ d3 l1 ?2 R7 N$ q& X
3830. ;; indicated.  Case is ignored in comparison, so "foo.arx" matches "FOO.ARX"
      4 f, b, R$ m2 R9 z6 t
3831. ;; Also, if appset contains members that contain paths, app will right-match
      
3832. ;; against these members, so "bar.arx" matches "c:\\path\\bar.arx"; note that
      ' ?0 [7 N5 d3 s2 N0 J7 v/ Y. J- `% x( w
3833. ;; "bar.arx" will *not* match "c:\\path\\foobar.arx."
      9 D( h% \$ v8 }6 I
3834. (defun loadedp (app appset)
      " Q8 E! V1 a0 P5 ?3 M( D+ l
3835.   (cond (appset  (or
      7 x$ F# x# {4 t3 [) Q
3836.                      ;; exactly equal? (ignoring case)
      1 ?6 k5 j* d$ `+ E
3837.                      (= (strcase (car appset))
      
3838.                         (strcase app))
      
3839.                      ;; right-matching? (ignoring case, but assuming that
        B9 o& x& J  V
3840.                      ;; it's a complete filename (with a backslash before it)
      
3841.                                          (and
      ) u, J! a* e) C# Q6 O' q5 U4 ~
3842.                                              (> (strlen (car appset)) (strlen app))
      6 `7 s' r4 ^' {: f. e6 {' J
3843.                              (= (strcase (substr (car appset)
      
3844.                                                  (- (strlen (car appset))
      8 K: Q% T6 z; x9 O5 ~
3845.                                                     (strlen app)
      3 d% _- @* L0 P7 F
3846.                                                  )
      
3847.                                          )
      & g; o; y" {8 i! h2 Z" M
3848.                                 )
      ) G* ]( R& ], U- W
3849.                                 (strcase (strcat "\\" app))
      : V2 g! R; v9 y* D3 |' x
3850.                              )
      % U4 x" H$ }1 T+ x/ B- p
3851.                                      )
      * C: u& p8 q/ q4 q0 ^
3852.                      ;; no match for this entry in appset, try next one....
      
3853.                      (loadedp app (cdr appset)) )))
      
3854. )
      / l' i* `# |6 \: H9 G1 r
3855. 
      
3856. 
      0 F  L# L* ^& k( W
3857. ;;; ===== Single-line MText editor =====
      
3858. (defun LispEd (contents / fname dcl state)
      
3859.   (if (not (setq fname (getvar "program")))
      9 e6 i% b/ c" M, f& l7 [
3860.      (setq fname "acad")
      
3861.   )
      6 K) ]/ _* T- b
3862.   (strcat fname ".dcl")
      
3863.   (setq dcl (load_dialog fname))
      ) L* s. s4 [. K3 C% p5 {' V
3864.   (if (not (new_dialog "LispEd" dcl)) (exit))
      - b( I8 _1 _. t8 M! J
3865.   (set_tile "contents" contents)
      
3866.   (mode_tile "contents" 2)
      
3867.   (action_tile "contents" "(setq contents $value)")
      
3868.   (action_tile "accept" "(done_dialog 1)")
      
3869.   (action_tile "mtexted" "(done_dialog 2)" )
      , \- _- p, G9 g! P
3870.   (setq state (start_dialog))
      
3871.   (unload_dialog dcl)
      / W: L8 X* Z  ^, z% F' T5 {( g# `# J
3872.   (cond
      
3873.     ((= state 1) contents)
      # n# O5 z: I% a+ ?" |% E
3874.     ((= state 2) -1)
      9 T" I: {' j, k+ C/ P
3875.     (t 0)
      
3876.   )
      % x/ d$ B! ^, q) f- I2 a
3877. )
      
3878. 
      
3879. ;;; ===== Discontinued commands =====
      4 b- y; q/ [! Z! }
3880. (defun c:ddselect(/ cmdecho-save)
      
3881.   (setq cmdecho-save (getvar "CMDECHO"))
      
3882.   (setvar "CMDECHO" 0)
      0 q0 h. F& {7 r7 _: U; Q
3883.   (command "._+options" 7)
      7 t  i) W* t. R8 B$ ~6 Q
3884.   (setvar "CMDECHO" cmdecho-save)
      ' G1 w: u( b& i' \: H
3885.   (princ)
      
3886. )
      0 d& w! k, u9 ?) m; B
3887. 
      
3888. (defun c:ddgrips(/ cmdecho-save)
      
3889.   (setq cmdecho-save (getvar "CMDECHO"))
      9 ?' i* b% G# c# d
3890.   (setvar "CMDECHO" 0)
      $ U. A* k- i+ i( {4 W
3891.   (command "._+options" 7)
      
3892.   (setvar "CMDECHO" cmdecho-save)
      ) f- L) C0 |4 Y& q4 G- l% S
3893.   (princ)
      
3894. )
      
3895. 
      
3896. (defun c:gifin ()
      * c) O; \: z2 ^  k. P
3897.   (alert "\nThe GIFIN command is no longer supported.\nUse the IMAGE command to attach raster image files.\n")
      
3898.   (princ)
      
3899. )
      * e4 w$ E, ^8 ?% C3 P  Y, J
3900. 
      
3901. (defun c:pcxin ()
      
3902.   (alert "\nThe PCXIN command is no longer supported.\nUse the IMAGE command to attach raster image files.\n")
      
3903.   (princ)
      
3904. )
      
3905. 
      & M: a8 n! |7 b% U
3906. (defun c:tiffin ()
      
3907.   (alert "\nThe TIFFIN command is no longer supported.\nUse the IMAGE command to attach raster image files.\n")
      
3908.   (princ)
      
3909. )
      " e% H# A9 ]2 E7 h# X1 a. f& r
3910. 
      
3911. (defun c:ddemodes()
      
3912.   (alert "The Object Properties toolbar incorporates DDEMODES functionality.  \nDDEMODES has been discontinued.  \n\nFor more information, select \"Object Properties toolbar\" from the AutoCAD Help Index tab.")
      + Y( B& j+ H1 I) n
3913.   (princ)
      $ n/ S: h/ H' t; q5 p. T
3914. )
      
3915. 
      
3916. (defun c:ddrmodes(/ cmdecho-save)
      
3917.   (setq cmdecho-save (getvar "CMDECHO"))
      
3918.   (setvar "CMDECHO" 0)
      # l' f- ^. n0 Q6 F
3919.   (command "._+dsettings" 0)
      
3920.   (setvar "CMDECHO" cmdecho-save)
      % K2 F; r8 W2 `9 ^! S1 d; M
3921.   (princ)
      
3922. )
      & {, c$ w3 L, w* u& D6 i
3923. 
      2 S9 p9 P5 m! P- l6 L
3924. ;; HPCONFIG
      5 h& t' @# O8 ]- M. v
3925. (defun c:hpconfig (/ hlppath)
      
3926.   (if (not (setq hlppath (findfile "acad.hlp")))
      / @1 R3 y4 t( `# V4 x0 o  s
3927.     (setq hlppath ""))
      8 H& R# z6 B' l1 f6 f* ?# G7 w1 c
3928.   (help hlppath "hpconfig")
      5 i" @9 {9 U/ E: }! R
3929.   (princ)
      7 x0 ^+ [4 [9 h
3930. )
      
3931. 
      . y( g, Y& Q/ C! B/ K# _) P  u
3932. ;; OCECONFIG
      
3933. (defun c:oceconfig (/ hlppath)
      
3934.   (if (not (setq hlppath (findfile "acad.hlp")))
      
3935.     (setq hlppath ""))
      
3936.   (help hlppath "oceconfig")
      
3937.   (princ)
      
3938. )
      
3939. 
      0 k2 p$ q5 }1 n0 }& R6 r
3940. ;; CCONFIG
      & t, z" d5 v% ]# t9 Q" L
3941. (defun c:cconfig (/ hlppath)
      
3942.   (if (not (setq hlppath (findfile "acad.hlp")))
      
3943.     (setq hlppath ""))
      
3944.   (help hlppath "cconfig")
      
3945.   (princ)
      * K1 X8 N( ]0 V! F( t: g: e1 K/ V) s
3946. )
      - Y. M$ L  P1 v, L) i  }2 F% u) @
3947. 
      
3948. ;;; ===== AutoLoad =====
      
3949. 
        z5 l* \* |. m& i" Y) E  w
3950. ;;; Check list of loaded <apptype> applications ("ads" or "arx")
      " t) _" V: M  v) W3 T
3951. ;;; for the name of a certain appplication <appname>.
      8 _" ~9 k0 x. o7 p8 E% ~& |/ K8 U
3952. ;;; Returns T if <appname> is loaded.
      ' y  b/ T2 E: ^/ u
3953. 
        R( W/ D# N0 Y2 L0 [$ F  j
3954. (defun ai_AppLoaded (appname apptype)
      9 e: G8 e9 X5 D' L
3955.    (apply 'or
      . ?6 A1 M7 _. i' D
3956.       (mapcar
      
3957.         '(lambda (j)
      2 J4 J0 w' _1 T
3958.             (wcmatch
      1 ^, ?/ t, _, F3 r
3959.                (strcase j T)
      ' u" d3 y# y+ e' Q1 |$ [  S* f& x
3960.                (strcase (strcat "*" appname "*") T)
      9 u6 T& l% e5 G) a9 G% _6 {6 X
3961.             )   
      
3962.          )
      
3963.          (eval (list (read apptype)))
      $ s6 B; ?; B" @9 t0 |
3964.       )
      " _" A( n0 P" w, t$ C
3965.    )
      - O, Y- m/ J! ?, D) h5 I8 L
3966. )
      9 M" `1 Q) }4 z
3967. 
      + [( b- R1 v% Z# N3 [2 L
3968. ;;  
      5 d" a- K8 y3 v! o
3969. ;;  Native Rx commands cannot be called with the "C:" syntax.  They must
      . V- P  \9 h0 o9 l9 \7 A5 d. y( K1 I
3970. ;;  be called via (command).  Therefore they require their own autoload
      + `' P) ~3 u; i8 N4 G
3971. ;;  command.
      - ^9 V; g3 E9 F( Z' q5 L, T
3972. 
      
3973. (defun autonativeload (app cmdliste / qapp)
      9 }+ `+ Y& B  n% l8 z' N1 ~
3974.   (setq qapp (strcat "\"" app "\""))
      ; c' B+ U5 f& c9 G( F
3975.   (setq initstring "\nInitializing...")
      
3976.   (mapcar
      4 Y' u# v  ~& b
3977.    '(lambda (cmd / nom_cmd native_cmd)
      6 u' h9 l6 ?* C1 ~* j
3978.       (progn
      3 J2 t: o6 M+ T, C$ ?2 R
3979.         (setq nom_cmd (strcat "C:" cmd))
      ; n5 P9 J! y5 a5 M9 r  S8 ]* X
3980.         (setq native_cmd (strcat "\"_" cmd "\""))
      
3981.         (if (not (eval (read nom_cmd)))
      3 l$ V$ S0 ]0 d7 r+ M
3982.             (eval
      ! |6 {3 x' O+ k2 O
3983.              (read (strcat
      
3984.                     "(defun " nom_cmd "()"
      
3985.                     "(setq m:err *error* *error* *merrmsg*)"
      3 \* r) I  O7 J5 \1 Y  y$ G1 Z
3986.                     "(if (ai_ffile " qapp ")"
      
3987.                     "(progn (princ initstring)"
      
3988.                     "(_autoarxload " qapp ") (command " native_cmd "))"
      4 n9 p) e1 F' _2 h9 q, v5 W2 D
3989.                     "(ai_nofile " qapp "))"
      
3990.                     "(setq *error* m:err m:err nil))"
      3 `9 T. M( G1 X  F; e, k- i
3991.                     ))))))
      
3992.    cmdliste)
        H3 f- d! S! j6 F2 P
3993.   nil
      
3994. )
      
3995. 
      
3996. (defun _autoqload (quoi app cmdliste / qapp symnam)
      
3997.   (setq qapp (strcat "\"" app "\""))
      
3998.   (setq initstring "\nInitializing...")
      
3999.   (mapcar
      
4000.    '(lambda (cmd / nom_cmd)
      $ j" q3 ?1 C; q3 a  g1 a0 ^) a
4001.       (progn
      
4002.         (setq nom_cmd (strcat "C:" cmd))
      
4003.         (if (not (eval (read nom_cmd)))
      4 ^5 H3 L8 ?, d
4004.             (eval
      * o2 `5 _5 }- g& b
4005.              (read (strcat
      9 ]1 ], k( F, o  z8 T
4006.                     "(defun " nom_cmd "( / rtn)"
      , a- i+ s/ q) s* U
4007.                     "(setq m:err *error* *error* *merrmsg*)"
      , `, B4 n! @7 A8 f5 D) }3 i) s
4008.                     "(if (ai_ffile " qapp ")"
      5 Y) b( f# h2 i$ W; b
4009.                     "(progn (princ initstring)"
      8 e7 r0 u) T, |# N! O) k
4010.                     "(_auto" quoi "load " qapp ") (setq rtn (" nom_cmd ")))"
      & I2 h2 Q0 \2 f- `, Q
4011.                     "(ai_nofile " qapp "))"
      ) D+ ?- ^6 b+ L0 ^/ f) J% }' \
4012.                     "(setq *error* m:err m:err nil)"
      
4013.                     "rtn)"
      
4014.                     ))))))
      5 `  s! @! G+ T
4015.    cmdliste)
      
4016.   nil
      / B; ]# k* }% W  r% o. s
4017. )
      
4018. 
      " E7 t. R; r+ S  L# A" ?
4019. (defun autoload (app cmdliste)
      ' e  T$ d* ~, C  |0 Z, r
4020.   (_autoqload "" app cmdliste)
      
4021. )
      4 e9 i6 W# j4 k% G
4022. 
      ! \0 e8 h& |3 M; |" q
4023. (defun autoarxload (app cmdliste)
      
4024.   (_autoqload "arx" app cmdliste)
      " q/ _; X, ?4 l5 K4 f) Z9 l6 M
4025. )
      
4026. 
      
4027. (defun autoarxacedload (app cmdliste / qapp symnam)
      & [/ ~' D, \: ^2 m
4028.   (setq qapp (strcat "\"" app "\""))
      ; m- c7 q, }: R( Z+ c# Q+ b* Q
4029.   (setq initstring "\nInitializing...")
      
4030.   (mapcar
      , u; |9 A2 l6 @
4031.    '(lambda (cmd / nom_cmd)
      # `, R5 ]- H" |: L* W
4032.       (progn
      4 a/ k4 T0 F; x$ o" v0 ~0 y+ r
4033.         (setq nom_cmd (strcat "C:" cmd))
      ; f' t/ G% u' h+ `  |2 a
4034.         (if (not (eval (read nom_cmd)))
      
4035.             (eval
      8 _& v0 v& l# N$ I& J7 `* Y( \+ s
4036.              (read (strcat
      
4037.                     "(defun " nom_cmd "( / oldcmdecho)"
      ! f8 K$ [' l6 R; z) G: N# I4 |
4038.                     "(setq m:err *error* *error* *merrmsg*)"
      
4039.                     "(if (ai_ffile " qapp ")"
      
4040.                     "(progn (princ initstring)"
      1 H; \  I5 o( o) U
4041.                     "(_autoarxload " qapp ")"
      $ y" o* H* S" X0 h4 o" t
4042.                     "(setq oldcmdecho (getvar \"CMDECHO\"))"
      % A8 f) H+ N3 D# H- z
4043.                     "(setvar \"CMDECHO\" 0)"
      
4044.                     "(command " "\"_" cmd "\"" ")"
      
4045.                     "(setvar \"CMDECHO\" oldcmdecho))"
      
4046.                     "(ai_nofile " qapp "))"
      
4047.                     "(setq *error* m:err m:err nil)"
      3 s6 E. D- T5 \7 Z7 a
4048.                     "(princ))"
      
4049.                     ))))))
      % y/ G7 O: e  [- W$ J, F
4050.    cmdliste)
      
4051.   nil
      
4052. )
      
4053. 
      " \% m- L+ g- t- V' c
4054. (defun _autoload (app)
      8 ]  [8 ]. C# H* Q
4055. ; (princ "Auto:(load ") (princ app) (princ ")") (terpri)
      
4056.   (load app)
      
4057. )
      ! u: t! f8 r- h: c2 r/ h1 N
4058. 
      
4059. (defun _autoarxload (app)
      
4060. ; (princ "Auto:(arxload ") (princ app) (princ ")") (terpri)
      
4061.   (arxload app)
      
4062. )
      9 q: T! b8 L, z' p
4063. 
      
4064. (defun ai_ffile (app)
      
4065.   (or (findfile (strcat app ".lsp"))
      
4066.       (findfile (strcat app ".exp"))
      6 b- N- D+ @* a' _( R) V
4067.       (findfile (strcat app ".exe"))
      
4068.       (findfile (strcat app ".arx"))
      
4069.       (findfile app)
      
4070.   )
      
4071. )
      
4072. 
      
4073. (defun ai_nofile (filename)
      
4074.   (princ
      5 }) z; d, O+ |7 Z) h" E
4075.     (strcat "\nThe file "
      ! f, _5 M" A9 H8 p& R4 {4 t
4076.             filename
      8 ]9 O. w6 |8 \6 J7 @0 g
4077.             "(.lsp/.exe/.arx) was not found in your search path folders."
      
4078.     )
      
4079.   )
      1 ^# ]; B2 ^. y
4080.   (princ "\nCheck the installation of the support files and try again.")
      . ?, s' N; v. z+ i+ I
4081.   (princ)
      / y6 K. P7 C$ p
4082. )
      
4083. 
      8 c3 T0 k! @) p- B( z
4084. 
      
4085. ;;;===== AutoLoad LISP Applications =====
      
4086. ;  Set help for those apps with a command line interface
      * u$ G6 j: A9 _
4087. 
      ( N* D- ~! O7 t: t- m* I: g
4088. (autoload "edge"  '("edge"))
      
4089. (setfunhelp "C:edge" "" "edge")
      3 {4 D6 q& s! {
4090. 
      - g7 e$ ?2 R# T* L
4091. (autoload "filter" '("filter " "filter"))
      : ?4 s! t; t+ B
4092. 
      % L8 P% q5 S9 f: V8 s# i
4093. (autoload "3d" '("3d" "3d" "ai_box" "ai_pyramid" "ai_wedge" "ai_dome"
      ( b0 d  b9 v$ V# Y) [$ r
4094.                  "ai_mesh" "ai_sphere" "ai_cone" "ai_torus" "ai_dish")
      
4095. )
      8 g+ C: U; q( y8 `) _, @7 @
4096. (setfunhelp "C:3d" "" "3d")
      
4097. (setfunhelp "C:ai_box" "" "3d_box")
      
4098. (setfunhelp "C:ai_pyramid" "" "3d_pyramid")
      
4099. (setfunhelp "C:ai__wedge" "" "3d_wedge")
      - N% y/ e' z. j! q2 @/ e
4100. (setfunhelp "C:ai_dome" "" "3d_dome")
      ! q. V1 q2 H3 T; s$ n
4101. (setfunhelp "C:ai_mesh" "" "3d_mesh")
      
4102. (setfunhelp "C:ai_sphere" "" "3d_sphere")
      
4103. (setfunhelp "C:ai_cone" "" "3d_cone")
      
4104. (setfunhelp "C:ai_torus" "" "3d_torus")
      
4105. (setfunhelp "C:ai_dish" "" "3d_dish")
      % n6 M7 L* Y% ^& g3 D- C' D
4106. 
      
4107. (autoload "3darray" '("3darray"))
      0 O9 A1 c2 I( a2 M3 O9 X
4108. (setfunhelp "C:3darray" "" "3darray")
      5 ~& Q* x. q& k) r
4109. 
      
4110. (autoload "ddvpoint" '("ddvpoint"))
      
4111. 
        s$ v! b  b! V! |* o7 q* v6 l/ g
4112. (autoload "mvsetup" '("mvsetup"))
      
4113. (setfunhelp "C:mvsetup" "" "mvsetup")
      
4114. 
      
4115. (autoload "ddptype" '("ddptype"))
      
4116. 
      / m; ^, w5 ~1 o9 X; O6 _* m
4117. (autoload "attredef" '("attredef"))
      $ C1 i5 N, ]. I& n- f
4118. (setfunhelp "C:attredef" "" "attredef")
      
4119. 
      
4120. (autoload "xplode" '("xp" "xplode"))
      1 f! Q2 O' a. T% x: Q/ a& t
4121. (setfunhelp "C:xplode" "" "xplode")
      
4122. 
      
4123. (autoload "tutorial" '("tutdemo" "tutclear"
      
4124.                                        "tutdemo"
      
4125.                                        "tutclear"))
      , Y3 P0 k* Q& f: |1 n4 h; e5 Z
4126. 
      
4127. ;;;===== AutoArxLoad Arx Applications =====
      
4128. 
      5 @4 }. M  k, B8 `
4129. (autoarxload "geomcal" '("cal" "cal"))
      
4130. 
      $ s: D" Z6 ]0 ]& q8 M
4131. (autoarxload "geom3d" '("mirror3d" "rotate3d" "align"
      : s" Q% g( ~" B( D% w
4132.                       "mirror3d" "rotate3d"
      3 b* l. I# ]6 v" X, d* M
4133.                                  "align"))
      
4134. 
      0 Q. B0 z: [1 D4 W* z! o
4135. 
      
4136. ;;; ===== Double byte character handling functions =====
      0 d4 G3 v( ]- ?( d1 X
4137. 
      ) b  p6 P5 y: ?3 W7 Q0 U
4138. (defun is_lead_byte(code)
      
4139.     (setq asia_cd (getvar "dwgcodepage"))
      
4140.     (cond
      
4141.         ( (or (= asia_cd "dos932")
      ! J; ~$ r, f# j% ^; I, C1 y
4142.               (= asia_cd "ANSI_932")
      
4143.           )
      
4144.           (or (and (<= 129 code) (<= code 159))
      1 i1 P+ l6 d( x7 F! g
4145.               (and (<= 224 code) (<= code 252))
      ; W6 \& I  t$ F8 z! b
4146.           )
      : K$ G) x" _& A- i
4147.         )
      * L- L' ~# J( b% Q  A$ G1 z
4148.         ( (or (= asia_cd "big5")
      
4149.               (= asia_cd "ANSI_950")
      
4150.           )
      
4151.           (and (<= 129 code) (<= code 254))
      
4152.         )
      $ v& i6 A5 B  m- b9 I' {$ R8 j
4153.         ( (or (= asia_cd "gb2312")
      
4154.               (= asia_cd "ANSI_936")
      # h4 r, a1 u" W' \; m- R
4155.           )
      * h# N2 [  w+ G+ w( a
4156.           (and (<= 161 code) (<= code 254))
      
4157.         )
      
4158.         ( (or (= asia_cd "johab")
      
4159.               (= asia_cd "ANSI_1361")
      ' T" A# F  K/ {5 H' R& N
4160.           )
      1 q' {$ c1 D* {# c. y: Y% p( U- s; Z
4161.           (and (<= 132 code) (<= code 211))
      7 M  m+ j, D8 a0 ?( ]5 T6 g" n
4162.         )
      - M) E6 E6 }! m# h% \
4163.         ( (or (= asia_cd "ksc5601")
      
4164.               (= asia_cd "ANSI_949")
      5 c$ ~; e' F1 z8 {2 k$ ?
4165.           )
      
4166.           (and (<= 129 code) (<= code 254))
      . Z+ z3 f; l8 J0 V
4167.         )
      
4168.     )
      
4169. )
      ) h4 X8 H9 ?* m. S0 w# |
4170. 
      
4171. ;;; ====================================================
      
4172. 
      / q7 E$ v# _5 I0 Z& q
4173. 
      
4174. ;;;
      * b" w( f1 J4 P) _/ t
4175. ;;;  FITSTR2LEN
      * Z# T5 @; ^; B- o0 p8 R4 p9 f& H$ D
4176. ;;;
      
4177. ;;;  Truncates the given string to the given length.
      
4178. ;;;  This function should be used to fit symbol table names, that
      
4179. ;;;  may turn into \U+ sequences into a given size to be displayed
      
4180. ;;;  inside a dialog box.
      ; M1 j& B1 i9 ]/ m" a) e2 u, ]/ u
4181. ;;;
      
4182. ;;;  Ex: the following string:
      
4183. ;;;
      
4184. ;;;      "This is a long string that will not fit into a 32 character static text box."
      : t5 e" X% i! f. t% I9 V
4185. ;;;
      8 b5 r& K* f1 K  V& c
4186. ;;;      would display as a 32 character long string as follows:
      
4187. ;;;
      
4188. ;;;      "This is a long...tatic text box."
      - }# J. v; O$ a6 `1 k2 M
4189. ;;;
      7 N) W* b8 l. i7 H* _
4190. 
      + Z* d$ w2 j6 v- |8 f, [
4191. (defun fitstr2len (str1 maxlen)
      + L' [) ]3 L& [" O, t& i3 z
4192. 
      4 E. x" ^0 b3 j9 ^: c8 @
4193.     ;;; initialize internals
      0 S/ J) X- s+ N, j6 B* Q
4194.     (setq tmpstr str1)
      
4195.     (setq len (strlen tmpstr))
      , ]0 t7 K; A8 d) K5 i9 g
4196. 
      
4197.     (if (> len maxlen)
      . ~' h8 \9 S. V# z- u! }# k
4198.          (progn
      & y1 c; _& l9 q) F0 w
4199.             (setq maxlen2 (/ maxlen 2))
      9 Y* _9 E; Z4 F
4200.             (if (> maxlen (* maxlen2 2))
      
4201.                  (setq maxlen2 (- maxlen2 1))
      & m0 n3 ~4 E/ x3 }( _6 D
4202.             )
      5 @2 p/ m/ v+ k& Z, K' Z: \8 O
4203.             (if (is_lead_byte (substr tmpstr (- maxlen2 2) 1))
      
4204.                  (setq tmpstr1 (substr tmpstr 1 (- maxlen2 3)))
      
4205.                  (setq tmpstr1 (substr tmpstr 1 (- maxlen2 2)))
      ( `. c2 I& g* x8 i! Z: z
4206.             )
      
4207.             (if (is_lead_byte (substr tmpstr (- len (- maxlen2 1)) 1))
      / D( I* X- G8 T  O8 H, t
4208.                  (setq tmpstr2 (substr tmpstr (- len (- maxlen2 3))))
      ! \; A7 D$ v1 `  ^
4209.                  (setq tmpstr2 (substr tmpstr (- len (- maxlen2 2))))
      4 K; X; }: ~. i4 o2 P
4210.             )
      $ v$ u9 i% G; S7 H- \
4211.             (setq str2 (strcat tmpstr1 "..." tmpstr2))
      
4212.          ) ;;; progn
      " p3 I2 B$ K5 U8 s4 D5 [' B  a
4213.          (setq str2 (strcat tmpstr))
      9 l. F3 j# O. H' \+ d& q
4214.     ) ;;; if
      
4215. ) ;;; defun
        v; V/ p8 s6 I  r& b$ c5 n
4216. 
      
4217. 
      * m5 P6 Z2 F) H% Z" h& U
4218. ;;;
      
4219. ;;;  If the first object in a selection set has an attached URL
      
4220. ;;;  Then launch browser and point to the URL.
      / E5 {: i! T, Z" h
4221. ;;;  Called by the Grips Cursor Menu
      
4222. ;;;
      
4223. 
      
4224. (defun C:gotourl ( / ssurl url i)
      
4225.    (setq m:err *error* *error* *merrmsg* i 0)
      
4226. 
      ; r# _# V5 M1 e: s
4227. ; if some objects are not already pickfirst selected,
      
4228. ; then allow objects to be selected
      5 J+ O# ~$ n/ z+ f4 o+ Q% ^; w1 J' n  w. S
4229. 
      ) V% `1 I/ ?! i& ]- H( y
4230.   (if (not (setq ssurl (ssget "_I")))
      
4231.       (setq ssurl (ssget))
      
4232.   )
      # O( k) n# h& i, e, B
4233. 
      
4234. ; if geturl LISP command not found then load arx application
      
4235. 
      - B/ O' g) Q% D/ ]3 N
4236.   (if (/= (type geturl) 'EXRXSUBR)
      . B! a1 z* O3 i3 q  Q
4237.     (arxload "dwfout")
      ! H7 ^' {  f+ H. ~0 W
4238.   )
      
4239.   
      
4240. ;  Search list for first object with an URL
      
4241.   (while (and (= url nil) (< i (sslength ssurl)))
        I& g$ B5 t. ^- I+ y& a
4242.     (setq url (geturl (ssname ssurl i))
      
4243.           i (1+ i))
      $ h4 T3 R& I' \" f9 ~* p
4244.   )
      
4245. 
      + M: ?# n, u  w- N$ g  O: C; S3 a, S
4246. ; If an URL has be found, open browser and point to URL
      # U0 W3 J. C) E$ g
4247.   (if (= url nil)
      
4248.     (alert "No Universal Resource Locator associated with the object.")
      " n5 k5 u% r8 U6 F9 I* I* x
4249.     (command "_.browser" url)
      " y) u' z; S! Q
4250.   )
      ; i1 R5 T8 o8 u9 l7 K" N
4251. 
      
4252.   (setq *error* m:err m:err nil)
      
4253.   (princ)
      
4254. 
      
4255. )
      # \3 J9 G( S4 l7 {) B1 z/ R$ f
4256. 
      ( m% ?( J7 u  ]1 T# k8 _+ r
4257. ;; Used by the import dialog to silently load a 3ds file
      # I# U7 y4 D& L& F
4258. (defun import3ds (filename / filedia_old render)
      
4259.   ;; Load Render if not loaded
      
4260.   (setq render (findfile "acRender.arx"))
      ; b0 k4 u) C. I9 h# n
4261.   (if render
      0 p" l6 j1 M; l, [- v
4262.     (verify_arxapp_loaded render)
      , @, L; z( Y8 t& b, S/ e
4263.     (quit)
      
4264.   )
      8 x% `% g8 r6 o9 N! b& t
4265. 
      . g3 y% V. f0 [
4266.   ;; Save current filedia & cmdecho setting.
      
4267.   (setq filedia-save (getvar "FILEDIA"))
      % _6 r4 {, N+ \4 N: e
4268.   (setq cmdecho-save (getvar "CMDECHO"))
      
4269.   (setvar "FILEDIA" 0)
      ! }5 g1 L" l3 l# e
4270.   (setvar "CMDECHO" 0)
      * _& R+ V3 e, X
4271. 
      
4272.   ;; Call 3DSIN and pass in filename.
      ) ]7 H) X3 h) E
4273.   (c:3dsin 1 filename)
      
4274. 
      
4275.   ;; Reset filedia & cmdecho
      
4276.   (setvar "FILEDIA" filedia-save)
      
4277.   (setvar "CMDECHO" cmdecho-save)
      
4278.   (princ)
      
4279. )
      
4280. 
      
4281. 
      ; p: V% a1 E! M' s5 t$ f
4282. ;;;=== Menu Functions ======================================
      
4283. 
      
4284. (defun ai_rootmenus ()
      $ @0 D1 a+ ?( Z0 @, _- T3 t+ E) h
4285.   (setq T_MENU 0)
      ; [$ V5 j3 p% U- m6 [
4286.   (menucmd "S=S")
      . m  E. h1 \. b5 y- E
4287.   (menucmd "S=ACAD.S")
      
4288.   (princ)
      : u' w8 ^7 s. L; H8 l) v
4289. )
      " Y# S5 U9 N$ n" W1 Q
4290. 
      1 m4 P  B& f; Z0 y2 h; R2 F1 s
4291. (defun c:ai_fms ( / fmsa fmsb)
        ?" X/ c3 F) i$ X
4292.   (setq m:err *error* *error* *merr*)
      
4293.   (ai_undo_push)
      
4294.   (if (getvar "TILEMODE") (setvar "TILEMODE" 0))
      
4295.   (setq fmsa (vports) fmsb (nth 0 fmsa))
      ) H# n2 q/ x2 ?- y2 J- z  k. F
4296.   (if (member 1 fmsb)
      # N% H, U( r1 ?, |
4297.     (if (> (length fmsa) 1)
      
4298.       (command "_.mspace")
      % d7 v( Y" S( s
4299.       (progn
      
4300.         (ai_sysvar '("cmdecho" . 1))
      2 a+ O- R6 \  G: W1 m/ L
4301.         (command "_.mview")
      ' M4 i1 w* n8 N8 i+ L) x3 e
4302.         (while (eq 1 (logand 1 (getvar "CMDACTIVE")))
      ( ~5 i1 r1 ^3 c6 y" H9 A. ?0 l
4303.           (command pause)
      ) i, P' [( ~4 z7 S& v1 N; c
4304.         )
      5 r) a+ `3 p2 A# W4 \/ v3 \% `# i$ a
4305.         (ai_sysvar NIL)
      + I3 g) b+ h: G9 ]+ b. a: ]: T
4306.         (command "_.mspace")
      7 _- w# n8 c( |, C
4307.       )
      / l; C$ [; t) n
4308.     )
      
4309.   )
      
4310.   (ai_undo_pop)
      , B  \0 B/ {; _9 c4 r) Q
4311.   (setq *error* m:err m:err nil)
      7 k4 W) V  p  {! R0 k
4312.   (princ)
      
4313. )
      / a# o' L$ U/ e% b) l. u4 d# Y
4314. 
      
4315. (defun ai_onoff (var)
      
4316.   (setvar var (abs (1- (getvar var))))
      * w7 V- N5 W. ^- n; z/ V7 A
4317.   (princ)
      
4318. )
      
4319. 
      9 M' o* H% ?6 s# t2 v. J2 h
4320. ;;; go to paper space
      
4321. (defun c:ai_pspace ()
        _" v9 ?' Y$ a; }
4322.   (ai_undo_push)
      & @' X/ U4 W7 i1 v2 X' }5 y
4323.   (if (/= 0 (getvar "tilemode"))
      # W9 ^0 I/ c7 Q5 V' [  R, J
4324.     (command "_.tilemode" 0)
      8 p+ i. h9 K0 ?5 ~! B
4325.   )
      # U) n. s7 T4 w, v: E
4326.   (if (/= 1 (getvar "cvport"))
      " e8 |" c6 D" X' l% B
4327.     (command "_.pspace")
      
4328.   )
      
4329.   (ai_undo_pop)
      
4330.   (princ)
      
4331. )
      % u  N" [* g8 @* N( @! l5 F
4332. 
      , I4 r# _' B0 Z. p/ T. x
4333. ;;; go to tilemode 1
        }4 h9 {1 `( j- E7 b6 \9 B
4334. (defun c:ai_tilemode1 ()
      3 K% |" h6 ?7 c
4335.   (ai_undo_push)
      : Z" G/ V6 K6 Z4 S
4336.   (if (/= 1 (getvar "tilemode"))
      
4337.     (command "_.tilemode" 1)
      
4338.   )
      ! i, A% i! j$ G# C8 M* Z$ r  g
4339.   (ai_undo_pop)
      
4340.   (princ)
      
4341. )
      % F' w8 f" W0 l! c
4342. 
      
4343. ;;; Pop menu Draw/ Dim/ Align Text/ Centered
      
4344. ;;; Toolbar Dimensions/ Align Text/ Centered
      % ?! ?, W0 D5 Y; q: h7 s7 M  o
4345. 
      
4346. (defun ai_dim_cen (/ ai_sysvar ai_dim_ss)
      . s# N% k+ e4 b+ R
4347.   (setq ai_sysvar (getvar "cmdecho"))
      
4348.   (setvar "cmdecho" 0)
      . s3 {( c: r: L  N1 L+ n8 L6 L
4349.   (cond
      
4350.     ((setq ai_dim_ss (ssget  "_P" '((0 . "DIMENSION"))))
      
4351.       (command "_.dimoverride" "_dimjust" 0 "" ai_dim_ss ""
      0 ~3 _$ Q: f% m( V% ?7 |
4352.                "_.dimtedit" ai_dim_ss "_h")
      
4353.     )
      . f- c& }& T* j, z( I) b
4354.     (T nil)
      4 N3 m9 ]: E* L# Z$ y8 Y+ P& P% V9 Q  H" t
4355.   )
      
4356.   (setvar "cmdecho" ai_sysvar)
      
4357.   (princ)
      
4358. )
      
4359. 
      
4360. ;;; Shortcut menu for Dimension Text Above
      6 |* d6 j/ {: {
4361. 
      : O+ b: H" c7 y; T
4362. (defun c:ai_dim_textabove (/ ss)
      ; d. @1 s- M& Y  R
4363.   (ai_sysvar '("cmdecho" . 0))
      ' \9 p! w+ o, x; ^$ R+ s
4364.   (if (setq ss (ssget "_I"))
      
4365.     (command "_.dimoverride" "_dimtad" 3 "" ss "")
      
4366.     (if (setq ss (ssget))
      + p9 i: Y- {4 }* j) H' S; Q/ W. |( U
4367.       (command "_.dimoverride" "_dimtad" 3 "" ss "")
      
4368.     )
      # L6 J" j* a2 K" C7 G& a% j
4369.   )
      
4370.   (ai_sysvar NIL)
      
4371.   (princ)
      & P) t; x. M9 j6 h, Z1 j7 J, [
4372. )
      
4373. 
      
4374. ;;; Shortcut menu for Dimension Text Center
      
4375. 
      
4376. (defun c:ai_dim_textcenter (/ ss)
      8 O/ l6 P$ W, T% N$ g2 @
4377.   (ai_sysvar '("cmdecho" . 0))
      
4378.   (if (setq ss (ssget "_I"))
      0 {/ i" J  \6 v# K, |* U0 y
4379.     (command "_.dimoverride" "_dimtad" 0 "" ss "")
      
4380.     (if (setq ss (ssget))
      
4381.       (command "_.dimoverride" "_dimtad" 0 "" ss "")
      
4382.     )
      & u" K" g/ N+ B, r
4383.   )
      
4384.   (ai_sysvar NIL)
      8 X, }0 Q/ T9 s! ?+ d5 [# c, e
4385.   (princ)
      - y( [2 l/ _' j) Y6 M) E5 J, [
4386. )
      
4387. 
      7 H* N! A5 A$ S7 [9 n" M
4388. ;;; Shortcut menu for Dimension Text Home
      9 x3 b$ g/ g, U
4389. 
      ' A" c* {: K- f: z8 m+ s7 ~
4390. (defun c:ai_dim_texthome (/ ss)
      
4391.   (ai_sysvar '("cmdecho" . 0))
      6 o- J1 P$ I3 Z; g8 l+ n2 M' F" }; i
4392.   (if (setq ss (ssget "_I"))
      
4393.     (command "_.dimedit" "_h")
      $ R0 T0 f) @! ?& ^
4394.     (if (setq ss (ssget))
      
4395.       (command "_.dimedit" "_h" ss)
      
4396.     )
      
4397.   )
      & G. q1 ^& a1 M; Y( E' E
4398.   (ai_sysvar NIL)
      
4399.   (princ)
      % M3 `& C5 p% ~5 |9 e8 w5 y
4400. )
      
4401. 
      
4402. 
      6 v* S+ C+ f( `; a+ O
4403. ;;; Screen menu item for CIRCLE TaTaTan option.
      
4404. ;;;     first, get points on entities
      3 b) t3 S  }' G1 e
4405. (defun ai_circtanstart()
      
4406.    (setq m:err *error* *error* *merr*)
      / b) N- }: Y2 v8 ~/ @
4407.    (ai_sysvar
      
4408.       (list '("cmdecho" . 0)
      
4409.          ;; make sure _tan pick for CIRCLE gets same entity
      
4410.          (cons "aperture"  (getvar "pickbox"))
      
4411.           )
      : H9 A4 @. A) }9 K! R, L) ?2 o+ c
4412.    )
      1 R  f& \2 F7 M8 T+ o/ d
4413.    ;; prompts are the same as CIRCLE/TTR command option
      * ~' s# o* p) I; d. k* V) k
4414.    (setq pt1 (ai_entsnap "\nEnter Tangent spec: "  nil))
      ( M" z2 D& |  v0 ]
4415.    (setq pt2 (ai_entsnap "\nEnter second Tangent spec: " nil))
      9 B3 m* j8 f5 u8 V4 q
4416.    (setq pt3 (ai_entsnap "\nEnter third Tangent spec: "  nil))
      
4417. )
      ' N5 d% f2 N- X, {/ T, N  ^/ O/ Q/ w
4418. ;;; Command-line version
      $ g1 `0 i- K2 E$ U5 x7 |+ k3 ^
4419. (defun c:ai_circtan (/ pt1 pt2 pt3)
      
4420.    (ai_circtanstart)
      
4421. 
      + G1 R7 r2 K4 T4 }0 ?( G$ e& ^& L
4422.    (ai_sysvar '("osmode" . 256))
      
4423.    (command "_.circle" "_3p" "_tan" pt1 "_tan" pt2 "_tan" pt3)
      ' z3 l1 u1 q' W! T9 k7 ]7 N
4424.    
      3 T: \1 a: O+ n% }
4425.    (ai_sysvar nil)
      * {0 k$ G: Z* o: s  Z# T
4426.    (setq *error* m:err m:err nil)
      
4427.    (princ)
      
4428. )
      
4429. ;;; Use this if CMDNAMES == CIRCLE
      
4430. (defun ai_circtan (/ pt1 pt2 pt3)
      
4431.    (ai_circtanstart)
      0 D) u$ u& E) I+ g
4432. 
      
4433.    (ai_sysvar '("osmode" . 256))
      
4434.    (command "_3p" pt1  pt2  pt3)
      
4435.    
      
4436.    (ai_sysvar nil)
      , a6 `2 n) j( w6 r, G
4437.    (setq *error* m:err m:err nil)
      
4438.    (princ)
      : H! `) [7 R/ x2 `7 P
4439. )
      . \3 s- o' E  k- s! i, P0 O. j
4440. 
      8 h* N. R& N2 \  O( y0 k+ N
4441. 
      
4442. 
      
4443. ;;; Shortcut menu Deselect All item.
      ; [  Q" X6 V; {* O
4444. 
      
4445. (defun ai_deselect ()
      
4446.    (if (= (getvar "cmdecho") 0)                        ;start if
      : z$ C% K" N. v, h, h+ c- T
4447.        (command "_.select" "_r" "_all" "")
      
4448.        (progn                                        ;start progn for cmdecho 1
      
4449.            (setvar "cmdecho" 0)
      
4450.            (command "_.select" "_r" "_all" "")
      
4451.            (setvar "cmdecho" 1)
        ^  o  f) S6 N9 c+ p
4452.        )                                        ;end progn for cmdecho 1
      . Z" I4 J$ |) l8 a
4453.    )                                                ;end if
      
4454.    (terpri)
      
4455.    (prompt "Everything has been deselected")
      
4456.    (princ)
      / j7 Q. U7 ]. i9 `& Q" T
4457. )
      
4458. 
      
4459. ;;; Command version of ai_deselect to be called from the CUI
      % _4 }2 ^0 Z3 a  N; o' D
4460. ;;; so it gets properly recorded by the Action Recorder
      
4461. ;;;
      9 G- O& l1 z4 F  R1 Q
4462. (defun c:ai_deselect ()
      
4463.   (ai_deselect)
      ! {& c: L8 ^2 s# d! D
4464.   (princ)
      % X2 V5 {( q# y8 [9 G4 J
4465. )
      
4466. 
      
4467. ;;;
      
4468. ;;; Enable Draworder to be called from a menu
      
4469. ;;; Checks for Pickfirst selected objects
      
4470. ;;;
      
4471. 
      4 x/ i% }4 B( Z3 k4 P( o- O
4472. (defun ai_draworder (option / ss )
      
4473. 
      ! k2 \: o) f8 k6 Z2 l7 g
4474.   (setq m:err *error* *error* *merr*)
      
4475.   (ai_sysvar '("cmdecho" . 0))
      
4476. 
      
4477.   (if (setq ss (ssget "_I"))
      $ M8 [  m4 h$ I: ]  [
4478.     (command "_.draworder" option)
      & H3 X  v& L$ ]7 ~
4479.     (if (setq ss (ssget))
      + L$ ]  ~0 Z* Q  r
4480.       (command "_.draworder" ss "" option)
      
4481.     )
      
4482.   )
      
4483.   (ai_sysvar NIL)
      
4484.   (setq *error* m:err m:err nil)
      
4485. 
      - |  K) n3 c* U1 U& t8 C
4486.   (princ)
      % L0 k' r% S) h  ]+ i0 W; H
4487. )
      / t1 H" ]4 A/ z5 y$ R
4488. 
      : @; z+ d2 ^4 w1 [1 c& t
4489. ;;; Command version of ai_draworder to be called from the CUI
      / Z6 ~: E9 E4 {) W
4490. ;;; so it gets properly recorded by the Action Recorder
      1 a) S- L: ?- @3 C
4491. ;;;
      
4492. (defun c:ai_draworder ()
      , C7 {* d/ U& u6 W
4493.   (initget "Above Under Front Back")
      ( M% a# K2 x6 X' h, E' d. c5 c; r0 l
4494.   (ai_draworder (strcat "_" (getkword)))
      9 Y, w2 ~9 v  N. Q7 x0 k' d
4495.   (princ)
      
4496. )
      6 [: e0 g0 H% H" f+ x9 h" P
4497. 
      
4498. (defun c:vlisp ()
      
4499.   (if (/= nil c:vlide) (c:vlide))
      
4500. )
      % u$ k, m1 r2 v( p5 L$ ?- t$ @
4501. 
      ! ?( B$ C/ c/ d; x  O+ ~- `- L
4502. (princ "loaded.")
      7 K& I3 I3 \% i) n' \. z) K+ k
4503. 
      
4504. ;; Silent load.
      2 q* t3 v' N$ o/ }
4505. (princ)
      
4506. 
      5 Z' ?$ s( A/ u+ h  `6 P& _
4507. ;;;----------------------------------------------------------------------------
      - p: ^6 M7 s/ D% B0 r
4508. ;;;
      9 T6 f) \, H' P5 i
4509. ;;;   DDCHPROP.LSP   Version 0.5
      
4510. ;;;
      
4511. ;;;   Copyright (C) 1991-1993 by Autodesk, Inc.
      
4512. ;;;
      
4513. ;;;   Permission to use, copy, modify, and distribute this software
      
4514. ;;;   for any purpose and without fee is hereby granted, provided
      
4515. ;;;   that the above copyright notice appears in all copies and that
      5 j! ]& o- C9 S7 d# M) M. z5 Z
4516. ;;;   both that copyright notice and this permission notice appear in
      
4517. ;;;   all supporting documentation.
      * V. s" e: E' ~! q' l4 P) }
4518. ;;;
      
4519. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
      
4520. ;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
      
4521. ;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
      
4522. ;;;
      
4523. ;;;   2 February 1992
      
4524. ;;;   
      7 N0 B/ V& a4 w6 s9 E# t, `* ~+ X
4525. ;;;----------------------------------------------------------------------------
      
4526. ;;;   DESCRIPTION
      , k. B" {( ?4 ~, N
4527. ;;;----------------------------------------------------------------------------
      
4528. ;;;   C:DDCHPROP is a dialogue interface for the CHPROP command.
      
4529. ;;;
      
4530. ;;;   The command looks similar to DDEMODES.  The main dialogue has an image
      
4531. ;;;   tile, 3 buttons (layer, color, linetype), and an editbox (thickness).   
      & O0 i' ?* U4 R  b* |, w  b
4532. ;;;   The 3 buttons each launch a sub-dialogue containing a list and edit box.  
      8 e9 N6 L, ?. p( X
4533. ;;;   The dialogues are all defined in the DDCHPROP.DCL file.
      : y, N& W3 x5 i+ E
4534. ;;;
      " q- e" u* G% K1 m0 M" V+ @9 B  m# z
4535. ;;;
      ! r8 N$ H5 i# S' J2 b6 @1 [6 ?
4536. ;;;----------------------------------------------------------------------------
      
4537. ;;;----------------------------------------------------------------------------
      
4538. ;;;   Prefixes in command and keyword strings:
      0 ]0 T, c5 B! @6 I: Y
4539. ;;;      "."  specifies the built-in AutoCAD command in case it has been        
      
4540. ;;;           redefined.
      
4541. ;;;      "_"  denotes an AutoCAD command or keyword in the native language
      
4542. ;;;           version, English.
      ; S8 t: }# l' {( J7 J* f( E& A
4543. ;;;----------------------------------------------------------------------------
      ) G3 c/ K0 R7 L. x3 d! J* F
4544. ;;;
      
4545. ;;;
      
4546. ;;; ===========================================================================
      ( n0 g, \: {. q% L9 w, t( Q) O& a7 D
4547. ;;; ===================== load-time error checking ============================
      ; V9 N: O: [; t2 Q# {; z
4548. ;;;
      + o+ m0 p8 [: F. w$ _2 G* U
4549. 
      
4550.   (defun ai_abort (app msg)
        W7 [& j: k8 |0 t& a) ^. m3 ^7 P2 c
4551.      (defun *error* (s)
      
4552.         (if old_error (setq *error* old_error))
      ! s+ p1 @! U7 A) G
4553.         (princ)
      
4554.      )
      % G1 T5 L! Y+ ~/ [" I
4555.      (if msg
      
4556.        (alert (strcat " Application error: "
      1 G# m: n+ G1 P5 ~  {( g
4557.                       app
      
4558.                       " \n\n  "
      1 }! ]) Y3 P" E* H9 t
4559.                       msg
      5 x* q% O: ]( ^( K" u0 q6 L( H0 B: J
4560.                       "  \n"
      
4561.               )
      
4562.        )
      ! ~' k& r" X* j$ u2 L8 f) N
4563.      )
      7 a8 |! ?5 }0 b! g& p3 s" F2 t
4564.      (exit)
      ' P8 J: B3 [& x0 ?
4565.   )
      9 {/ k& o& T" U# x0 C* Z9 a/ x
4566. 
      9 b" x1 b# Y( i4 Y, n3 T
4567. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
      4 K$ \6 v7 y- \* g/ {
4568. ;;; and then try to load it.
      
4569. ;;;
      
4570. ;;; If it can't be found or it can't be loaded, then abort the
      / K: e0 L% ^9 h8 L8 P1 b
4571. ;;; loading of this file immediately, preserving the (autoload)
      
4572. ;;; stub function.
      1 ?' y$ ]% X' G, k) r- j
4573. 
      
4574.   (cond
      
4575.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
      * R! [3 l% h- f2 \
4576. 
      
4577.      (  (not (findfile "ai_utils.lsp"))                     ; find it
      
4578.         (ai_abort "DDCHPROP"
      
4579.                   (strcat "Can't locate file AI_UTILS.LSP."
      1 u# j5 F" k! S! b( X+ m- j
4580.                           "\n Check support directory.")))
      
4581. 
      ; w& j5 `( k: K. H  D( H9 P
4582.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
      
4583.         (ai_abort "DDCHPROP" "Can't load file AI_UTILS.LSP"))
      6 e# t5 e* J/ I; S
4584.   )
      
4585. 
      
4586.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
      ( c. b) q. m  y+ G7 F, ~) x
4587.       (ai_abort "DDCHPROP" nil)        ; a Nil <msg> supresses
      - U3 `6 p) i' v9 O% Q) h: [
4588.   )                                    ; ai_abort's alert box dialog.
      1 l! n" x& ?1 X- ]' v) z
4589. 
      ( ~4 I; W7 F5 N4 u
4590. ;;; ==================== end load-time operations ===========================
      
4591. 
      9 v6 `8 R1 j0 \7 P( l3 k* q
4592. ;;; Initialize program subroutines and variables.
      $ \! e1 Y& t( E( M' C! ]. E( L
4593. 
      
4594. (defun ddchprop_init ()
      
4595. 
      ( @& R9 m, C0 s5 ^$ M+ W6 `  V/ r
4596.   ;;
        C5 [2 \. t! u. Y6 n3 T. T
4597.   ;; Define buttons and set values in CHPROP dialogue box
      7 L+ M8 ~1 ]: R7 S" ?$ _. Q  x
4598.   ;;
      + e9 H. U+ p# g+ k/ {7 I
4599.   (defun call_chp ()
      
4600.     (if (not (new_dialog "ch_prop" dcl_id)) (exit))
      # @2 z7 u  @2 t% E0 q. W
4601.     (set_tile "error" "")
      
4602.     ;; Set initial dialogue tile values
      + u. v( X; \% Q, e: L
4603.     (set_col_tile)
      2 y% o: F% H4 L+ |
4604.     (if (= lay-idx nil)
      9 y" a* W; n( k9 \3 U- J8 E! ]1 K7 S
4605.       (set_tile "t_layer" "Varies")
      
4606.       (set_tile "t_layer" (nth lay-idx laynmlst))
      
4607.     )
      $ b) [" t$ M( L- ^
4608.     (cond
      
4609.       ((= lt-idx nil)
      ' {# n7 V" c* D
4610.         (set_tile "t_ltype" "Varies")
      
4611.       )
      & O! R3 C4 O  Z
4612.       ((= lt-idx 0) ; set tile "By layer & layer linetype"
      
4613.         (set_tile "t_ltype" (bylayer_lt))
      
4614.       )
      
4615.       (T
      / J' x* _9 v" \  j+ d8 m. @
4616.         (set_tile "t_ltype" (nth lt-idx ltnmlst))
      , E$ Z3 D& [  J" v
4617.       )
      
4618.     )
      " _$ H: Z' P/ b7 `9 p3 f* G
4619.     (if (or (= ethickness nil) (= ethickness "Varies"))
      ' S8 L: {  k% C# N
4620.       (set_tile "eb_thickness" "Varies")
      
4621.       (set_tile "eb_thickness" (rtos ethickness))
      % x( A' g) M: d* q6 q1 q
4622.     )
      
4623.     ;; Define action for tiles
      ( D* d8 p, i! ]% z  t8 J) k, Z) |
4624.     (action_tile "b_color" "(setq ecolor (getcolor))")
      % p, O3 t4 B: B2 [, u/ L
4625.     (action_tile "show_image" "(setq ecolor (getcolor))")
      
4626.     (action_tile "b_name" "(setq elayer (getlayer))")
      ' P/ C+ o% b7 C" D2 ]
4627.     (action_tile "b_line" "(setq eltype (getltype))")
      
4628.     (action_tile "eb_thickness"  "(getthickness $value)")
      
4629.     (action_tile "help" "(acad_helpdlg \"acad.hlp\"  \"ddchprop\")")
      
4630.     (action_tile "accept" "(test-ok)")
      # Z( t' C8 R- V2 {: J! X, M
4631.     (if (= (start_dialog) 1)
      
4632.       (progn
      9 a% D+ b, t) H  t$ |
4633.         (command "_.chprop" ss "")
      4 ]" r- s8 m- A0 R: R
4634.         (if ecolor
      : L( L: @) t2 \5 d
4635.           (progn
      ) w& s2 r, q. O. `
4636.             (if (= 0 ecolor )   (setq ecolor "BYBLOCK"))
      
4637.             (if (= 256 ecolor ) (setq ecolor "BYLAYER"))
      ; F  C8 N3 B; o
4638.             (command "_c" ecolor)
      
4639.           )
      4 O. S2 G+ x1 b3 u
4640.         )
      
4641.         (if (and (/= eltype "Varies") lt-idx)
      & ?  b/ z% j" s9 P* `" u
4642.           (command "_lt" eltype)
      9 i( Z/ D- @5 y6 q% @$ {
4643.         )
      
4644.         (if (and (/= elayer "Varies") lay-idx)
      
4645.           (command "_la" elayer)
      . {' r9 n6 F. b+ W% O: f: N
4646.         )
      1 F  k2 M; R3 K+ _
4647.         (if (and (/= ethickness "Varies") ethickness)
      5 l' U! o. h0 Q  |0 N: R  l4 O
4648.           (command "_t" ethickness)
      $ ?9 h# B# S2 |# w2 R! T
4649.         )
      " T. }4 {+ a% ?$ O$ ?- G0 t
4650.         (command "")
      6 E; i" h# X, F& k) \- T" x6 I! L
4651.       )
      
4652.       (princ "\nProperties unchanged")
      ' Z+ G) [& l2 J0 u
4653.     )
      
4654.     (princ)
      : v7 n$ _; ~+ u
4655.   )
      
4656.   ;;
      . u$ b" M. G6 D% X0 E. r
4657.   ;; Function to set the Color text tile and swab to the current color value.
      # J& k, u. O7 f! j0 I  ~
4658.   ;;
      
4659.   (defun set_col_tile()
      
4660.     (cond
      5 ]8 ?; \9 a: ^6 p. L' E
4661.       ((= ecolor nil)
      
4662.         (set_tile "t_color" "Varies")
      
4663.         (col_tile "show_image" 0 nil)
      4 M: ?! T; ?& k1 O6 ~4 j$ R# A* b
4664.       )
      
4665.       ((= ecolor 0)
      
4666.         (set_tile "t_color" "BYBLOCK")
      
4667.         (col_tile "show_image" 0 nil)
      
4668.       )
      
4669.       ((= ecolor 1)
      
4670.         (set_tile "t_color" "1 red")
      
4671.         (col_tile "show_image" 1 nil)
      
4672.       )
      
4673.       ((= ecolor 2)
      ; C* I0 |" I1 k9 A& }* \
4674.         (set_tile "t_color" "2 yellow")
      
4675.         (col_tile "show_image" 2 nil)
      7 C7 K8 t" Z3 I
4676.       )
      
4677.       ((= ecolor 3)
      
4678.         (set_tile "t_color" "3 green")
      6 U. e$ o1 I" _7 A
4679.         (col_tile "show_image" 3 nil)
      ( k. A# c3 g% j  {% a9 f" R
4680.       )
      
4681.       ((= ecolor 4)
      
4682.         (set_tile "t_color" "4 cyan")
      ! V( R, c: K5 q% C& C# D3 z
4683.         (col_tile "show_image" 4 nil)
      0 v3 ?3 |$ ?* A$ n1 ]; U
4684.       )
      
4685.       ((= ecolor 5)
      1 q. @& l' _# B) W1 G8 C. G8 {. D
4686.         (set_tile "t_color" "5 blue")
      0 g. O9 f' w7 _5 N
4687.         (col_tile "show_image" 5 nil)
      * M# Y7 E: S* f) |0 f
4688.       )
      4 n0 P  G8 J& ^
4689.       ((= ecolor 6)
      
4690.         (set_tile "t_color" "6 magenta")
      0 o5 Y: Q+ g+ t. d5 O. ]
4691.         (col_tile "show_image" 6 nil)
      . i: w5 E# X0 q, h! |  l8 j6 [: i# }
4692.       )
      
4693.       ((= ecolor 7)
      . v+ f1 x3 @  [5 p$ H
4694.         (set_tile "t_color" "7 white")
      3 _; `9 n. h, k4 R0 f
4695.         (col_tile "show_image" 7 nil)
      2 u! y- p" r, g
4696.       )
      
4697.       ;; If the color is "BYLAYER", then set the tile to
      7 |8 ^/ A5 e$ r( @. O
4698.       ;; show it's set By layer, but also indicate the
      ) p* m2 Q' j5 S
4699.       ;; color of the layer - i.e. By layer (red)
      ( S+ D' I' c( H6 ?
4700.       ((= ecolor 256)
      3 W+ I2 I" r7 f- }3 f/ i' G
4701.         (set_tile "t_color" (bylayer_col))
      6 W& i9 g0 ]: k( R" M/ x" N
4702.         (col_tile "show_image" cn nil)
      
4703.       )
      0 n0 M6 r7 M) x! `2 k
4704.       (T
      . j; O6 _- j) r8 J% y( j' n
4705.         (set_tile "t_color" (itoa ecolor))
      
4706.         (col_tile "show_image" ecolor nil)
      & v" B% K( ^) o$ l+ L
4707.       )
      % v" ^& f- \8 K; \3 H1 }
4708.     )
      
4709.   )
      ) X' U$ `) |/ Q: |9 |
4710.   ;;
        D" B* C8 s# r/ l' H) f
4711.   ;;  Function to put up the standard color dialogue.
      
4712.   ;;
      8 q% f; b6 Y  X. x1 X* ?+ G
4713.   (defun getcolor(/ col_def lay_clr temp_color)
      
4714.     ;; col_def is the default color used when rq_color is called.  If ecolor
      
4715.     ;; is nil (varies) then set it to 1, else use the value of ecolor.
      
4716.     (if ecolor
      
4717.       (setq col_def ecolor)
      
4718.       (setq col_def 1)
      
4719.     )
      ! i. j/ M! n2 a- |
4720.       
      
4721.     ;; If we're working with a single layer, get its color
      
4722.     ;; for use in the color swatch if the user selects color BYLAYER.
      % Q$ f' _; N' v: ]: O1 _7 @
4723.     (if (/= elayer "Varies")
      
4724.       (setq lay_clr (cdr (assoc 62 (tblsearch "layer" elayer))))
        {! f5 T5 s# K2 h8 Q
4725.       (setq lay_clr 0)
      
4726.     )
      9 M) z, d- H/ ]
4727.     (if (numberp (setq temp_color (acad_colordlg col_def T lay_clr)))
      6 L3 ~( y# Q$ \! D2 f
4728.       (progn
      5 i  U# q( _, h# _5 B9 R2 R
4729.         (setq ecolor temp_color)
      ( `2 w. U8 f8 |
4730.         (set_col_tile)
      + w3 p& y" U  a4 m% p; p& e$ k( }
4731.         ecolor
      ! B. R" Z+ t2 D& O
4732.       )
      
4733.       ecolor
      ; ~/ a$ i8 F! g( Q7 V4 Y+ s: Y, w
4734.     )  
      + h. p9 r7 R" W3 w1 O7 J- w6 ]
4735.   )
      6 V8 X9 t& J$ E. l# A% m" w
4736.   ;;
      ( `. {1 Y" B+ v# k9 Y
4737.   ;; This function pops a dialogue box consisting of a list box, image tile,
      ; w4 N$ E8 q: T4 _4 w
4738.   ;; and edit box to allow the user to select or type a linetype.  It returns
      ) {, b7 y' U) C. C: k
4739.   ;; the linetype selected.
      # N9 E3 M$ c! {
4740.   ;;
      
4741.   (defun getltype (/ old-idx ltname)
      
4742.     ;; Initialize a dialogue from dialogue file
      
4743.     (if (not (new_dialog "setltype" dcl_id)) (exit))
      
4744.     (start_list "list_lt")
      0 z7 V! S% r5 t, f
4745.     (mapcar 'add_list ltnmlst)         ; initialize list box
      
4746.     (end_list)
      1 Y) L: b& R) H) `8 H9 S* s
4747.     (setq old-idx lt-idx)
      : F  `- R" J; W6 J) ^) `
4748.     ;; Show initial ltype in image tile, list box, and edit box
      
4749.     (if (/= lt-idx nil)
      * a6 R, g) s8 B+ O7 F2 r4 ?! n/ N
4750.       (ltlist_act (itoa lt-idx))
      
4751.       (progn
      ) E4 e  {) _% l$ j. P7 u" J. g$ \, G
4752.         (set_tile "edit_lt" "Varies")
      
4753.         (col_tile "show_image" 0 nil)
      " A  y4 P3 l+ R( f4 K! X" w
4754.       )
      9 d! X, W# T9 y0 n3 d$ H, ~/ `
4755.     )
      1 G6 Z3 X& Q( ?6 E; r6 B4 X
4756.     (action_tile "list_lt" "(ltlist_act $value)")
      
4757.     (action_tile "edit_lt" "(ltedit_act $value)")
      8 `% i. B' u% e
4758.     (action_tile "accept" "(test-ok)")
      
4759.     (action_tile "cancel" "(reset-lt)")
      
4760.     (if (= (start_dialog) 1)           ; User pressed OK
      % R# ~+ ^4 \, U- q2 H0 N
4761.       (cond
      ' t! ?, U+ s; @7 D; i: [
4762.         ((= lt-idx nil)
      
4763.           (set_tile "t_ltype" "Varies")
      
4764.           "Varies"
      # ^9 R; G9 x6 K" ?& |, {/ t
4765.         )
      
4766.         ((= lt-idx 0)
      9 d9 B/ r/ M+ W4 m# ?, I4 V% t
4767.           (set_tile "t_ltype" (bylayer_lt))
      - N- b9 I) ?. F' d5 ^
4768.           "BYLAYER"
      
4769.         )
      0 n. e6 m& [  a; r# S$ `
4770.         ((= lt-idx 1)
      9 f1 V5 r+ W. W# ]' n
4771.           (set_tile "t_ltype" "BYBLOCK")
      
4772.           "BYBLOCK"
      
4773.         )
        F- R% h% ~6 `% k* y  A$ J' j+ U  d
4774.         (T  
      
4775.           (set_tile "t_ltype" ltname)
      
4776.           ltname
      
4777.         )
      : {" H: a7 j2 P' h
4778.       )
      
4779.       eltype
      
4780.     )
      
4781.   )
      3 Q7 v( m0 B  b) U: T5 l1 G% C
4782.   ;;
      
4783.   ;; Edit box entries end up here
      7 v- m- a3 B( c5 @6 R: l. p' ?, U- a; H# {
4784.   ;;
        _  A; a' `. t+ N5 `
4785.   (defun ltedit_act (ltvalue)
      2 O1 d$ F6 ^, Z1 j" p
4786.     ;; If linetype name,is valid, then clear error string,
      # O$ a  x& H, I1 I" t
4787.     ;; call ltlist_act function, and change focus to list box.
      
4788.     ;; Else print error message.
      1 s! I' [2 v' j/ u& C
4789.     (setq ltvalue (strcase ltvalue))
      # i! N& ^$ W: H4 l
4790.     (if (or (= ltvalue "BYLAYER") (= ltvalue "BY LAYER"))
      , H. a3 ?6 S1 w& t9 M
4791.       (setq ltvalue "BYLAYER")
      9 K+ q0 G6 k1 P8 B& f1 \
4792.     )
      $ B: q$ J/ e, E- q. `
4793.     (if (or (= ltvalue "BYBLOCK") (= ltvalue "BY BLOCK"))
      
4794.       (setq ltvalue "BYBLOCK")
      
4795.     )
      
4796.     (if (setq lt-idx (getindex ltvalue ltnmlst))
      0 q$ K" L; |, V  T# z
4797.       (progn
      
4798.         (set_tile "error" "")
      
4799.         (ltlist_act (itoa lt-idx))
      6 U; p) ?/ o$ \0 o: Y5 B+ a; G, w
4800.         (mode_tile "list_lt" 2)
      
4801.       )
      6 z9 o/ D8 e0 j0 T9 o. _( D
4802.       (progn
      
4803.         (if (/= ltvalue "VARIES")
      
4804.           (set_tile "error" "Invalid linetype.")
      % r/ M# K# n' X
4805.         )
      
4806.         (setq lt-idx old-idx)
      
4807.       )
      6 p- p5 {% N2 s2 D  Q% V
4808.     )
      - H" b$ _& ?& `
4809.   )
      
4810.   ;;
      3 M1 _6 b$ U! Y3 Q4 C) @
4811.   ;; List selections end up here
      
4812.   ;;
      
4813.   (defun ltlist_act (index / dashdata)
      
4814.     ;; Update the list box, edit box, and color tile
      / X9 G6 c5 N0 Q3 _' \
4815.     (set_tile "error" "")
      9 l# f6 A  |/ d( }, l
4816.     (setq lt-idx (atoi index))
      ) z8 R- \! {, Y, k# T
4817.     (setq ltname (nth lt-idx ltnmlst))
      
4818.     (setq dashdata (nth lt-idx mdashlist))
      
4819.     (col_tile "show_image" 0 dashdata)
      
4820.     (set_tile "list_lt" (itoa lt-idx))
      
4821.     (set_tile "edit_lt" ltname)
      
4822.   )
      , g$ l; R% ]6 v3 }+ X& P
4823.   ;;
      
4824.   ;; Reset to original linetype when cancel it selected
      ( ~: S, F: N/ {3 f# s& N2 I( ?$ B- J
4825.   ;;
      6 W0 h1 V2 W3 H8 D; n
4826.   (defun reset-lt ()
      2 Z% G9 Z: C3 `" f# o4 q
4827.     (setq lt-idx old-idx)
      
4828.     (done_dialog 0)
      ! |8 D. y+ Z8 ?% l
4829.   )
      
4830.   ;;
      
4831.   ;; This function pops a dialogue box consisting of a list box and edit box to
      
4832.   ;; allow the user to select or type a layer name.  It returns the layer name
      / j. v0 J& e. R1 A
4833.   ;; selected.  It also the status (On, Off, Frozen, etc.) of all layer in the
      
4834.   ;; drawing.
      % Z; w, w8 W0 r. ^2 |$ ?1 R0 K) V5 c- m- O
4835.   ;;
      ! l' ]! @# U) g, p+ r
4836.   (defun getlayer (/ old-idx layname on off frozth linetype colname)
      
4837.     ;; Load a dialogue from dialogue file
      , d4 i( s! a7 }: i# M6 ~
4838.     (if (not (new_dialog "setlayer" dcl_id)) (exit))
      
4839.     (start_list "list_lay")
      5 ?0 R7 K, z% w( v* r* h
4840.     (mapcar 'add_list longlist)        ; initialize list box
      
4841.     (end_list)
      
4842.     ;; Display current layer, show initial layer name in edit
      ! K  [( Q' E, B- B% D% J) g4 O
4843.     ;; box, and highlight list box.
      
4844.     (setq old-idx lay-idx)
      ! g8 j$ F- o1 Z2 ~8 q
4845.     (if (/= lay-idx nil) (laylist_act (itoa lay-idx)))
      - V5 Y! @4 E1 H" i
4846.     (set_tile "cur_layer" (getvar "clayer"))
      
4847.     (action_tile "list_lay" "(laylist_act $value)")
      : @' Z/ S, o8 F' Y, {7 ?
4848.     (action_tile "edit_lay" "(layedit_act $value)")
      + C4 p9 q8 N! Y' ?! M
4849.     (action_tile "accept" "(test-ok)")
      + o2 Y  E- y9 f9 c$ x9 Y  k! Y6 B9 v
4850.     (action_tile "cancel" "(reset-lay)")
      
4851.     (if (= (start_dialog) 1)           ; User pressed OK
      
4852.       (progn
      
4853.         (if (= lay-idx nil) (setq layname "Varies"))
      0 M' H6 e- V& m# ?2 V" v
4854.         (set_tile "t_layer" layname)
      ( V* h6 I" U- }/ e* Z
4855.         ; If layer or ltype equals bylayer reset their tiles
      1 \/ l/ B2 z9 S# {/ f$ S$ y0 E
4856.         (if (= lt-idx 0)
      # F0 O/ \$ z# P, n
4857.           (set_tile "t_ltype" (bylayer_lt))
      
4858.         )
      
4859.         (if (= ecolor 256)
      
4860.           (progn
      0 ?: Q# ]# v6 y/ Z7 `2 M2 o  X
4861.             (set_tile "t_color" (bylayer_col))
      8 J+ o2 C& d  L) y# W
4862.             (col_tile "show_image" cn nil)
      8 P' f+ p  g3 [, A5 l1 T
4863.           )
      
4864.         )
      
4865.         layname
      
4866.       )
      
4867.       elayer
      ' C2 v) V1 F2 @
4868.     )
      
4869.   )
      
4870.   ;;
      8 _& h) j; j& e& z* a9 ]
4871.   ;; Edit box selections end up here
      
4872.   ;;
      
4873.   (defun layedit_act (layvalue)
        v9 y6 E3 i2 Y8 p/ `. w
4874.     ;; Convert layer entry to upper case.  If layer name is
      
4875.     ;; valid, clear error string, call (laylist_act) function,
      
4876.     ;; and change focus to list box.  Else print error message.
      
4877.     (setq layvalue (strcase layvalue))
      
4878.     (if (setq lay-idx (getindex layvalue laynmlst))
      
4879.       (progn
      
4880.         (set_tile "error" "")
      8 d$ m; y1 U0 R% s
4881.         (laylist_act (itoa lay-idx))
      
4882.       )
      8 X/ ?  }$ h: t5 n
4883.       (progn
      
4884.         (set_tile "error" "Invalid layer name.")
      
4885.         (setq lay-idx old-idx)
        v/ T( Y" D8 O
4886.       )
      8 l6 e. O/ v: G6 z" D( i
4887.     )
      , c6 [6 M  w* [* z% x
4888.   )
      
4889.   ;;
        l7 b4 G; z/ E  x
4890.   ;; List entry selections end up here
      : c; J0 t. K7 Z- ^3 R
4891.   ;;
      
4892.   (defun laylist_act (index / layinfo color dashdata)
      4 C9 L* k1 ]8 x3 |) f3 `9 p7 K4 J
4893.     ;; Update the list box, edit box, and color tile
      % s" n! z$ @; ?& a
4894.     (set_tile "error" "")
      
4895.     (setq lay-idx (atoi index))
      
4896.     (setq layname (nth lay-idx laynmlst))
      
4897.     (setq layinfo (tblsearch "layer" layname))
        d* c0 I9 s, Y/ q# D& ?$ h* B
4898.     (if (= (logand (cdr (assoc 70 layinfo)) 4) 4)
      ( J, T2 F3 x" d  {
4899.       (set_tile "error" "Cannot change entity to locked layer.")
      ' m8 d& c0 O8 a7 p1 m& S
4900.       (progn
      
4901.         (setq color (cdr (assoc 62 layinfo)))
      , L7 W7 }+ v8 r1 [  Z) q0 n
4902.         (setq color (abs color))
      
4903.         (setq colname (colorname color))
      
4904.         (set_tile "list_lay" (itoa lay-idx))
      
4905.         (set_tile "edit_lay" layname)
      . o3 O/ X5 X/ ^
4906.         (mode_tile "list_lay" 2)
      - _0 \% {! P3 w6 Q5 U) r
4907.       )
      / ]8 r5 P& C" l! A7 V# \
4908.     )
      
4909.   )
      7 Y# F! _; J) l; t4 U
4910.   ;;
      
4911.   ;; Reset to original layer when cancel is selected
      
4912.   ;;
      6 z! A4 q4 k) Y$ H
4913.   (defun reset-lay ()
      
4914.     (setq lay-idx old-idx)
      
4915.     (done_dialog 0)
      7 l0 k$ q5 T6 w) f% j. i
4916.   )
      - v! t: B9 t8 `
4917.   ;;
      
4918.   ;; Checks validity of thickness from edit box. Since (atof) returns 0 when a
      
4919.   ;; string can't be converted to a real, this routine checks if the first
      - ?) G. Y" D" Y" n" T" T  v5 ?1 p4 n+ @
4920.   ;; character is "0".  It also checks to see if the value equals "Varies".
      0 f( `  F" j9 p5 {3 E1 U6 w0 @9 q1 X
4921.   ;;
      : j' k: k" D( B, c/ \7 Q5 u5 c, h$ {
4922.   (defun getthickness (value)
      
4923.     (setq value (strcase value))
      : y) `  u* L5 p+ w4 S
4924.     (if (or (= value "VARIES")
      
4925.             (distof value)
      
4926.         )
      
4927.       (progn
      
4928.         (set_tile "error" "")
      
4929.         (if (= value "VARIES")
      2 u( V( A+ z( o- i9 w) t$ B0 s
4930.           (progn
      
4931.             (set_tile "eb_thickness" "Varies")
      
4932.             (setq ethickness nil)
      : [# O6 I+ x- u, ^8 c7 g; \
4933.           )
      
4934.           (progn
      
4935.             (setq ethickness (distof value))
      
4936.             (set_tile "eb_thickness" (rtos ethickness))
      ! L% ~" e" c4 U) g0 J  A
4937.             ethickness
      
4938.           )
      # y/ I1 g1 \. J+ b* J& J
4939.         )
      9 H, J+ f& S/ j$ z9 [6 N" w
4940.       )
      $ F( d9 g4 {# ?6 F3 V  }( X
4941.       (progn
      
4942.         (set_tile "error" "Invalid thickness.")
      
4943.         nil
      
4944.       )
      
4945.     )
      
4946.   )
      
4947.   ;;
      : i3 w+ l4 \7 u; V4 H
4948.   ;; This function make a list called laynmlst which consists of all the layer
      
4949.   ;; names in the drawing.  It also creates a list called longlist which
      
4950.   ;; consists of strings which contain the layer name, color, linetype, etc.  
      
4951.   ;; Longlist is later mapped into the layer listbox.  Both are ordered the
      & d/ k5 p" ~* C4 r* d4 N
4952.   ;; same.
      
4953.   ;;
      
4954.   (defun makelaylists (/ layname onoff frozth color linetype vpf vpn ss cvpname
      ( H6 k/ c- p4 U+ C
4955.                          xdlist vpldata sortlist name templist bit-70
      
4956.                       )
      
4957.     (if (= (setq tilemode (getvar "tilemode")) 0)
      
4958.       (progn
      
4959.         (setq ss (ssget "x" (list (cons 0 "VIEWPORT")
      
4960.                                   (cons 69 (getvar "CVPORT"))
      
4961.                             )
      
4962.                  )
      
4963.         )     
      
4964.         (setq cvpname (ssname ss 0))
      
4965.         (setq xdlist (assoc -3 (entget cvpname '("acad"))))
      # l% L" n2 U  ?0 n
4966.         (setq vpldata (cdadr xdlist))
      0 E& O4 V" s! X- G. y# n  Z
4967.       )
      
4968.     )
      
4969.     (setq sortlist nil)
      - E! k4 S% V; L6 a1 K
4970.     (setq templist (tblnext "LAYER" T))
      
4971.     (while templist
      
4972.       (setq name (cdr (assoc 2 templist)))
      
4973.       (setq sortlist (cons name sortlist))
      0 z+ i) e, B7 v
4974.       (setq templist (tblnext "LAYER"))
      ; g1 `$ P, y0 W# L% Q0 P% D% {
4975.     )
      3 C3 _; J$ |2 ^3 k7 @- B# V; x7 k: U
4976.     (if (>= (getvar "maxsort") (length sortlist))
      
4977.       (setq sortlist (acad_strlsort sortlist))
      
4978.       (setq sortlist (reverse sortlist))
      . Q: b0 j: {' V; E. F5 y6 |: O$ {
4979.     )
      
4980.     (setq laynmlst sortlist)
      2 w/ G. m6 Q8 }$ Y+ C2 ]% L4 H
4981.     (setq longlist nil)
      , ~, P7 \; o2 h7 X) V
4982.     (setq layname (car sortlist))
      
4983.     (while layname
      , s4 w1 a( P; b7 ?* x
4984.       (setq laylist (tblsearch "LAYER" layname))
      : F3 D: g. f1 X$ R1 e4 J
4985.       (setq color (cdr (assoc 62 laylist)))
      : I; f! j0 u7 t0 s
4986.       (if (minusp color)
      - }9 w' K% \  h; e6 l8 L
4987.         (setq onoff ".")
      
4988.         (setq onoff "On")
      $ y( w0 u% i! X. _
4989.       )
      
4990.       (setq color (abs color))
      : N. `( ~4 B0 h0 e# \1 U8 R
4991.       (setq colname (colorname color))
      * g" x3 u0 v' f' Q9 N4 i3 E) H# @
4992.       (setq bit-70 (cdr (assoc 70 laylist)))
      
4993.       (if (= (logand bit-70 1) 1)
      $ v9 F9 v  I; ~/ L* r
4994.         (setq frozth "F" fchk laylist)
      
4995.         (setq frozth ".")
      # N% Q4 W( H" h+ }
4996.       )
      + V. l  ?/ X) b7 ^& h. Z
4997.       (if (= (logand bit-70 2) 2)
      
4998.         (setq vpn "N")
        ^  p" S8 G& I
4999.         (setq vpn ".")
      3 @3 ^6 |8 f* g1 F4 f
5000.       )
      
5001.       (if (= (logand bit-70 4) 4)
      
5002.         (setq lock "L")
      $ p& M! K$ l) h2 ^* z* C
5003.         (setq lock ".")
      
5004.       )
      
5005.       (setq linetype (cdr (assoc 6 laylist)))
      
5006.       (setq layname (substr layname 1 31))
      ; i0 e+ y  g3 [9 `
5007.       (if (= tilemode 0)
      , @) t8 ]1 s8 o7 y7 m% y! r
5008.         (progn
      " {; K0 R: I' M( V
5009.           (if (member (cons 1003 layname) vpldata)
      1 F: H- F9 Z9 G& u
5010.             (setq vpf "C")
      " k& u5 J5 U* o0 X9 {( V7 C4 B/ c% J
5011.             (setq vpf ".")
      
5012.           )
      4 I# r1 ?- V+ p; K& M7 P
5013.         )
      
5014.         (setq vpf ".")
      
5015.       )
      4 @* s! e! I% B
5016.       (setq ltabstr (strcat layname "\t"
      / |- t' t: i: t$ t! s: Q9 M
5017.                               onoff "\t"
      5 M9 c7 W; q& G* C! [6 k" I+ P5 i
5018.                              frozth "\t"
      % `6 y6 _0 j7 O; U0 f$ u
5019.                                lock "\t"
      
5020.                                 vpf "\t"
      ' I8 J3 ?- J9 h: j, c- h
5021.                                 vpn "\t"
      
5022.                             colname "\t"
      
5023.                            linetype
      4 }# q( ]; g) t8 M, s! I
5024.                     )
      
5025.       )
      0 V4 S. i8 G1 i( k/ S2 S8 t# r0 k
5026.       (setq longlist (append longlist (list ltabstr)))
      6 D# W# L. ^: ?8 Y  q3 g$ i. y
5027.       (setq sortlist (cdr sortlist))
      
5028.       (setq layname (car sortlist))
      
5029.     )
      " a$ [% T- o- z1 I
5030.   )
      7 o$ H( ^2 X6 H
5031.   ;;
      
5032.   ;; This function makes 2 lists - ltnmlst & mdashlist.  Ltnmlst is a list of
      . q6 I# R( |8 t* J& j& [
5033.   ;; linetype names read from the symbol table.  Mdashlist is list consisting
      
5034.   ;; of lists which define the linetype pattern - numbers that indicate dots,
      
5035.   ;; dashes, and spaces taken from group code 49.  The list corresponds to the
      
5036.   ;; order of names in ltnmlst.
      0 W+ Y9 w7 U5 x. Y" u" w( @
5037.   ;;
      . c+ e/ |6 q8 ^( k; P# U
5038.   (defun makeltlists (/ ltlist ltname)
      
5039.     (setq mdashlist nil)
      / h. P5 P. [2 s% X
5040.     (setq ltlist (tblnext "LTYPE" T))
      
5041.     (setq ltname (cdr (assoc 2 ltlist)))
      ( ^9 b8 d8 I2 h$ q; t7 i. f
5042.     (setq ltnmlst (list ltname))
      2 ]3 R7 _9 u8 H# f
5043. 
      0 Y. _3 c5 _+ u8 ^. e6 b
5044.     (if (= ltname "CONTINUOUS")
      2 B. R. d, }9 g$ d% L- _, K4 A
5045.       (setq mdashlist (list "CONT"))
      0 I5 S/ V# I4 z& Y
5046.       (setq mdashlist
      
5047.             (append mdashlist (list (add-mdash ltlist)))
      
5048.       )
      * u; h$ `, k& @0 M! h6 j
5049.     )
      / q4 ]. p# S( _7 \$ [
5050.     (while (setq ltlist (tblnext "LTYPE"))
      
5051.            (setq ltname (cdr (assoc 2 ltlist)))
      
5052.            (setq ltnmlst (append ltnmlst (list ltname)))
      5 ^/ }. K% N- k2 l  A( r" z
5053.            (setq mdashlist
      + p, [$ f' R( F# m8 D
5054.                 (append mdashlist (list (add-mdash ltlist)))
      
5055.            )
      3 J) a, k! O9 ~: S0 ?! |! n: x' @
5056.     )
      
5057.     (setq ltnmlst (cons "BYBLOCK" ltnmlst))
      3 i. j- \) c  P1 \* ]% a+ m
5058.     (setq mdashlist  (cons nil mdashlist))
      8 I* ]4 F& C' G) T4 Z; N
5059.     (setq ltnmlst (cons "BYLAYER" ltnmlst))
      0 D: T! f. s- g9 n
5060.     (setq mdashlist  (cons nil mdashlist))
      * q5 v0 U, S2 T
5061.   )
      $ e2 T5 ^5 ~8 D) S
5062.   ;;
      
5063.   ;; Get all the group code 49 values for a linetype and put them in a list
      
5064.   ;; (pen-up, pen-down info)
      , M. O: X! ]. j1 o) I
5065.   ;;
      
5066.   (defun add-mdash (ltlist1 / dashlist assoclist dashsize)
      4 P, G( |& @  W0 Q  }' M
5067.     (setq dashlist nil)
      3 q- w0 ?) t* \# g
5068.     (while (setq assoclist (car ltlist1))
      
5069.       (if (= (car assoclist) 49)
      
5070.         (progn
      / Q5 `5 n  ^  h& p$ \
5071.           (setq dashsize (cdr assoclist))
      
5072.           (setq dashlist (cons dashsize dashlist))
      
5073.         )
      
5074.       )
      ' w( j- k6 n5 A, p
5075.       (setq ltlist1 (cdr ltlist1))
      
5076.     )
      $ o6 P$ }1 Z6 D9 E3 x6 B
5077.     (setq dashlist (reverse dashlist))
      0 T7 T3 \5 W. d+ f
5078.   )
      1 {0 k0 k( n* Z
5079.   ;;
      
5080.   ;; Color a tile, draw linetype, and draw a border around it
      9 H2 |  _; E; h  ]( v4 U) x
5081.   ;;
      * l6 K& h9 ^% ^( o+ K! `0 q
5082.   (defun col_tile (tile color patlist / x y)
      7 F# O# @9 H0 h" F
5083.     (setq x (dimx_tile tile))
      8 R# u; L/ o  Y, i) ]) \* y; \4 K
5084.     (setq y (dimy_tile tile))
      
5085.     (start_image tile)
      
5086.     (fill_image 0 0 x y color)
      
5087.     (if (= color 7)
      9 i, Z  z& R. L8 R8 k& R
5088.       (progn
      . l2 t% k" H0 X; }4 x! A- Z8 X
5089.         (if patlist (drawpattern x (/ y 2) patlist 0))
      
5090.         (tile_rect 0 0 x y 0)
      3 J2 L/ T* I; y% a7 @
5091.       )
      
5092.       (progn
      ' ]+ y& @8 B# ?
5093.         (if patlist (drawpattern x (/ y 2) patlist 7))
      
5094.         (tile_rect 0 0 x y 7)
      
5095.       )
      
5096.     )
      
5097.     (end_image)
      + F* R6 D, v0 u
5098.   )
      
5099.   ;;
      
5100.   ;; Draw a border around a tile
      
5101.   ;;
      
5102.   (defun tile_rect (x1 y1 x2 y2 color)
      / ?5 w) d' h" j4 p; ]! t1 z
5103.     (setq x2 (- x2 1))
      
5104.     (setq y2 (- y2 1))
      6 D9 `' T, D& r& Y7 w/ N3 {
5105.     (vector_image x1 y1 x2 y1 color)
      / E* q2 F- t5 }1 e8 W* Z% B
5106.     (vector_image x2 y1 x2 y2 color)
      1 w. I4 n& M6 t: C4 L5 J% c
5107.     (vector_image x2 y2 x1 y2 color)
      
5108.     (vector_image x1 y2 x1 y1 color)
      
5109.   )
      5 [/ H4 B' Q9 z  [. |8 v" W
5110.   ;;
      . p' m2 V. Y* U$ x
5111.   ;; Draw the linetype pattern in a tile.  Boxlength is the length of the image
      
5112.   ;; tile, y2 is the midpoint of the height of the image tile, pattern is a
      & X. U. {7 p& J9 ?+ {" W5 |
5113.   ;; list of numbers that define the linetype, and color is the color of the
      , v3 c2 `; @) ~+ V- x2 A/ M* D
5114.   ;; tile.
      
5115.   ;;
      : T% b4 L, m; m+ H4 @/ X- x& s
5116.   (defun drawpattern (boxlength y2 pattern color / x1 x2
      ! {7 }/ p7 g7 c( B0 \7 a
5117.                       patlist dash)
      + V: k" I) J, S: d$ E
5118.     (setq x1 0 x2 0)
      
5119.     (setq patlist pattern)
      % L& W7 T' H$ r$ [- g0 y5 n$ r
5120.     (if (= patlist "CONT")
      
5121.       (progn
      
5122.         (setq dash boxlength)
      
5123.         (vi)
      : U/ o) o& A  b, T# B% P/ Q' i
5124.         (setq x1 boxlength)
      1 q" D' ^; |% o$ ?/ l0 p
5125.       )
      
5126.     )
      , `  f2 I: T: E& j
5127.     (while (< x1 boxlength)
      
5128.       (if (setq dash (car patlist))
      & X( v9 q% v) g
5129.         (progn
      
5130.           (setq dash (fix (* 30 dash)))
      ( M7 k' q) B; ?; R; p
5131.           (cond
      1 L' j' U/ Y& W5 T( B( r& @& _; E
5132.             ((= dash 0)
      
5133.               (setq dash 1)
      ( z4 h. e% c$ Z, B% |4 K% I
5134.               (vi)
      
5135.             )
      % @5 x- v& o# ^5 o% ?0 U
5136.             ((> dash 0)
        }/ I) O3 m8 c9 ^% a1 D
5137.               (vi)
      " w* u& x& r+ c' m! Y( k6 G
5138.             )
      ; Y# m9 Z9 a/ i7 Y* J4 D9 g6 w
5139.             (T
      5 n: ^4 H9 L; m7 c! e4 C/ L$ X6 p
5140.               (if (< (abs dash) 2) (setq dash 2))
      1 Z! A5 k! Y/ j: F
5141.               (setq x2 (+ x2 (abs dash)))
      / i# ]5 M- ]+ X
5142.             )
      
5143.           )
      
5144.           (setq patlist (cdr patlist))
      ( s% P3 r0 P% E
5145.           (setq x1 x2)
      8 B2 x% u( q" M! {0 X- R
5146.         )
      
5147.         (setq patlist pattern)
      
5148.       )
      " a5 E! F* s: w
5149.     )
      
5150.   )
      
5151.   ;;
      3 F/ Q: h9 J" q$ R
5152.   ;; Draw a dash or dot in image tile
      3 S9 d$ ^& w: x; G9 ~" c
5153.   ;;
      
5154.   (defun vi ()
      
5155.     (setq x2 (+ x2 dash))
      
5156.     (vector_image x1 y2 x2 y2 color)
      
5157.   )
      
5158.   ;;
      
5159.   ;; This function takes a selection and returns a list of the color, linetype,
      
5160.   ;; layer, and thickness properties that are common to every entities in the
      ; O, L5 d6 {. Y2 k
5161.   ;; selection set - (color linetype layer thickness).  If all entities do not
      
5162.   ;; share the same property value it returns "Varies" in place of the
      % l2 f) o2 c- Y( u
5163.   ;; property value.  i.e. ("BYLAYER" "DASHED" "Varies" 0)
      9 l. E/ h* J  X3 S9 w# t2 X
5164.   ;;
      - J# c9 J8 k" N# v' s, P
5165.   (defun getprops (selset / sslen elist color ltype layer
      ! y) w4 z: S8 T' y9 {* Z! d
5166.                             thickness go chk-col chk-lt chk-lay chk-th ctr)
      # g0 `4 v" E. T* f6 J1 k+ }
5167.     (setq sslen (sslength selset))
      
5168.     (setq elist (entget (ssname selset 0)))
      
5169.     (setq color (cdr (assoc 62 elist)))
      
5170.     (if (not color) (setq color 256))
      
5171.     (setq ltype (cdr (assoc 6 elist)))
      % I/ q" g- Q; v& S  z
5172.     (if (not ltype) (setq ltype "BYLAYER"))
      $ m+ y3 m7 M: ?& \$ X$ Q# l
5173.     (setq layer (cdr (assoc 8 elist)))
      # `; ~# L8 I8 N
5174.     (setq thickness (cdr (assoc 39 elist)))
      
5175.     (if (not thickness) (setq thickness 0))
      % q' o3 e- t$ C0 e; s' K
5176.     (setq go T chk-col T chk-lt T chk-lay T chk-th T ctr 1)
      ( a: M; v0 q# d" o: U+ ^, m: t9 W
5177. 
      2 a8 c$ k2 `! u# s! H- k% Z* y
5178.     ;; Page through the selection set.  When a property
      + h- f. `3 r9 M9 O* q+ w
5179.     ;; does not match, stop checking for that property.
      
5180.     ;; If all properties vary, stop paging.
      6 r# ?8 Y5 a" R& a+ ^( U6 g
5181. 
      5 |* C+ U' R0 Z5 T
5182.     (while (and (> sslen ctr) go)
      
5183.       (setq elist (entget (setq en (ssname selset ctr))))
      9 d7 t+ C  J- l. ]  _
5184.       (if chk-col (match-col))
      . Q* ?! P5 x3 R0 c
5185.       (if chk-lt (match-lt))
      
5186.       (if chk-lay (match-lay))
      
5187.       (if chk-th (match-th))
      
5188.       (setq ctr (1+ ctr))
      ! K- h# x: K0 E6 I$ Y! Y
5189.       (if (and (not chk-col) (not chk-lt) (not chk-lay) (not chk-th))
      
5190.         (setq go nil)
      ( z) i8 C( T! S) J6 P/ p* q
5191.       )
      % @" O- V$ s1 Y7 _! r
5192.     )
      
5193.     (list color ltype layer thickness)
      * |3 b) u0 [5 Y- ]7 v8 G( q1 `. j
5194.   )
      
5195. 
      
5196.   (defun match-col (/ ncolor)
      4 ^- t2 l) F& |! w8 o) V
5197.     (setq ncolor (cdr (assoc 62 elist)))
      
5198.     (if (not ncolor) (setq ncolor 256))
      $ b5 p0 n4 M1 I! T9 u* L
5199.     (if (/= color ncolor)
      
5200.       (progn
      , J, J. n7 b5 K% p4 X' ^' w) O
5201.         (setq chk-col nil)
      7 t0 f2 F5 a; u+ K
5202.         (setq color nil)
      
5203.       )
      5 y) m2 B' M! J4 P" a; |, ]: u. H
5204.     )
      
5205.   )
      8 y4 e7 m8 f; x% F, Y
5206. 
      $ h3 w+ W  z! q: y/ \
5207.   (defun match-lt (/ nltype)
      
5208.     (setq nltype (cdr (assoc 6 elist)))
      4 T( N) ]) S* ]& f
5209.     (if (not nltype) (setq nltype "BYLAYER"))
      
5210.     (if (/= ltype nltype)
      & l3 c% Y; Z; y4 t( K
5211.       (progn
      
5212.         (setq chk-lt nil)
      
5213.         (setq ltype "Varies")
      ; ?$ x1 ^- b! X1 J
5214.       )
      
5215.     )
      
5216.   )
      
5217. 
      
5218.   (defun match-lay (/ nlayer)
      
5219.     (setq nlayer (cdr (assoc 8 elist)))
      & `) n2 }! k, I7 F* Q; m9 k
5220.     (if (/= layer nlayer)
      4 l2 N- ~4 s0 K  x; |/ G$ L
5221.       (progn
      
5222.         (setq chk-lay nil)
      ) D5 D" w- v4 ~/ t6 v
5223.         (setq layer "Varies")
      : G2 h* t1 Z$ Y+ O7 u
5224.       )
      ) F7 Q! u* ^: H0 O2 @
5225.     )
      # A4 j* A0 @3 y- r, o
5226.   )
      ) q3 d- F9 v4 s
5227. 
      , o9 o4 K+ H2 `3 R/ m
5228.   (defun match-th (/ nthickness)
      
5229.     (setq nthickness (cdr (assoc 39 elist)))
      
5230.     (if (not nthickness) (setq nthickness 0))
      7 [9 L+ `, x- x+ Y
5231.     (if (/= thickness nthickness)
      
5232.       (progn
      
5233.         (setq chk-th nil)
      
5234.         (setq thickness "Varies")
      , F7 B# z$ p* H3 }  U( ?0 Z
5235.       )
      2 {/ Y" V7 f; w9 F
5236.     )
      
5237.   )
      . e9 b! _" ^+ d6 ^. a. O$ q
5238. 
      
5239.   ;;
      
5240.   ;; If an item is a member of the list, then return its index number, else
      ) A/ [' H6 m6 |  d  z* |
5241.   ;; return nil.
      
5242.   ;;
      ! k- u. j7 M$ }. Y' b2 E# p
5243.   (defun getindex (item itemlist / m n)
      1 O* f; B0 ?9 P$ W8 W# V0 |
5244.     (setq n (length itemlist))
      # O, |" o. i- i7 _
5245.     (if (> (setq m (length (member item itemlist))) 0)
      
5246.         (- n m)
      
5247.         nil
      
5248.     )
      
5249.   )
      2 O( q& B  K0 y7 q3 x3 R' D
5250.   ;;
      
5251.   ;; This function is called if the linetype is set "BYLAYER". It finds the
      
5252.   ;; ltype of the layer so it can be displayed beside the linetype button.
      
5253.   ;;
      $ V2 N/ m8 z# h
5254.   (defun bylayer_lt (/ layname layinfo ltype)
      ( A4 ]3 v2 x1 X) F, ?
5255.     (if lay-idx
      
5256.       (progn
      
5257.         (setq layname (nth lay-idx laynmlst))
      ' A) n' }* |) o
5258.         (setq layinfo (tblsearch "layer" layname))
        E( x. }  X4 j8 H) {% r
5259.         (setq ltype (cdr (assoc 6 layinfo)))
      
5260.         (strcat "BYLAYER (" ltype ")")
      3 x4 f" d1 t+ d) }
5261.       )
      4 s$ @2 B; Q0 e5 K" k
5262.       "BYLAYER"
      
5263.     )
      
5264.   )
      ' }% k5 k$ Y. r8 C8 G0 k& \0 _
5265.   ;;
      8 |2 {- g0 x8 o, ]0 h; T
5266.   ;; This function is called if the color is set "BYLAYER".  It finds the
      
5267.   ;; color of the layer so it can be displayed  beside the color button.
      : n/ U# g. R6 x0 I$ z  A7 k
5268.   ;;
      
5269.   (defun bylayer_col (/ layname layinfo color)
      
5270.     (if lay-idx
      3 }2 v1 R( G4 `: z
5271.       (progn
      
5272.         (setq layname (nth lay-idx laynmlst))
      
5273.         (setq layinfo (tblsearch "layer" layname))
      
5274.         (setq color (abs (cdr (assoc 62 layinfo))))
      
5275.         (setq cn color)
      
5276.         (strcat "BYLAYER (" (colorname color) ")")
      
5277.       )
      
5278.       (progn
      " m+ p  e! b7 X6 w' C
5279.         (setq cn 0)
      3 u& a- n/ p% L0 W8 r
5280.         "BYLAYER"
      7 J0 t  A! x- ~
5281.       )
      
5282.     )
      
5283.   )
      7 g* B. Z3 N/ Z
5284.   ;;
      
5285.   ;; If there is no error message, then close the dialogue
      
5286.   ;;
      
5287.   ;; If there is an error message, then set focus to the tile
      6 o% b! U6 a9 K/ D) I: K/ {$ R
5288.   ;; that's associated with the error message.
      
5289.   ;;
      $ C4 j- ~0 N% X1 h+ P, X# a
5290.   (defun test-ok ( / errtile)
      
5291.     (setq errtile (get_tile "error"))
      ! @& R  F6 b; c7 [4 |% U/ a: C+ n& o
5292.     (cond
      0 y" ~9 `3 _  Q) E& X
5293.       (  (= errtile "")
      
5294.          (done_dialog 1))
      - H2 ?4 }5 r3 C4 R
5295.       (  (= errtile "Invalid thickness.")
      : P+ a2 P% i; V5 h: r
5296.          (mode_tile "eb_thickness" 2))
      
5297.     )
      
5298.   )
      0 k# C- d8 F! x; H3 \/ ]7 {
5299.   ;;
      
5300.   ;; A color function used by getlayer.
      
5301.   ;;
      * l! A9 ^4 v" E- d+ X) s$ v4 D# F/ A
5302.   (defun colorname (colnum)
      5 X+ a$ b7 G% M4 z
5303.     (setq cn (abs colnum))
      
5304.     (cond ((= cn 1) "red")
      2 W6 {* `; v/ G% }  d
5305.           ((= cn 2) "yellow")
      
5306.           ((= cn 3) "green")
      , d/ `) m: p2 E9 I, I. H7 D/ W
5307.           ((= cn 4) "cyan")
      
5308.           ((= cn 5) "blue")
      % M* Z6 F7 J- M5 N8 Z
5309.           ((= cn 6) "magenta")
      * w+ q, f- q3 S3 f& k
5310.           ((= cn 7) "white")
      
5311.           (T (itoa cn))
      . }/ m1 H) [; G( Y6 R- s8 d4 ^
5312.     )
      
5313.   )
      
5314. 
      * V+ I0 O2 N- t8 G
5315. ;;; Construct layer and ltype lists and initialize all
      
5316. ;;; program variables:
      ! K0 K, Z! F. J9 D8 y% X% }
5317. 
      * A  H0 r9 k/ H# ]
5318.   (makelaylists)                     ; layer list - laynmlst
      5 z' j) Y' {, y% @( K! T' y
5319.   (makeltlists)                      ; linetype lists - ltnmlst, mdashlist
      
5320.   ;; Find the property values of the selection set.
      # }9 v5 O$ a2 {8 }* S6 l
5321.   ;; (getprops ss) returns a list of properties from
      5 W' `! R: _" o
5322.   ;; a selection set - (color ltype layer thickness).
      
5323.   (setq proplist (getprops ss))
      
5324.   (setq ecolor (car proplist))
      
5325.   (setq eltype (cadr proplist))
      # b) _- g* G, s( d2 y
5326.   (setq elayer (caddr proplist))
      
5327.   (setq ethickness (cadddr proplist))
      
5328.   ;; Find index of linetype, and layer lists
      ) {! ^6 u1 D% n$ M" u; Q6 C
5329.   (cond
      
5330.     ((= eltype "Varies") (setq lt-idx nil))
      
5331. ;   ((= eltype "BYLAYER") (setq lt-idx (getindex "BYLAYER" ltnmlst)))
      2 f6 ~+ ?; s$ B8 V1 G7 H/ a
5332. ;   ((= eltype "BYBLOCK") (setq lt-idx (getindex "BYBLOCK" ltnmlst)))
      
5333.     (T (setq lt-idx (getindex eltype ltnmlst)))
      7 m4 g( n; N) P, L0 z
5334.   )
      
5335.   (if (= elayer "Varies")
      
5336.       (setq lay-idx nil)
      6 q/ G$ g% n- t( y: u( K) }5 o
5337.       (setq lay-idx (getindex elayer laynmlst))
      . @3 A6 ?. i. K: j2 w$ J) B7 j
5338.   )
      
5339.   (if (= ethickness "Varies")
      
5340.       (setq ethickness nil)
      5 v+ S1 c# {; w& d% _
5341.   )
      
5342. 
      
5343. )   ; end (ddchprop_init)
      * k# p) _0 S8 ~1 i/ x1 h
5344. 
      
5345. ;;; (ddchprop_select)
      4 R; i. l/ o& P; ?  G
5346. ;;;
      ; R* Q# X1 `5 V: z2 c) w
5347. ;;; Aquires selection set for DDCHPROP, in one of three ways:
      ; F9 Q+ Q/ s5 \. {7 _( E
5348. ;;;
      
5349. ;;;   1 - Autoselected.
      
5350. ;;;   2 - Prompted for.
      ' U4 Y6 x2 k% [
5351. ;;;   3 - Passed as an argument in a call to (ddchprop <ss> )
      : G& A# ^2 I6 d  m$ G
5352. ;;;
      / c- v# I4 q! H5 G) D4 ~- \
5353. ;;; The (ddchprop_select) function also sets the value of the
      4 u8 ]' ~! f- s9 ]$ j* A( C( |. B
5354. ;;; global symbol AI_SELTYPE to one of the above three values to
      . p8 i; W( h: x' n% [6 ]+ i
5355. ;;; indicate the method thru which the entity was aquired.
      
5356. 
      
5357. 
      
5358. (defun ddchprop_select ()
      
5359.    (cond
      ( |" o( @/ c5 i* T4 w+ y
5360.       (  (and ss (eq (type ss) 'pickset))        ; selection set passed to
      
5361.          (cond                                   ; (ddchprop) as argument
      
5362.             (  (not (zerop (sslength ss)))       ;   If not empty, then
      ( E0 q, s; p- A; y
5363.                (setq ai_seltype 3)               ;   then return pickset.
      
5364.                (ai_return ss))))
      
5365. 
        u7 Z! H! e9 p1 u7 l
5366.       (  (ai_aselect))                          ; Use current selection
      ! f# O- T0 Z/ Y5 e. X7 j* M) D
5367.                                                 ; set or prompt for objects
      
5368. 
      
5369.       (t (princ "\nNothing selected.")
      
5370.          (ai_return nil))
      
5371.    )
      + `- A0 x9 b0 m. d, y9 _7 ^
5372. )
      
5373. 
      . z$ h% Y" N1 I! J$ o; L
5374. ;;; Define command function.
      3 q$ Y& @  B( ~& v
5375. 
      
5376. (defun C:CH ()
      ( E" i' b# F. |: J( r
5377.    (ddchprop nil)
      
5378.    (princ)
      5 I& A+ ^/ ?6 Y9 [! D, H0 Q
5379. )
      
5380. 
      9 e9 |* y! x! |6 U
5381. 
      + Y' m* N7 W8 T* {8 D
5382. ;;; Main program function - callable as a subroutine.
      
5383. ;;;
      4 x+ u- ]8 B6 U; _$ S6 ]7 E
5384. ;;; (ddchprop <pickset> )
      & U- Z  N0 Y& D
5385. ;;;
      * g4 ~* W2 z5 {' G( A$ W
5386. ;;; <pickset> is the selection set of objects to be changed.
      
5387. ;;;
      1 v9 x! x; |9 _7 @
5388. ;;; If <pickset> is nil, then the current selection set is
      
5389. ;;; aquired, if one exists.  Otherwise, the user is prompted
      4 r. j  |3 k# x/ M8 ?$ j( ^, C+ ~2 R
5390. ;;; to select the objects to be changed.
      - \* S. t, Z1 y; x9 }( e
5391. ;;;
      % E; h  ]. R: w/ s
5392. ;;; Before (ddchprop) can be called as a subroutine, it must
      
5393. ;;; be loaded first.  It is up to the calling application to
      
5394. ;;; first determine this, and load it if necessary.
      
5395. 
      
5396. (defun ddchprop (ss  /
      
5397. 
      . K  i# P0 b& X: l  L% q
5398.                   add-mdash      ecolor          ltedit_act      s
      7 f0 |- G( ^9 F( l7 m
5399.                   assoclist      elayer          ltidx           selset
      
5400.                   bit-70         elist           ltlist          set_col_tile
      ; u0 V* k' F2 @7 K2 x- f
5401.                   boxlength      eltype          ltlist1
      
5402.                   bylayer-lt     en              ltlist_act      sortlist
      - k3 a& h; O" d. ?0 U
5403.                   bylayer_col    ethickness      ltname
      . r3 o9 P" x" N( a
5404.                   bylayer_lt     fchk            ltnmlst         sslen
      3 ^9 b) L7 C) |! d! q: c
5405.                   call_chp       frozth          ltvalue         templist
      5 f5 r/ B+ q+ {7 y4 i, w
5406.                   chk-col        getcolor        ltype           temp_color
      
5407.                   chk-lay        getindex        m               test-ok
        v: P+ Q, e# U
5408.                   chk-lt         getlayer        makelaylists    testidx
      
5409.                   chk-th         getltype        makeltlists     testlay
      1 }. E/ ]) z) ~3 w
5410.                   cmd            getprops        match-col       th-value
      
5411.                   cmdecho        getthickness    match-in        thickness
      
5412.                   cn             globals         match-lay       tile
      5 b" R/ G5 X- D1 ?1 u! o
5413.                   cnum           go              match-lt        tilemode
      , }: q% i: v; L
5414.                   col-idx        index           match-th        tile_rect
      . @+ U$ M+ [0 n
5415.                   colname        item            match_col       vi
      ; P& I) h. b2 F4 I2 p
5416.                   colnum         item1           mdashlist       vpf
      
5417.                   color          item2           n               vpldata
      
5418.                   colorname      itemlist        name            vpn
      0 P. |, T5 w0 a! _7 V' o
5419.                   col_def        lay-idx         ncolor          x
      0 P0 k" e8 {6 B/ I( U" G
5420.                   col_tile       layedit_act     nlayer          x1
      
5421.                   ctr            layer           nltype          x2
      
5422.                   cvpname        layinfo         nthickness      xdlist
      ! n5 X" X1 H1 ]8 i5 S' `# Q
5423.                   dash           laylist         off             y
      
5424.                   dashdata       laylist_act     old-idx         y1
      $ ]1 E- e' @" q! \( `; B, p: ^9 W! N4 q
5425.                   dashlist       layname         olderr          y2
      & {. |* x) P* V
5426.                   dashsize       laynmlst        on              undo_init
      ! Z/ i: N5 E1 F: S0 `
5427.                   dcl_id         layvalue        onoff
      
5428.                                  linetype        patlist
      
5429.                   ddchprop-err   list1           pattern
      
5430.                   longlist       proplist
      
5431.                   lt-idx         reset-lay
      
5432.                   drawpattern    ltabstr         reset-lt
      
5433.                 )
      0 {. W0 z! v2 ~1 V7 h& N! S
5434. 
      
5435.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
      & L# C# y& {. ?9 f  q, h
5436.         old_error  *error*            ; save current error function
      # p* R0 m4 U8 y9 W4 J* z
5437.         *error* ai_error              ; new error function
      
5438.   )
      0 l; j+ H. c# D/ ^2 p. O
5439. 
      
5440.   (setvar "cmdecho" 0)
      
5441. 
      
5442.   (cond
      
5443.      (  (not (ai_notrans)))                      ; Not transparent?
      
5444.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
        n  G4 V$ a7 ?$ Q1 S
5445.      (  (not (setq dcl_id (ai_dcl "ddchprop")))) ; is .DCL file loaded?
      
5446.      (  (not (setq ss (ddchprop_select))))       ; objects to modify?
      8 _) y( J: {# l- O/ l' h
5447. 
      , j. O# ~  [# H0 v, @9 L, ~# T
5448.      (t (ai_undo_push)
      
5449.         (ddchprop_init)                          ; Everything's cool,
      9 A0 k' y* y4 _# L) D) u3 b- {
5450.         (call_chp)                               ; so proceed!
      4 W9 b: b$ ]9 ?# e3 p
5451.         (ai_undo_pop)
      ( z+ }' m, e  F* l3 a
5452.      )
      + x/ ^3 g% h7 q% t
5453.   )
      3 b' R: B  J8 U
5454.   
      
5455.   (setq *error* old_error)
      & I) w8 [6 K# [4 X
5456.   (setvar "cmdecho" old_cmd)
      " [8 B8 w( q7 t
5457.   (princ)
      ; m5 Y3 A  A+ N2 |" D% _  q/ e7 i
5458. )
      
5459. 
      
5460. ;;;----------------------------------------------------------------------------
      ' V% R& i, a: `' U- T
5461. 
      
5462. (princ "   DDCHPROP loaded.")
      
5463. (princ)
      
5464. 
      4 N/ O) A: S( Z
5465. ;;;----------------------------------------------------------------------------
      ( }' U  W7 S0 @6 n
5466. 
      
5467. ;--------------------------------ddmodify.lsp----------------------------------
      5 M, i' G6 t% P
5468. ; Next available MSG number is    111
      % q$ F+ P4 M( D6 r! t. R- D' t
5469. ; MODULE_ID DDMODIFY_LSP_
      8 A. j6 j' A* @
5470. ;;;----------------------------------------------------------------------------
      
5471. ;;;    DDMODIFY.LSP
      + V. @( E$ p. v8 F7 X9 o, g3 }, q
5472. ;;;
      
5473. ;;;    Copyright 1997 by Autodesk, Inc.
      0 p0 ?1 m# a2 |/ Y, h' I' U
5474. ;;;
      
5475. ;;;    Permission to use, copy, modify, and distribute this software
      
5476. ;;;    for any purpose and without fee is hereby granted, provided
      " ?9 e9 G, R6 n
5477. ;;;    that the above copyright notice appears in all copies and
      
5478. ;;;    that both that copyright notice and the limited warranty and
      - ]1 Y! o: O1 _) a
5479. ;;;    restricted rights notice below appear in all supporting
      
5480. ;;;    documentation.
      
5481. ;;;
      
5482. ;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
      
5483. ;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
      
5484. ;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
        r0 Y8 a8 p, H8 v( y! }8 L
5485. ;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
      7 F0 v; S' z) H! ]! u2 I! S
5486. ;;;    UNINTERRUPTED OR ERROR FREE.
      
5487. ;;;
      
5488. ;;;    Use, duplication, or disclosure by the U.S. Government is subject to
      
5489. ;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
      , o7 o$ e$ i7 d9 E; B
5490. ;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
      
5491. ;;;    (Rights in Technical Data and Computer Software), as applicable.
      8 n7 D/ L5 U: d" e3 C* m+ x; `
5492. ;;;
      ) Z# s6 g" O$ w& k2 `- \
5493. ;;;.
      ' N) }: K% Q4 z3 q3 O+ T# I4 D
5494. ;;;
      
5495. ;;;----------------------------------------------------------------------------
      2 a2 a2 N* m' ]( X8 w: U* X$ g
5496. ;;;   DESCRIPTION
      5 W* |. b, c! W, x! {
5497. ;;;
      + E6 \( T7 v  I. ^* L8 L4 ^, u2 y
5498. ;;;   This function allows the user to get a listing comparable to the LIST
      
5499. ;;;   command for most objects.  In addition, most object fields in the
      
5500. ;;;   dialogue box are editable.  Points can be specified dynamically by
      
5501. ;;;   temporarily dismissing the dialogue box.  Each object has a unique
      
5502. ;;;   dialogue.
      ) W1 ^% }' V, s( E" \# U
5503. ;;;
      
5504. ;;;   Naming conventions
      , E' Z4 q8 M2 \' V3 C1 c
5505. ;;;   Long function and widget names may use an underscore "_"
      
5506. ;;;   in their names to make them easier to read, long variable
      2 B( m: l' i; Q: I' }/ b
5507. ;;;   names use a dash "-".
      ( r- N( a2 ^) e2 X
5508. ;;;----------------------------------------------------------------------------
      / a1 Z( @( m, w* h7 ]$ M7 v
5509. ;;;----------------------------------------------------------------------------
      
5510. ;;;   Prefixes in command and keyword strings:
      
5511. ;;;      "."  specifies the built-in AutoCAD command in case it has been
      
5512. ;;;           redefined.
      , V5 E& O5 g3 Q$ @, _
5513. ;;;      "_"  denotes an AutoCAD command or keyword in the native language
      
5514. ;;;           version, English.
      . P" n0 S) s$ Y5 G) [9 @  l
5515. ;;;----------------------------------------------------------------------------
      
5516. ;;;
      
5517. ;;; Avoid (gc)s on load to improve load time.
      
5518. ;;;
      
5519. (defun do_alloc (/ old_allod new_alloc)
      & Q* l4 j; s0 V; X" G' e4 ^. `5 N
5520.   (setq old_alloc (alloc 2000) new_alloc (alloc 2000))
      : o/ f4 G  P' ^5 V0 I  Q3 `5 ^( u
5521.   (expand (1+ (/ 17000 new_alloc)))
      
5522.   (alloc old_alloc)
      : A( s8 O, h. F" m
5523. )
      
5524. (do_alloc)
      
5525. (setq do_alloc nil)
      
5526. 
      6 ?6 L% E8 u3 f! A/ o/ k9 o0 r6 p2 f
5527. ;;;
      
5528. ;;;
      
5529. ;;; ===========================================================================
      & _( I, V/ `# w% y
5530. ;;; ===================== load-time error checking ============================
      & P/ z( W6 T, C& E9 |
5531. 
      
5532.   (defun ai_abort (app msg)
      * E( c0 V. y& M5 s) A3 _4 p
5533.      (defun *error* (s)
        B& R: N# ?! ^7 G5 ^7 ^+ a* X2 [
5534.         (if old_error (setq *error* old_error))
      9 S! o2 H' |- u8 U1 q7 m
5535.         (princ)
      , r' t  Z8 {0 R/ H
5536.      )
      
5537.      (if msg
      3 t' e( c* |( d) g1 O
5538.        (alert (strcat " Application error: "
      6 r# G& k# c2 O  s9 l& \. Y" X% Y
5539.                       app
      
5540.                       " \n\n  "
      $ f  u) |) g0 B% x# H4 K$ s
5541.                       msg
      
5542.                       "  \n"
      
5543.               )
      
5544.        )
      
5545.      )
      
5546.      (exit)
      
5547.   )
      
5548. 
      7 [. r/ I* F: q- m: j
5549. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
      , ^0 p5 H2 ~" z$ Z( o& b
5550. ;;; and then try to load it.  If it can't be found or can't be
      
5551. ;;; loaded, then abort the loading of this file immediately.
      
5552. 
      , ]& u% C! h' l( B& l
5553.   (cond
      
5554.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
      
5555. 
      
5556.      (  (not (findfile "ai_utils.lsp"))                     ; find it
      
5557.         (ai_abort "DDMODIFY"
      
5558.                   (strcat "Can't locate file AI_UTILS.LSP."
      % Q( B. P3 H: h7 W* ~2 p/ F
5559.                           "\n Check support directory.")))
      9 o/ q2 B2 d2 [  @% h1 @/ j
5560. 
      1 E5 N' |- U7 Q4 \0 f- Y
5561.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
      
5562.         (ai_abort "DDMODIFY" "Can't load file AI_UTILS.LSP"))
      
5563.   )
      0 g+ P# F8 A& u8 g+ M
5564. 
      / p; ?2 S: O+ i
5565. ;;; If we get this far, then AI_UTILS.LSP is loaded and it can
      , l' o  {  k3 u5 H; ~& ~9 c+ }
5566. ;;; be assumed that all functions defined therein are available.
      
5567. 
      # v" ^1 x; {5 L# Y
5568. ;;; Next, check to see if ACADAPP.EXP has been xloaded, and abort
      
5569. ;;; if the file can't be found or xloaded.  Note that AI_ACADAPP
      
5570. ;;; does not abort the running application itself (so that it can
      
5571. ;;; also be called from within the command without also stopping
      
5572. ;;; an AutoCAD command currently in progress).
      / p! D+ x+ ^. B& g9 o
5573. 
      " W, `% [/ h" {" @
5574.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
      
5575.       (ai_abort "DDMODIFY" nil)        ; a Nil <msg> supresses
      0 k! z8 B: T" s4 B- m* C
5576.   )                                    ; ai_abort's alert box dialog.
      6 A8 f+ {) H: [) f4 f
5577. 
      
5578. ;;; ==================== end load-time operations ===========================
      
5579. 
      & n% _; C. S& t( @1 L
5580. ;;; global variables
      / Z  V$ t" h3 Y" |, b$ ]
5581. 
      * ?+ o9 g4 w3 c4 c
5582. (setq hatch-elist nil)
      + V, M8 c$ k% q3 n4 x0 E9 r
5583. 
      3 z7 w& {8 q7 b1 ?- {  Q) ~0 B" }
5584. ;;; If we get this far, both ai_utils.lsp and acadapp.exp are
      
5585. ;;; assumed to be available.
      ) b' s3 k% Y1 Q$ B' _: I3 P% o; \. l
5586. 
      
5587. ;;; Define and encapsulate all subroutines that are declared
      
5588. ;;; locals of the (ddmodify) function.
      ' N6 v7 N. ]6 p4 Y1 a; P# j
5589. 
      , |( |& _3 p1 u& ~, X' {
5590. (defun ddmodify_init ()
      
5591.   ;;
      
5592.   ;; These three functions modify the enitity list for common properties.  Since
      
5593.   ;; color, ltype, and thickness are absent from the object list when they are
      : J; _4 @0 k/ _3 D" M" z+ F  `
5594.   ;; set to their defaults (i.e. color = bylayer), a simple substitution using
      ' U, K5 ?+ a! j+ q' ]
5595.   ;; SUBST is not possible.
      2 K$ Z3 q2 o# q9 `& T
5596.   ;;
      # F- ^6 K- J( A9 _, S' G
5597.   (defun modify_properties ()
      
5598.     (emod ecolor 62)
      
5599.     (emod eltype 6)
      
5600.     (emod ethickness 39)
      
5601.     (emod eltscale 48)
      / c; N% m, Z# t' o0 \
5602.     (tempmod elayer 8 nil)
      
5603.   )
      4 Y5 X' k' P: m
5604.   ;;
      + r% O% _8 m3 }! t5 T2 F
5605.   ;; This function is used for modifying common properties of the ACIS
      # h1 P$ d( N1 p! `; E
5606.   ;; based geometry objects. Thickness is not valid for these objects
      ' x" B" i8 A) r# ?& g
5607.   ;; so it is left out.
      
5608.   ;;
      ' Q& p/ A2 _2 m. Q& P  v9 z' O
5609.   (defun modify_prop_geom ()
      
5610.     (emod ecolor 62)
      ' f9 Z3 Z9 p% Z, m0 Z3 c
5611.     (emod eltype 6)
      6 B6 w! |7 y0 r0 h# I2 Q
5612.     (emod eltscale 48)
      1 j1 U" ~1 L: X  |( F
5613.     (tempmod elayer 8 nil)
      
5614.   )
      : h/ g  U7 k; o' u) |1 Q
5615. 
      
5616.   (defun emod (value bit)
      
5617.     (if (= bit 62)
      2 j! X. j0 J3 w9 T) t
5618.       (progn
      
5619.         (if (or (= value "BYLAYER")
      
5620.                 (= value "BYLAYER")) (setq value 256))
      
5621.         (if (or (= value "BYBLOCK")
      
5622.                 (= value "BYBLOCK")) (setq value 0))
      ( _% T- ]8 }3 u- a4 `3 D
5623.       )
      2 ?' w$ O+ `; O  c3 \
5624.     )
      
5625.     (if (setq oldlist (cdr (assoc bit elist)))
      
5626.       (tempmod value bit nil)
      + ]2 q, ~1 n4 \
5627.       (setq elist (append elist (list (cons bit value))))
      
5628.     )
      
5629.   )
      6 O( W- B' N# Y8 C7 L1 w2 D
5630.   ;;
      5 g" V% V6 @# I8 Z
5631.   ;; Resets object list to original values.  Called when the dialogue or
      " L- Z4 y2 M8 i( u
5632.   ;; function is cancelled.
      6 X2 C) w# a1 e
5633.   ;;
      / A( I5 W4 C& E  o' O$ q/ Q! b
5634.   (defun reset ()
      
5635.     (setq elist  old-elist
      : R: M% y2 K! W$ h
5636.           ecolor (cdr (assoc 62 old-elist))
      ( {! R, u) t# L) L
5637.           ethickness (cdr (assoc 39 old-elist))
      $ ^8 }6 B2 [0 \1 A) H' p
5638.           eltype (cdr (assoc 6 old-elist))
      
5639.           elayer (cdr (assoc 8 old-elist))
      9 [) ?9 l" |& r& V
5640.           eltscale (cdr (assoc 48 old-elist))
      
5641.     )
      / v1 c# P1 k5 H+ b7 Z: n
5642.     (if (not ecolor) (setq ecolor "BYLAYER"))
      ; N$ L2 Y8 n4 t8 ~5 \- q* P
5643.     (if (not eltype) (setq eltype "BYLAYER"))
      
5644.     (if (not ethickness) (setq ethickness 0))
      2 R3 t" }& a( U: W+ {
5645.     (if (not eltscale) (setq eltscale 1))
      
5646.     (modify_properties)
      1 R9 p, {. Y4 R' }. x
5647.     (setq reset_flag t)
      
5648.     (entmod elist)
        y* K5 T1 @4 Y: Y: n5 D0 I& S+ F
5649.   )
      
5650.   ;;
      + _3 @4 z: B+ s
5651.   ;; Modify object when dialogue is temporarily dismissed to reflect latest
      
5652.   ;; settings of dialogue.  It converts the point from current UCS coordinates to
      1 i7 t! U* k; E' O4 h5 @" o
5653.   ;; the proper object coordinates (world or object).
      
5654.   ;;
      ! a* `6 _0 g$ T* j
5655.   ;; Arguments: value - in current UCS coordinates
      6 u9 j/ O- f! q! e6 \
5656.   ;;            bit   - object code (i.e. 10 for start point)
      
5657.   ;;            ptype - point type  0=world 1=planar
      6 ~$ y: J* ~9 k
5658.   ;;
      
5659.   (defun tempmod (value bit ptype / newpoint)
      
5660.     (cond
      
5661.       ((= ptype 1) (setq value (trans value 1 ename)))
      
5662.       ((= ptype 0) (setq value (trans value 1 0)))
      
5663.     )
      
5664.     (setq elist (subst (cons bit value)
      5 N8 y6 @* H+ C1 `* y" E3 {7 o! C
5665.                        (assoc bit elist)
      
5666.                        elist
      3 l5 P/ l7 f% Y3 }, p  o
5667.                 )
      
5668.     )
      9 R1 m3 `6 u7 V1 I$ U3 Y) J# \* W6 @
5669.   )
      
5670.   ;;
      0 K8 U  i( v. _) A: }- J" c
5671.   ;; The following functions are called after a dialogue has been temporarily
      6 |) v! P% U! j% A& c/ q4 U
5672.   ;; dismissed and the user is selecting a point.  If a point is selected the
      
5673.   ;; object list is modified and new X,Y,Z values set.  If no point is selected
      
5674.   ;; (null response), then the point is reset back to its previous values.
      
5675.   ;;
      $ e! y' Q8 F! m, W7 x
5676.   (defun ver_pt1 (ptype)
      ! d! d  U  S- @5 a! t8 b& T
5677.     (if pt1
      * N) P. F: @+ e/ i) O( Z
5678.       (progn
      
5679.         (tempmod pt1 10 ptype)
      , ]4 B4 `/ c$ K/ P: }' s. _
5680.         (entmod elist)
      - ?. S. F) X1 C5 Q' a  S
5681.       )
      5 U* }# O$ Z8 q- a3 f
5682.       (setq pt1 (list x1 y1 z1))
      
5683.     )
      
5684.   )
      
5685. 
      
5686.   ; (move_pt1 <ptype> )
      1 U2 T; K4 q2 M& T3 q
5687.   ;
      0 F! d. ]) ^8 ^0 K) G- N
5688.   ; Called in liew of (ver_pt1) to translate block insertions which
      
5689.   ; might have variable attributes attached to them.  If the distance
      
5690.   ; the block is to be moved is < 1e-6, the move is deferred.
      
5691. 
      
5692.   (defun move_pt1 (ptype / basept hi)
      
5693.     (setq basept (trans (cdr (assoc 10 (entget ename))) ename 1))
      
5694.     (cond
      
5695.        (  (not pt1)
      ' _' n+ a8 X" G* h
5696.           (setq pt1 (list x1 y1 z1)))
      
5697. 
      
5698.        (  (> 1e-6 (distance pt1 basept)))
      6 N% R; ]: J) e: l6 P, ^
5699. 
      
5700.        (t (tempmod pt1 10 ptype)
      , X. Q, f" G1 d+ U1 r! t' c; K2 R! C
5701.           (setq hi (getvar "highlight"))
      2 ~) l: f" \. `# o/ `
5702.           (setvar "highlight" 0)
      
5703.           (command "._move" ename "" basept pt1)
      
5704.           (setvar "highlight" hi))
      
5705.     )
      
5706.   )
      
5707. 
      
5708.   (defun ver_pt2 (ptype)
        k8 B0 W4 l9 E
5709.     (if pt2
      
5710.       (progn
      
5711.         (tempmod pt2 11 ptype)
      % C: r* {+ f# Y" m* J% ^( D
5712.         (entmod elist)
      
5713.       )
      
5714.       (setq pt2 (list x2 y2 z2))
      
5715.     )
      
5716.   )
      + ~) I6 j" C% R5 P9 \
5717. 
      " L: l7 ^* I9 h) ^3 k4 a) r
5718.   (defun ver_pt3 (ptype)
      . V) k. @" z# u
5719.     (if pt3
      - z! @5 P( C9 Y, g/ J/ U
5720.       (progn
      
5721.         (tempmod pt3 12 ptype)
      
5722.         (entmod elist)
      , V$ C  `, Z! g* U' x
5723.       )
      4 D- g$ _/ ]* R. f* C. r
5724.       (setq pt3 (list x3 y3 z3))
      + d- M; i" p, j% I
5725.     )
      4 H- O* G0 x% w1 l
5726.   )
      
5727. 
      
5728.   (defun ver_pt4 (ptype)
      
5729.     (if pt4
      
5730.       (progn
      5 d% W- n3 y, e5 h2 |! P
5731.         (tempmod pt4 13 ptype)
      5 J- g9 @& z& I
5732.         (entmod elist)
      
5733.       )
      
5734.       (setq pt4 (list x4 y4 z4))
      4 p' ~% @3 p# |
5735.     )
      
5736.   )
      0 k+ w; ^' f' H. l4 A3 h3 b
5737.   ;; Xline/Ray
      : h7 L, v+ I, h' b8 U; p
5738.   (defun ver_xline_pt1()
      6 x2 U- Q* m- p4 V. v5 ]
5739.     (if xline_pt1
      
5740.       (progn
      
5741.         ;; convert to WCS.
      
5742.         (setq value (trans xline_pt1 1 0))
      # o* t! }/ I- z( g* I' b# o
5743.         (setq elist (subst (cons 10 value)
      ; p' c; u* L& w
5744.                           (assoc 10 elist)
      
5745.                            elist
      , X2 J: v' R/ J0 K
5746.                     )
      # S- H+ \- M" q. t' W& q
5747.         )
      
5748.       )
      
5749.       (setq xline_pt1 (list xline_x1 xline_y1 xline_z1))
      
5750.     )
      
5751.   )
      
5752. 
      
5753.   (defun ver_xline_pt2()
      
5754.     (if xline_pt2
      
5755.       (progn
      
5756.     ;;
      
5757.     ;; Calculate new Direction Vector WCS
      & T) O' `- m& o* v, w  M# j
5758.     ;; x / (sqrt ( (x**2) + (y**2) + (z**2)     ))
      - E5 h) w. {" y
5759.     (setq temp_dir (trans xline_pt2 1 0))
      
5760.     (setq temp_dir_x (car temp_dir))
      8 f) R' [  q2 W* K* a. |
5761.     (setq temp_dir_y (cadr temp_dir))
      
5762.     (setq temp_dir_z (caddr temp_dir))
      # D( B; X+ g3 i/ {5 W, a
5763. 
      
5764.     (setq temp_xline_pt1 (trans xline_pt1 1 0))
      ! z; _. Z, ?- _. p; h
5765.     (setq temp_xline_x1 (car temp_xline_pt1))
      7 y1 w8 _# ^  U/ b
5766.     (setq temp_xline_y1 (cadr temp_xline_pt1))
      / d. S  A" o" l) ~$ N% ~
5767.     (setq temp_xline_z1 (caddr temp_xline_pt1))
      4 n0 l1 B8 m3 D5 C
5768. 
      
5769.     (setq denom (sqrt (+ (expt (- temp_dir_x temp_xline_x1) 2)
      5 _  M' s& Y: Z. Q( c, v
5770.                          (expt (- temp_dir_y temp_xline_y1) 2)
      
5771.                          (expt (- temp_dir_z temp_xline_z1) 2)
      ) C+ P* e' _! o3 V% [+ X0 d
5772.     )))
      ) O5 C; M1 h$ }- F8 r6 F( W6 K
5773.     (setq temp_dir_x (/ (- temp_dir_x temp_xline_x1) denom))
      " |5 Z% G; k# @& C; W' i
5774.     (setq temp_dir_y (/ (- temp_dir_y temp_xline_y1) denom))
      9 Z' G% K$ d# Y* ^
5775.     (setq temp_dir_z (/ (- temp_dir_z temp_xline_z1) denom))
      6 u3 T; u2 X  W% I
5776.     (setq elist (subst (cons 11 (list temp_dir_x temp_dir_y temp_dir_z))
      0 H* g1 Q% K( l8 W
5777.                        (assoc 11 elist)
      * m9 J7 p* j' y
5778.                        elist
      
5779.                 )
      0 v( W# c7 p+ Y, x/ n
5780.     )
      4 X1 A' O$ r% Q2 U; D' w
5781.     (entmod elist)
      
5782.         (setq xline_x2 (car xline_pt2))
      
5783.         (setq xline_y2 (cadr xline_pt2))
      
5784.         (setq xline_z2 (caddr xline_pt2))
      # H7 O( l/ a2 F8 T/ y) b
5785. 
      
5786. 
      4 D$ K; H; H/ G& B" f
5787.       )
      
5788.       (setq xline_pt2 (list xline_x2 xline_y2 xline_z2))
      
5789.     )
      . a2 ~) {) S5 @$ U. U
5790.   )
      ! z- k; P: ]2 f' a6 m* d  ]
5791. 
      6 G* K9 o8 K* w0 k, ~# e7 I
5792.   ;;
      
5793.   ;; Common properties for all objects
      % Y- ]) y' V) r+ h, ^3 \  Z3 e
5794.   ;;
      
5795.   (defun set_tile_props ()
      
5796.     (set_tile "error" "")
      5 N! S4 t0 S% \. a7 m# B
5797.     (setcolor)
      $ c6 k7 ?7 F, y+ z3 K% h
5798.     (cond
      # H* q# V- @- ?' w2 R, \
5799.       ((= eltype "BYLAYER")
      - W# K8 R+ u# _
5800.          (set_tile "t_ltype" (bylayer_lt)))
      " b+ z7 ~  _9 V9 q! G% x' j( Q
5801.       ((= eltype "BYBLOCK")
      8 ^% B4 d4 e. T1 h/ n
5802.          (set_tile "t_ltype" "BYBLOCK"))
      3 ~6 G; d  s# T5 x8 _  B
5803.       (T (set_tile "t_ltype" eltype))
      
5804.     )
      " ]: }# p& Y& q9 p
5805.     (set_tile "t_layer" elayer)
      6 n: Z) n  ^% d
5806.     (set_tile "eb_thickness" (ai_rtos ethickness))
      . y& d' h* t' B* P9 Y7 t' R3 h/ X
5807.     (set_tile "eb_ltscale" (ai_rtos eltscale))
      
5808.     (setq which_tiles (ai_common_state etype))
      : P$ l5 s% }3 p. I/ L3 H3 p
5809.     ;; Disable tiles if need be...
      ' R# I' @/ E/ i, Y
5810. 
      
5811.     ;; Layer Button and Text Field
      " K# }; V( w* F- H) Y
5812.     (if (/= 1 (logand 1 which_tiles))
      
5813.       (progn
      : a" M/ ^5 p  G5 P! ^4 A( O
5814.         (mode_tile "t_layer" 1)
      
5815.         (mode_tile "b_name" 1)
      
5816.       )
      
5817.     )
      5 s2 L4 C8 `3 M+ j6 Q" o/ C
5818.     ;; Color Button and Text Field
      
5819.     (if (/= 2 (logand 2 which_tiles))
      
5820.       (progn
      6 `9 f; P' `- P# k4 S' F1 E7 [" h
5821.         (mode_tile "t_color" 1)
      8 A; I. A' l; a, a8 q% J
5822.         (mode_tile "b_color" 1)
      # n! D# U0 s% K3 y# Z  V1 q
5823.         (mode_tile "show_image" 1)
      
5824.       )
      - U- I- l2 L' {  V+ t/ X
5825.     )
      
5826.     ;; Linetype Button and Text Field
      
5827.     (if (/= 4 (logand 4 which_tiles))
      . l: p7 G% S) N5 D4 k
5828.       (progn
      ; Y! J2 k7 d7 N1 b8 @: @& ?
5829.         (mode_tile "t_ltype" 1)
      * k3 e) ~4 n: Q5 q
5830.         (mode_tile "b_line" 1)
      ) l& V8 j8 G4 I6 v3 d; u
5831.       )
      
5832.     )
      
5833.     ;; Linetype Scale Edit Field
        j) s7 h& U- l( }' O
5834.     (if (/= 8 (logand 8 which_tiles))
      8 E; t8 U5 f3 p$ [3 l' ?
5835.       (progn
      
5836.         (mode_tile "eb_ltscale" 1)
      : u# E8 U  ?2 O0 F) `7 I" m
5837.       )
      - i* }  ^7 c+ q- C; }$ R% D' D
5838.     )
      
5839.     ;; Thickness Edit Field.
      . l; P- ~: U; d7 ?0 _2 V7 x: o% Z
5840.     (if (/= 16 (logand 16 which_tiles))
      
5841.       (progn
      
5842.         (mode_tile "eb_thickness" 1)
      
5843.       )
      2 G+ C; ~" ~6 l) ^! @* d
5844.     )
      8 [- X0 \' J1 A3 L+ p5 Y2 Q
5845.   )
      $ G$ u8 q5 ~* p
5846.   ;;
      
5847.   ;; XYZ Point values for all enitites
      
5848.   ;;
      
5849.   (defun set_tile_pt1 (ptype)
      ; i5 {' P4 C! ?$ s3 Z, W: |% M
5850.     (if (= ptype 0)
      # ~; B- W" x0 ~5 s! k( ]+ o
5851.       (setq pt1 (trans (cdr (assoc 10 elist)) 0 1))
      
5852.       (setq pt1 (trans (cdr (assoc 10 elist)) ename 1))
      9 X1 Z7 y( w, e, U( c+ G/ Z8 w3 P
5853.     )
      
5854.     (set_tile "x1_pt" (ai_rtos (setq x1 (car pt1))))
      
5855.     (set_tile "y1_pt" (ai_rtos (setq y1 (cadr pt1))))
        n. `+ T9 u2 S7 _2 b
5856.     (set_tile "z1_pt" (ai_rtos (setq z1 (caddr pt1))))
      
5857.   )
      9 }+ o% d; F9 c) Q. [
5858.   (defun set_tile_pt2 (ptype)
      - j) s2 E  [" G4 e8 N  L7 b
5859.     (if (= ptype 0)
      
5860.       (setq pt2 (trans (cdr (assoc 11 elist)) 0 1))
      , e% R( ^2 S9 @  |
5861.       (setq pt2 (trans (cdr (assoc 11 elist)) ename 1))
      5 ]4 X" |# O  ?4 M9 R' Y; J9 f8 Z, c
5862.     )
      
5863.     (set_tile "x2_pt" (ai_rtos (setq x2 (car pt2))))
      
5864.     (set_tile "y2_pt" (ai_rtos (setq y2 (cadr pt2))))
      
5865.     (set_tile "z2_pt" (ai_rtos (setq z2 (caddr pt2))))
      
5866.   )
      : _( b6 T, a( `0 S% S$ X# B
5867.   (defun set_tile_pt3 (ptype)
      
5868.     (if (= ptype 0)
      
5869.       (setq pt3 (trans (cdr (assoc 12 elist)) 0 1))
      
5870.       (setq pt3 (trans (cdr (assoc 12 elist)) ename 1))
      % g9 z/ U) e  V# K, N, ~
5871.     )
      
5872.     (set_tile "x3_pt" (ai_rtos (setq x3 (car pt3))))
      5 c+ b3 C+ t  }1 a
5873.     (set_tile "y3_pt" (ai_rtos (setq y3 (cadr pt3))))
      ! V, L$ j9 K3 f
5874.     (set_tile "z3_pt" (ai_rtos (setq z3 (caddr pt3))))
      
5875.   )
      
5876.   (defun set_tile_pt4 (ptype)
      
5877.     (if (= ptype 0)
      
5878.       (setq pt4 (trans (cdr (assoc 13 elist)) 0 1))
      
5879.       (setq pt4 (trans (cdr (assoc 13 elist)) ename 1))
      
5880.     )
      
5881.     (set_tile "x4_pt" (ai_rtos (setq x4 (car pt4))))
      7 _; x. q+ n0 W2 [
5882.     (set_tile "y4_pt" (ai_rtos (setq y4 (cadr pt4))))
      - g* {' d" n9 ]& X! t
5883.     (set_tile "z4_pt" (ai_rtos (setq z4 (caddr pt4))))
      
5884.   )
      
5885.   ;;
      ) f& t1 p- Z$ h# T
5886.   ;; Xline/Ray
      7 B/ c3 a9 G* _" K
5887.   ;;
      
5888.   (defun set_tile_xline_pt1 ()
      
5889. 
      
5890.     (setq xline_pt1 (trans (cdr (assoc 10 elist)) 0 1))
      & U1 }. i! ~/ I- X. y* W
5891. 
      
5892.     (set_tile "xline_x1" (ai_rtos (setq xline_x1 (car xline_pt1))))
      : f9 d( b1 b6 m4 y% s0 Z5 E
5893.     (set_tile "xline_y1" (ai_rtos (setq xline_y1 (cadr xline_pt1))))
      
5894.     (set_tile "xline_z1" (ai_rtos (setq xline_z1 (caddr xline_pt1))))
      
5895.   )
      : D) i6 n( `; z- E' ^8 `
5896.   (defun set_tile_dirv ()
      ) u) g' a+ P& j( M
5897.         ;; Convert 11 group to local UCS (displacement)
        w. v  I! E: i6 ~
5898.     (setq dir_pt (trans (cdr (assoc 11 elist)) 0 1 1))
      $ t" |6 G9 G+ p& a/ e
5899. 
      
5900.     (set_tile "dir_x" (rtos (setq dir_ptx (car dir_pt))))
      5 v8 D/ _8 n7 [0 `! b' G2 \4 ]/ E0 w1 @
5901.     (set_tile "dir_y" (rtos (setq dir_pty (cadr dir_pt))))
      - J& F1 A6 q1 M# F4 \. M! y
5902.     (set_tile "dir_z" (rtos (setq dir_ptz (caddr dir_pt))))
      & ~/ c' n4 X& J. Q- b
5903.   )
      # L9 U$ S1 _/ ?& |: S, A: S
5904.   (defun set_tile_xline_pt2 ()
      ; Z: q* D3 G- [" d
5905.     (if (not xline_pt2)
      
5906.       ;; Initial second point is Root Point + Direction Vector
      
5907.       (setq xline_pt2 (mapcar '+ xline_pt1 dir_pt))
      
5908.     )
      $ _) T! t0 |% ]: q2 T
5909.     (set_tile "xline_x2" (ai_rtos (setq xline_x2 (car xline_pt2))))
      5 l2 a9 I; R7 H6 y+ |7 H
5910.     (set_tile "xline_y2" (ai_rtos (setq xline_y2 (cadr xline_pt2))))
      
5911.     (set_tile "xline_z2" (ai_rtos (setq xline_z2 (caddr xline_pt2))))
      
5912.   )
      
5913. 
      
5914.   ;;
      
5915.   ;; Handle for all objects
      
5916.   ;;
      
5917.   (defun set_tile_handle ()
      
5918.     (if (setq hand (cdr (assoc 5 elist)))
      
5919.       (set_tile "Handle" hand)
      6 Y. j' Z: }  t4 A6 |: ]
5920.       (set_tile "Handle" "None")
      ) O% ]1 G$ l2 \: |  w1 P" D
5921.     )
      
5922.   )
      ) f5 f5 h, G8 @; [
5923.   ;;
      " k5 u2 P' t- g) ^
5924.   ;; Radius for ARC and CIRCLE
      
5925.   ;;
      
5926.   (defun set_tile_rad ()
      % b3 L' _) j4 M' d1 b3 m; Y
5927.     (setq radius (cdr (assoc 40 elist)))
      ' x" I6 D6 n* C; ~5 }
5928.     (set_tile "radius" (ai_rtos radius))
      0 h; {* ?' O. y0 f. b1 O9 x# W
5929.   )
      8 U: s) t/ o) U% P* M: E2 i/ g0 A
5930.   ;;
      
5931.   ;; Start angle for ARC
      
5932.   ;;
      ' B+ b; W5 g8 D2 X* y, \, f
5933.   (defun set_tile_stang ()
      2 N. t: e! l+ u0 Z( Z: I
5934.     (setq st_ang (cdr (assoc 50 elist)))
      
5935.     (set_tile "st_ang" (ai_angtos st_ang))
      
5936.   )
      % K' N$ S) r  M8 g2 k6 F
5937.   ;;
      ! }7 H1 E6 T1 T: ]" z' a' S
5938.   ;; End angle for ARC
      
5939.   ;;
      6 {# @5 i+ U. ?8 H% [) y
5940.   (defun set_tile_endang ()
      + r# s  h4 M7 e  c! D
5941.     (setq end_ang (cdr (assoc 51 elist)))
      
5942.     (set_tile "end_ang" (ai_angtos end_ang))
      ) y8 \: B$ J2 |) `# _
5943.   )
      
5944.   ;;
      ; U: ^/ S0 v, `3 U4 ?: v
5945.   ;; Rotation Angle - Text, Attributes, Block insertions and Shapes
      
5946.   ;;
      ( F/ e  R0 u/ Y4 u- i
5947.   (defun set_tile_rot ()
      
5948.     (setq rot (cdr (assoc 50 elist)))
      
5949.     (set_tile "rot" (ai_angtos rot))
      
5950.   )
      7 Y3 J5 U+ x* |7 N
5951.   ;;
      
5952.   ;; Height - Text, Attributes and Shapes
      
5953.   ;;
      6 `! q9 @2 t% H* W2 f- T- r
5954.   (defun set_tile_hght ()
      
5955.     (setq hght (cdr (assoc 40 elist)))
      9 f$ W/ V. j+ k. n4 q
5956.     (set_tile "hght" (ai_rtos hght))
      
5957.   )
      
5958.   ;;
      
5959.   ;; Width Factor - Text, Attributes and Shapes
      - Y. Z( P! X# L4 }4 Q2 t+ O' W
5960.   ;;
      
5961.   (defun set_tile_wid ()
      7 h  I8 x1 n( k, U" \
5962.     (setq wid (cdr (assoc 41 elist)))
      8 e: Z) T7 Z! z* l% N
5963.     (set_tile "wid" (ai_rtos wid))
      
5964.   )
      
5965.   ;;
      
5966.   ;; Obliquing Angle - Text, Attributes and Shapes
      ( @$ i9 v  t- r) K
5967.   ;;
      " {1 J- g$ h# o, [0 H
5968.   (defun set_tile_obl ()
        c  D4 F7 `5 p2 k* e
5969.     (setq obl (cdr (assoc 51 elist)))
      
5970.     (set_tile "obl" (ai_angtos obl))
      
5971.   )
      
5972.   ;;
        h( T% \+ r" R" }# u) S
5973.   ;; Text string
      * g% e" i/ v: n7 l( s. _, \7 n2 w
5974.   ;;
      ) P/ ]* W* v) G, }% ~4 j* |9 ^/ }2 u
5975.   (defun set_tile_text ()
      & `- E, z2 \3 p8 w6 y
5976.     (setq text (cdr (assoc 1 elist)))
      , K$ U) r9 _& K5 i3 D; P* {
5977.     (set_tile "t_string" text)
      0 `# e$ J' |8 I$ T
5978.   )
      
5979.   ;;
      4 e% N5 q$ v) R
5980.   ;; Attribute Tag
      
5981.   ;;
      ; i! f) z& x1 Q9 N7 c! \) r
5982.   (defun set_tile_tag ()
      
5983.     (if (= etype "ATTDEF")
      ( l! F* p" Y" ^2 v& ^. v
5984.       (progn
      
5985.         (setq attag (cdr (assoc 2 elist)))
      / J4 T, Y" A$ w3 o* L
5986.         (set_tile "tag" attag)
      
5987.       )
      5 G% [7 p! }, o7 T2 c- O
5988.     )
      ! F1 S2 a/ e; d" _: A7 W% N
5989.   )
      9 D+ m8 w% z9 W1 B0 [6 F7 x( F
5990.   ;;
      
5991.   ;; Attribute Definition
      
5992.   ;;
      ( F+ U2 E1 P9 q$ B& j/ N
5993.   (defun set_tile_prompt ()
      
5994.     (if (= etype "ATTDEF")
      ( @$ X7 @: L( [5 Z
5995.       (progn
      
5996.         (setq atprompt (cdr (assoc 3 elist)))
      - ~$ Y: @5 d1 X
5997.         (set_tile "prompt" atprompt)
      
5998.       )
      + o) y5 V% i! A5 P
5999.     )
      4 [+ M$ Y6 g' t% X6 F
6000.   )
      1 H7 X# o) A  f5 k! O' A1 ?) v2 F+ c
6001.   ;;
      + f( g4 _+ Y+ X8 d" @3 i
6002.   ;; Justification setting for Attributes and Text.  Initializes
      
6003.   ;; popup list box
      
6004.   ;;
      
6005.   (defun set_tile_just ()
      
6006.     (setq ha (cdr (assoc 72 elist)))  ; horizontal alignment
      
6007.     (setq va (cdr (assoc 73 elist)))  ; vertical alignment
      4 e8 ]' D/ M' L3 n# X
6008.     (setq ha-prev ha)
      
6009.     (if (= etype "ATTDEF")
      $ d  D4 o1 Y$ p( T- D5 r/ u
6010.         (setq va (cdr (assoc 74 elist)))  ; vertical alignment
      4 }6 ]! z6 R; u8 x; g) ^
6011.     )
      & M( Z4 {$ l$ t
6012.     (setq jlist
      
6013.           (list "Left"        "Center"        "Right"
      : p3 z) K$ E& E: @! \% b; o
6014.                 "Aligned"     "Middle"        "Fit"
      . ?! N8 m. p/ Z
6015.                 "Top left"    "Top center"    "Top right"
      ) e" E" m; p# ^# c
6016.                 "Middle left" "Middle center" "Middle right"
      
6017.                 "Bottom left" "Bottom center" "Bottom right"
      + f0 m8 K) ]4 K1 ~& y! A
6018.           )
      & ]6 B  P3 ^, d3 G, L9 u
6019.     )
      7 `8 F7 D( \9 @; s! z7 J
6020.     (start_list "popup_just")
      
6021.     (mapcar 'add_list jlist)
      
6022.     (end_list)
      4 ~+ ~7 g  z& t  I2 x
6023.     (set_just_idx)
      1 v5 N2 F2 E8 r' e2 |- A
6024.     (set_tile "popup_just" (jlist_act just-idx))
      / B0 y4 z  T+ R0 _
6025.   )
      
6026.   ;;
      " }  ]6 Q/ S' Y% g/ U, |$ D$ J
6027.   ;; Style setting for Attributes and Text.  Reads symbol table for popup list
      9 h8 ?- f7 X+ a& y
6028.   ;; box.
      
6029.   ;;
      * y( ^* T4 T( v% s* t) ~0 [) x# u
6030.   (defun set_tile_style (/ sname style-idx tlist)
      / c! {, w6 w1 ]5 j+ L+ C( T6 H" J
6031.     (setq tlist (tblnext "STYLE" T)
      : F6 F8 g. z) {! h' o5 e
6032.           slist nil)
      
6033.     (while tlist
      / W- n) _: q0 V& |" X% V
6034.       (setq sname (cdr (assoc 2 tlist)))
      2 a9 b9 K& |1 `! E% L, S
6035.       (if (and (/= sname "")
      
6036.                (/= (logand 16 (cdr (assoc 70 tlist))) 16))
      
6037.           (setq slist (cons sname slist)))
      ) @$ U. ~; C( y
6038.       (setq tlist (tblnext "STYLE")))
      . b. d1 A4 G- I2 L
6039.     (if (>= (getvar "maxsort") (length slist))
      
6040.         (setq slist (acad_strlsort slist)) ; alphabetize style list
      
6041.       (setq slist (reverse slist)))     ; or reverse it to put it in DB order
      9 x, x( g( P4 i- x
6042. 
      
6043.     (start_list "style")
      , y7 ]5 j: g/ q5 j+ q0 x
6044.     (mapcar 'add_list slist)
      
6045.     (end_list)
      ) H0 ~$ j9 U3 A  |( F* X1 o
6046.     (setq tstyle (cdr (assoc 7 elist)))
      
6047.     (setq style-idx (getindex tstyle slist))
      8 T& x8 z. X8 U
6048.     (set_tile "style" (itoa style-idx))
      2 A, s- I2 k+ n' Q! L+ _
6049.   )
      
6050.   ;;
      : D# Z; ?! Y- `" d* s
6051.   ;; Text and Attribute setting - upside-down, backwards
      
6052.   ;;
      
6053.   (defun set_tile_bk-up ()
      
6054.     (setq bk-up (cdr (assoc 71 elist)))
      
6055.     (if (= (logand bk-up 2) 2)
      9 g- q( ^8 E6 t5 C. k2 g
6056.       (set_tile "bkwd" (itoa (setq bkwd 1)))
      
6057.       (set_tile "bkwd" (itoa (setq bkwd 0)))
        o* p+ g: i/ p$ L% ?: K
6058.     )
      
6059.     (if (= (logand bk-up 4) 4)
      ! }  k! B4 O2 r( O
6060.       (set_tile "upsd" (itoa (setq upsd 1)))
      : N; s6 J0 A/ }" t- C5 R
6061.       (set_tile "upsd" (itoa (setq upsd 0)))
      
6062.     )
        h: v" J1 U" H+ A2 a8 @/ M8 l
6063.   )
      
6064.   ;;
      3 f, n# [& O6 ^4 z  `* @; i
6065.   ;; Attribute setting - invisible, constant, verify, preset
      ( ~( i! A* c4 D7 T. _
6066.   ;;
      
6067.   (defun set_tile_icvp ()
      
6068.     (if (not (setq icvp (cdr (assoc 70 elist))))
      ) B2 ?; {1 `9 S+ U
6069.       (setq icvp 0)
      
6070.     )
      & v+ X9 k  R, m: f
6071.     (if (= (logand icvp 1) 1)
      
6072.       (set_tile "inv" (itoa (setq inv 1)))
      0 s& \! {" U  Y) j5 T+ F
6073.       (set_tile "inv" (itoa (setq inv 0)))
      
6074.     )
      8 t; }3 l" F: R! b1 i! g) ^0 I1 A! [6 j
6075.     (if (= (logand icvp 2) 2)
      # ?+ H4 Q! s3 n+ J
6076.       (set_tile "con" (itoa (setq con 1)))
      
6077.       (set_tile "con" (itoa (setq con 0)))
      
6078.     )
      $ z' n4 ?8 S& s8 |# T& Z2 i0 j
6079.     (if (= (logand icvp 4) 4)
      
6080.       (set_tile "ver" (itoa (setq vfy 1)))
      ( ^' c) \) Z7 Z( m, I- t1 M6 ]. u
6081.       (set_tile "ver" (itoa (setq vfy 0)))
      " j5 L5 k3 n1 j" L
6082.     )
      9 O+ ], K( u' q3 ^* M
6083.     (if (= (logand icvp 8) 8)
      6 t- a, k) ~$ X) k
6084.       (set_tile "pre" (itoa (setq pre 1)))
      1 p( g: c$ `3 ^" f
6085.       (set_tile "pre" (itoa (setq pre 0)))
      ( T' Q1 |; i, x" S7 L
6086.     )
      1 o4 r9 r2 b- B2 O! L; `
6087.   )
      
6088.   ;;
      
6089.   ;; Scale factors for block insertions
      " V6 ]7 I/ i2 d0 @6 y
6090.   ;;
        z2 D4 U% f& w# }  a7 L3 c
6091.   (defun set_tile_scale (/ temp)
      
6092.     (setq temp (getvar "LUNITS"))
      
6093.     (setvar "LUNITS" 2)
      . i5 B" t- L- G) \4 z
6094.     (setq xscale (cdr (assoc 41 elist)))
      
6095.     (set_tile "xscale" (ai_rtos xscale))
      # |7 Z. ^$ `  \
6096.     (setq yscale (cdr (assoc 42 elist)))
      
6097.     (set_tile "yscale" (ai_rtos yscale))
      
6098.     (setq zscale (cdr (assoc 43 elist)))
      * }! ~+ i+ p0 F* }  s* S
6099.     (set_tile "zscale" (ai_rtos zscale))
      3 d( t/ _; _' E( m
6100.     (setvar "LUNITS" temp)
      ; T$ w- E5 f" \$ R" a' E: }9 Z6 P
6101.   )
      
6102.   ;;
      . R5 w8 d: \- b+ p
6103.   ;; Rows and columns for block insertions
      
6104.   ;;
      
6105.   (defun set_tile_rc ()
      ( `; O. u, Q, U* m
6106.     (setq columns (cdr (assoc 70 elist)))
      ) y0 v- `/ S" h$ q6 m' {6 _$ V
6107.     (set_tile "columns" (itoa columns ))
      9 [  w1 P& r$ j9 v: Y4 p" G0 P% l# x
6108.     (setq rows (cdr (assoc 71 elist)))
      3 q9 e: Y( Z  a
6109.     (set_tile "rows" (itoa rows))
      
6110.     (setq col-sp (cdr (assoc 44 elist)))
      1 e% Z) C6 a: \1 u9 R
6111.     (set_tile "col_sp" (ai_rtos col-sp))
      
6112.     (setq row-sp (cdr (assoc 45 elist)))
      - `  d$ l5 ?. z5 _3 T$ v
6113.     (set_tile "row_sp" (ai_rtos row-sp))
      ; @; r* j9 r2 m0 u+ z% u
6114.         (if (/= hasclip T)
      , N. s$ m6 x# Y; Y) ]
6115.                 (mode_tile "xcliponoff" 1)
      8 a! X" V3 k* @. {8 G; E! W
6116.                 (set_tile "xcliponoff" (itoa xcliponoff))
        g! S' |/ n) j/ l
6117.         )
      8 F/ g. m7 G6 A# B- j; m' Q( m
6118.   )
      
6119.   ;;
      & ]* O2 T5 u, r2 D& l' a
6120.   ;; Invisible edges for 3DFACE
      
6121.   ;;
      
6122.   (defun set_tile_edges ()
      
6123.     (setq f-vis (cdr (assoc 70 elist)))
      & i& U$ G  J1 y1 E, v. R3 n5 t; e
6124.     (if (= (logand f-vis 1) 1)
      
6125.       (set_tile "edge_1" (setq edge1 "0"))
      * ]; `3 X+ u; d4 X7 o
6126.       (set_tile "edge_1" (setq edge1 "1"))
      
6127.     )
      / }- O! c9 ?8 _2 t
6128.     (if (= (logand f-vis 2) 2)
      ! _3 v* j8 R. p9 r
6129.       (set_tile "edge_2" (setq edge2 "0"))
      
6130.       (set_tile "edge_2" (setq edge2 "1"))
      . P" ~2 G" X# K- \% Y7 L
6131.     )
      
6132.     (if (= (logand f-vis 4) 4)
      
6133.       (set_tile "edge_3" (setq edge3 "0"))
      + Z( G+ W' i- X& X3 V+ {
6134.       (set_tile "edge_3" (setq edge3 "1"))
      " ]8 Q" l: I9 n0 i8 U& g
6135.     )
      
6136.     (if (= (logand f-vis 8) 8)
      
6137.       (set_tile "edge_4" (setq edge4 "0"))
      
6138.       (set_tile "edge_4" (setq edge4 "1"))
      
6139.     )
      ; Z8 G  B! X! [  r! _. |
6140.   )
      8 [# ]0 M/ d5 t" E5 @
6141.   ;;
      
6142.   ;; XYZ Point values for polyline vertex
      
6143.   ;;
      
6144.   (defun set_tile_vpt (ptype)
      
6145.     (if (= (cdr (assoc 0 vlist)) "LWPOLYLINE")
      
6146.         (progn
      
6147.             ;; ctr is 1 based, vertices are zero based.
      
6148.             (setq vpt (cdr (getLwVert (- ctr 1))))
      ( P2 s' P0 P1 G6 M
6149.             (set_tile "xtext" (rtos (setq x1 (car vpt))))
      
6150.             (set_tile "ytext" (rtos (setq y1 (cadr vpt))))
      
6151.             (set_tile "ztext" (rtos (setq z1 (caddr vpt))))
      
6152.         )
      , N0 q5 I7 p8 t, Q4 j
6153.         (progn
      
6154.             (if (= ptype 0)
      
6155.                 (setq vpt (trans (cdr (assoc 10 vlist)) 0 1))
      
6156.                 (setq vpt (trans (cdr (assoc 10 vlist)) ename 1))
      0 y. E$ @9 A: A- N
6157.             )
      
6158. 
      
6159.             (set_tile "xtext" (rtos (setq x1 (car vpt))))
      % B6 P) L' N9 Q9 D+ c1 }
6160.             (set_tile "ytext" (rtos (setq y1 (cadr vpt))))
      / W. K! f8 p% G: K3 w* @0 I
6161.             (set_tile "ztext" (rtos (setq z1 (caddr vpt))))
      
6162.         )
      
6163.     )
      4 c. W0 _" b: W: I8 L- J7 \1 g) Z3 p
6164. 
      
6165.   )
      
6166.   ;; This is the equivalent to doing an entnext on the heavy weight
      
6167.   ;; polylines. The hard coded '4' below allow stepping over the
        b7 s3 d1 M0 c0 r6 F2 p
6168.   ;; 40 41 and 42 group code information. The while loop finds the
      
6169.   ;; first vertex which will be used as the starting assoc in the
      9 u* X  P1 N$ b  Q, k% a
6170.   ;; call to nth.
      
6171.   ;;
      . H0 L( [6 D# {5 [
6172.   (defun getLwVert (tmpctr / count tmp)
      
6173.     (setq count 0)
      
6174.     (while (/= (car (nth count vlist)) 10)
      8 X6 S* t9 {; {9 E2 \
6175.         (setq count (+ count 1))
      
6176.     )
      
6177.     ;; If the counter reaches the number of vertices,
      
6178.     ;; reset ctr and tmpctr to zero again.
      $ U6 R8 m8 g4 R7 Y
6179.     (if (= tmpctr (cdr (assoc 90 vlist)))
      : s1 @6 a, ~; [& s1 x
6180.         (progn
      - G/ `, r6 a+ F- {9 J& l6 k2 Z/ {
6181.         (setq ctr 0)
      
6182.         (setq tmpctr 0)
      9 e& }- `- E1 n: \0 m3 W
6183.         )
      # F2 d) E) b3 \+ b+ a6 `% D' O) D; C; R
6184.     )
      3 e2 c( ]) ^0 u+ l& z/ D7 J/ W
6185.     (setq tmp (nth (+ count (* tmpctr 4)) vlist))
      
6186.     (setq tmp (append tmp (list(cdr (assoc 38 vlist)))))
      9 E2 d8 ^: R# S# L1 V( z* @
6187.     (setq pt1 (trans (cdr tmp) (cdr (assoc -1 vlist)) 1))
      : C: \5 i7 u6 S
6188.     (setq tmp (cons 10 pt1))
      / a( F. J! ~9 C1 O5 d
6189.     (setq tmp tmp)
      " e' Y3 j/ o3 V+ h
6190.   )
      6 e4 w$ Y6 O5 J1 D" a
6191.   ;;
      
6192.   ;; Set tiles for Spline properties. If the spline is rational then we
        ^8 {' |( p& @: G* L
6193.   ;; need to display the weight values of the control points, so set
      
6194.   ;; flag to 1.
      
6195.   ;; 1 = rational spline
      
6196.   ;; 0 = non-rational spline
      2 ]4 e1 E. [' r% ~
6197.   ;;
      / S  h4 z/ Q' j& Z
6198.   (defun set_tile_spline_props ()
      3 K" X2 I0 P+ W$ o
6199.     (setq rational_spl_flag 0)      ;; initialize rational spline flag
      3 I, t4 Y: A# l
6200.     (set_tile "Degree" (itoa (cdr (assoc 71 elist))))
      9 y6 j- x2 k& V1 o+ L# H# c/ b9 A
6201.     (setq bit70 (cdr (assoc 70 elist)))
      
6202.     (if (= (logand bit70 1) 1)
      
6203.         (set_tile "SpProp4" "Closed")
      + ]; y9 T' Z7 r  r% h
6204.         (set_tile "SpProp4" "      ")
      
6205.     )
      
6206.     (if (= (logand bit70 2) 2)
      - m( E8 @* {2 G; k9 d2 [
6207.         (set_tile "SpProp3" "Periodic")
      
6208.         (set_tile "SpProp3" "Non-Periodic")
      
6209.     )
      
6210.     (if (= (logand bit70 4) 4)
      
6211.       (progn
      5 |) `+ `2 W* Z0 L2 j1 Z
6212.         (set_tile "SpProp2" "Rational")
      
6213.         (setq rational_spl_flag 1)      ;; this is a rational spline
      $ u& y$ g/ u( m8 R
6214.       )
      ( H" @0 U6 k5 _* _; K5 T% j
6215.         (set_tile "SpProp2" "Non-Rational")
      9 B* L5 f6 W) i
6216.     )
      $ @" F6 c$ J2 U9 p4 i
6217.     (if (= (logand bit70 8) 8)
      
6218.         (set_tile "SpProp1" "Planar")
      
6219.         (set_tile "SpProp1" "Non-Planar")
      5 W- u: y" g- Y9 X: A4 S
6220.     )
      
6221.     (if (= (logand bit70 16) 16)
      
6222.         (set_tile "SpProp5" "Linear")
      
6223.         (set_tile "SpProp5" "      ")
      
6224.     )
      ! s) u8 h3 E; ^# h* T
6225.   )
      , p4 p5 w  a) T9 G5 v7 M
6226.   ;;
      
6227.   ;; XYZ Point values for spline points
      
6228.   ;; Need to account for WCS/UCS
      
6229.   ;;
      # T: T/ a- l1 p  |( G
6230.   (defun set_tile_cntl_pt ()
      
6231.     (setq cntl-pt (cdr (assoc 10  elist)))
      
6232.     (set_tile "xtext" (rtos (setq x1 (car cntl-pt))))
      
6233.     (set_tile "ytext" (rtos (setq y1 (cadr cntl-pt))))
      / t$ b& e; C$ F
6234.     (set_tile "ztext" (rtos (setq z1 (caddr cntl-pt))))
      
6235.     (if (= rational_spl_flag 1)      ;; if rational spline
      . [" ^( n# ]9 Q5 C
6236.       (progn                         ;; show weight
      1 Q% y. |4 @/ B! F! ^% _
6237.         (setq weight (cdr (assoc 41 elist)))
      ; a; r# x+ @4 L# u5 I6 M, C4 C
6238.         (set_tile "weight" (rtos weight))
      
6239.       )                              ;; else
      6 W( G6 w) f# w
6240.         (mode_tile "weight_text" 1)  ;; disable weight field
      
6241.     )
      
6242.   )
      
6243.   ;;
      6 \1 t, F$ l2 e) [1 f, k
6244.   ;; XYZ Point values for spline points
      ; I" [2 p, t2 g
6245.   ;; Need to account for WCS/UCS
      
6246.   ;;
      " t# S( R+ l6 [$ J& M. Q+ O" ^
6247.   (defun set_tile_data_pt ()
      
6248.     (if (not (assoc 11 elist))
      
6249.       (mode_tile "data_pts" 1)
      + C5 c* X; R( W/ ]* z9 U
6250.       (progn
      - }) F7 |, i$ d/ h
6251.          (setq data-pt (cdr (assoc 11  elist)))
      0 z+ [8 H' y( j# Y  Z3 v9 V
6252.          ;; display points with current precision.
      
6253.          (set_tile "dxtext" (rtos (setq x1 (car data-pt))))
      
6254.          (set_tile "dytext" (rtos (setq y1 (cadr data-pt))))
      
6255.          (set_tile "dztext" (rtos (setq z1 (caddr data-pt))))
      9 v" }, z/ w8 D9 Q
6256.       )
      $ L7 ^% @# h, b  G) o/ n4 Y
6257.     )
      7 L0 R6 F# T# ]0 ]. T% n" ^
6258.   )
      
6259.   ;;
      
6260.   ;; Fit curve, fit spline, or smooth spline surface setting
      " B/ Z; @; S2 ~5 k7 `% W, S
6261.   ;;
      
6262.   (defun set_tile_fitsmooth ()
      
6263.     (cond
      
6264.       ((= (cdr (assoc 0 elist)) "LWPOLYLINE")
      
6265.         (set_tile "none" "1")
      9 W  W$ C9 W: u/ {7 S: c
6266.       )
      # s0 o# I! k% q- l. H
6267.       ((= (logand bit70 4) 4)
      7 b( x" V9 P/ N3 Z9 ?2 D) d& _: y- b
6268.        (cond
      
6269.          ((= bit75 0)
      0 R! F% j- Y2 _! p) r0 o
6270.            (set_tile "none" "1")
      # I: U4 o6 _3 l7 G; O
6271.            (setq spltype 0)
      
6272.          )
      0 t* D2 o0 j! v0 A5 t: T
6273.          ((= bit75 5)
      
6274.            (set_tile "quad" "1")
      
6275.            (setq spltype 5)
      
6276.          )
      
6277.          ((= bit75 6)
      
6278.            (set_tile "cubic" "1")
      
6279.            (setq spltype 6)
      - x9 s/ B2 u/ b3 ^; ~: t4 ?9 `: t
6280.          )
      
6281.          ((= bit75 8)
      . ?" Y8 S* C& A( g. _0 c
6282.            (set_tile "bezier" "1")
      , S3 I4 H4 d7 `3 x! d6 J' X, M
6283.            (setq spltype 8)
      
6284.          )
      0 b0 A" |. B( E8 I/ v
6285.        )
      - p0 b0 e9 Q2 G2 A* {4 X1 P8 O
6286.       )
      2 @) [3 O" ?! I9 l$ c3 U
6287.       ((= (logand bit70 2) 2)
      
6288.         (set_tile "fit" "1")
      
6289.         (setq spltype 1)
      
6290.       )
      
6291.       (T (set_tile "none" "1"))
      
6292.     )
      
6293.   )
      6 }7 P8 Z% o' W" L; a4 n
6294.   ;;
      : M' s- s4 J0 a: g
6295.   ;; Closed or Open mesh and polyline setting
      5 E6 N1 X! V% Z7 Y* b  I# D, h
6296.   ;;
      
6297.   (defun set_tile_closed ()
      . P; p9 @0 o" N
6298.       (if (= pltype "3D mesh")
      : @+ ]: p9 l( J& G5 j$ t
6299.         (progn
      ' C( s- k0 b2 T7 D/ C$ C! M
6300.           (if (= (logand bit70 32) 32)
      ; _/ g. W" e3 A
6301.             (set_tile "closedn" (setq closedn "1"))
      6 N8 v6 Q6 @- E: @8 G5 M( O
6302.             (set_tile "closedn" (setq closedn "0"))
      8 H" M% Y0 z9 h0 ~1 @5 X$ D
6303.           )
      % r/ f2 e. V7 Y, t% t) x6 D
6304.           (if (= (logand bit70 1) 1)
      . d* F7 U: l1 _/ ?9 h% O& N
6305.             (set_tile "closedm" (setq closed "1"))
      
6306.             (set_tile "closedm" (setq closed "0"))
      2 t4 W+ W( v/ Z/ r- m& x
6307.           )
      9 Z: H6 @4 c/ r$ E  R
6308.           (setq old-closedm closedm old-closedn closedn)
      
6309.         )
      
6310.       )
      
6311.       (if (or (= pltype "2D polyline")
      
6312.               (= pltype "3D polyline")
      
6313.           )
      
6314.         (progn
      
6315.           (if (= (logand bit70 1) 1)
      0 k  U$ ~; R! G5 y0 y3 K$ ~0 S
6316.             (set_tile "closed" (setq closed "1"))
      
6317.             (set_tile "closed" (setq closed "0"))
      
6318.           )
      1 h% B+ }4 \' _0 N! m7 B, c1 d: f
6319.           (setq old-closed closed)
      ) w: a* F$ L' O9 \
6320.         )
      1 J0 V% Q, }* j: O' x& S
6321.       )
      
6322.   )
      1 }, E; u( t% `0 Z& C, O1 N
6323.   ;; Set common action tiles
      
6324.   ;;
      
6325.   ;; Defines action to be taken when pressing various widgets.  It is called
      
6326.   ;; for every object dialogue.  Not all widgets exist for each object dialogue,
      : B" ~6 j; k! @$ u
6327.   ;; but defining an action for a non-existent widget does no harm.
      
6328.   (defun set_action_tiles ()
      % s* \; A7 _& U) C- X
6329.     (action_tile "cancel"       "(dismiss_dialog 0)")
      
6330.     (action_tile "accept"       "(dismiss_dialog 1)")
      * g; S( s' M; ~$ r' R! i
6331.     (action_tile "help"         "(help \"\" help_entry)")
      ' i$ m4 O+ H3 }0 n  t) [3 _5 R
6332.     (action_tile "b_color"      "(getcolor)")
      6 L; N" }( h  k2 [# M, |0 r6 T3 L' R* k
6333.     (action_tile "show_image"   "(getcolor)")
      
6334.     (action_tile "b_name"       "(setq elayer (getlayer))")
      
6335.     (action_tile "b_line"       "(setq eltype (getltype))")
      - A4 e$ ^3 B( V5 p5 I0 z, j  t+ \
6336.     (action_tile "eb_thickness" "(getthickness $value)")
      
6337.     (action_tile "eb_ltscale"   "(getltscale $value)")
      
6338. 
      2 q! @# A& d/ d/ L
6339.     (action_tile "pick_1"       "(dismiss_dialog 3)")
      5 |9 j) Q& T8 C
6340.     (action_tile "pick_2"       "(dismiss_dialog 4)")
      $ l! q; Q" s& ~. _
6341.     (action_tile "pick_3"       "(dismiss_dialog 5)")
      
6342.     (action_tile "pick_4"       "(dismiss_dialog 6)")
      
6343.     (action_tile "x1_pt"        "(ver_x1 $value)")
      5 B  v3 E4 w$ h6 Q/ C
6344.     (action_tile "y1_pt"        "(ver_y1 $value)")
      ! g( g2 J, b) V. t0 ~/ C; p- ^
6345.     (action_tile "z1_pt"        "(ver_z1 $value)")
      ( F" M. ~; n6 L: p
6346.     (action_tile "x2_pt"        "(ver_x2 $value)")
      - _& x7 d1 G* r/ n
6347.     (action_tile "y2_pt"        "(ver_y2 $value)")
      
6348.     (action_tile "z2_pt"        "(ver_z2 $value)")
      
6349.     (action_tile "x3_pt"        "(ver_x3 $value)")
      $ @, e' U. Z7 ~5 K
6350.     (action_tile "y3_pt"        "(ver_y3 $value)")
      
6351.     (action_tile "z3_pt"        "(ver_z3 $value)")
      3 q! ?8 }  J. V/ A% ~! D8 j- C8 C
6352.     (action_tile "x4_pt"        "(ver_x4 $value)")
      7 m1 w% k" _  H- U  s
6353.     (action_tile "y4_pt"        "(ver_y4 $value)")
      ' R  Q3 p( T+ ^! P8 b
6354.     (action_tile "z4_pt"        "(ver_4 $value)")
      0 w  Q. U& l$ s  r* l& |, J
6355. 
      , O% P1 \9 F1 a4 B! h; @+ Q8 J
6356.     ;; Action tiles for Xline & Ray
      , N- q- P, m" m9 W2 g" c) x$ A
6357.     (action_tile "xline_x1" "(ver_xline_x1 $value)")
      
6358.     (action_tile "xline_y1" "(ver_xline_y1 $value)")
      
6359.     (action_tile "xline_z1" "(ver_xline_z1 $value)")
      + {; X7 o1 Q  i# g$ m3 Y! O1 `
6360.     (action_tile "xline_x2" "(ver_xline_x2 $value)")
        A& m: B6 R+ e8 ?0 g4 l3 @
6361.     (action_tile "xline_y2" "(ver_xline_y2 $value)")
      
6362.     (action_tile "xline_z2" "(ver_xline_z2 $value)")
      & z4 {' d* ^5 a2 Z5 P
6363. 
      
6364.     (action_tile "edge_1"       "(setq edge1 $value)")
      
6365.     (action_tile "edge_2"       "(setq edge2 $value)")
      * g1 r' a% F5 {. Z5 ^, b# J
6366.     (action_tile "edge_3"       "(setq edge3 $value)")
      
6367.     (action_tile "edge_4"       "(setq edge4 $value)")
      
6368. 
      
6369.     (action_tile "radius"       "(ver_rad $value)")
      3 u( l: f0 ^* L. P' y  v( D
6370.     (action_tile "st_ang"       "(ver_ang1 $value)")
      
6371.     (action_tile "end_ang"      "(ver_ang2 $value)")
      
6372.     (action_tile "end_eang"     "(ver_eang $value)")
      
6373.     (action_tile "minrad"       "(ver_minrad $value)")
      & O- r1 f  P6 D. W( }5 r4 t
6374.     (action_tile "majrad"       "(ver_majrad $value)")
      
6375. 
      5 x" [; X* c$ D  c2 @4 J
6376.     (action_tile "xscale"       "(ver_xscl $value)")
      ( B3 F& Q& q. P: i* m) V. g9 ?
6377.     (action_tile "yscale"       "(ver_yscl $value)")
      : M8 `8 t' K9 W( H2 o* p( i7 G( x& C
6378.     (action_tile "zscale"       "(ver_zscl $value)")
      
6379.     (action_tile "rot"          "(ver_rot $value)")
      / F) [" S* }& V; O* n* i" p
6380.     (action_tile "columns"      "(ver_col $value)")
      5 P4 i4 D. u. @3 |1 Z( l2 p
6381.     (action_tile "rows"         "(ver_row $value)")
      
6382.     (action_tile "col_sp"       "(ver_colsp $value)")
      
6383.     (action_tile "row_sp"       "(ver_rowsp $value)")
      
6384. 
      4 L1 h+ F: Q! i' t4 ^% s
6385.     (action_tile "hght"         "(ver_hght $value)")
      2 D  B4 s7 }& Y' ^/ Y. x
6386.     (action_tile "wid"          "(ver_wid $value)")
      2 I& L- Y( Q' f2 p# L
6387.     (action_tile "obl"          "(ver_obl $value)")
      / \3 M  v, @0 `, G- I$ ]8 o
6388.     (action_tile "style"        "(style_act $value)")
      
6389. 
      
6390.     (action_tile "t_string"     "(ddgettext)")
      - T6 H8 a' C. v$ p: p8 m3 H* e; l
6391.     (action_tile "tag"          "(ver_tag)")
      ( C4 G$ d* s: I
6392.     (action_tile "prompt"       "(ddgetprompt)")
      $ a8 j7 A) u4 v) h' o
6393.     (action_tile "bkwd"         "(setq bkwd (atoi $value))")
      
6394.     (action_tile "upsd"         "(setq upsd (atoi $value))")
      
6395.     (action_tile "inv"          "(setq inv (atoi $value))")
        C) c& g3 g  U' A6 I
6396.     (action_tile "con"          "(setq con (atoi $value))")
      . w8 A3 {4 o  B2 W8 C) _3 \9 N, ~
6397.     (action_tile "ver"          "(setq vfy (atoi $value))")
      
6398.     (action_tile "pre"          "(setq pre (atoi $value))")
      
6399.     (action_tile "popup_just"   "(jlist_act $value)")
      
6400. 
      
6401.     (action_tile "closed"       "(setq closed $value)")
      " ^! g% q* o, c3 }
6402.     (action_tile "ltgen"        "(setq ltgen $value)")
      2 n5 x, Q1 g5 Z1 n& ^$ T
6403.     (action_tile "closedm"      "(setq closedm $value)")
      
6404.     (action_tile "closedn"      "(setq closedn $value)")
      
6405.     (action_tile "next_v"       "(next_vertex)")
      
6406.     (action_tile "xcliponoff"   "(setq xcliponoff $value)")
      
6407. 
      ) T/ P( B# {% k
6408.     (action_tile "next_cntlpt"  "(next_cntl_pt)")
      ! y; `, Y/ e! C& c( q
6409.     (action_tile "next_datapt"  "(next_data_pt)")
      
6410. 
      
6411.     (action_tile "none"         "(if (radio_gaga \"none\")(set_uv 0))")
      
6412.     (action_tile "fit"          "(if (radio_gaga \"fit\")(set_uv 1))")
      
6413.     (action_tile "quad"         "(if (radio_gaga \"quad\")(set_uv 5))")
      : m1 g3 g1 e# n7 v) \: o
6414.     (action_tile "cubic"        "(if (radio_gaga \"cubic\")(set_uv 6))")
      
6415.     (action_tile "bezier"       "(if (radio_gaga \"bezier\")(set_uv 8))")
      ! P# B" b- S; s+ h
6416. 
      
6417.     (action_tile "u"            "(ver_u $value)")
      
6418.     (action_tile "v"            "(ver_v $value)")
      
6419.   )
      0 }6 N: t( W9 G- f# D9 |
6420. 
      
6421.   (defun ddgettext()
      ) R' _) G2 m/ c" Y/ s, l7 ~- s
6422.     (setq text (get_tile "t_string"))
      
6423.   )
      3 P; _8 t) Q* i
6424. 
      
6425.   (defun ddgetprompt()
      
6426.     (setq atprompt (get_tile "prompt"))
      : c/ V* z; r7 K2 [
6427.   )
      
6428. 
      % y) U/ ^* C8 Z" W* C
6429.   ;; As OW doesn't support disabling of individual radio buttons within
      + D3 l" c. [% V' r
6430.   ;; clusters, a check must be performed as to the legitimacy of the
      
6431.   ;; button pushed and reset if necessary.
      
6432.   (defun radio_gaga (pushed)
      
6433.     (cond
      
6434.       ((and (= pltype "3D polyline")
      # y7 R! ]  \# ]5 E' O  o
6435.             (or (= pushed "fit")
      8 \5 u) W( u  X0 O2 T1 |
6436.                 (= pushed "bezier")
      
6437.             )
      & R$ G& _( \  j' m
6438.        )
      
6439.         (set_tile "none" "1")
      
6440.         nil
      
6441.       )
      
6442.       ((and (= pltype "3D mesh")
      ( I7 C+ R# _6 G$ R
6443.             (= "fit" pushed)
      
6444.        )
      3 W5 c' L: u6 g! C
6445.         (set_tile "none" "1")
      + o5 {$ W" o' r
6446.         nil
      2 B! G% z" k3 f9 R. t- E
6447.       )
      , q8 v4 j9 }" V4 Y- C  p1 H2 B6 I
6448.       ((= pltype "Polyface mesh")
      
6449.         (set_tile "none" "1")
      + ~3 b: ?/ }! ~3 V
6450.         nil
      $ u+ @( [) v' P* a: a3 _
6451.       )
      ! F  H* L. y$ p, R6 V& Z" c) v& Z
6452.       ((and (= pltype "2D polyline")
      
6453.             (= "bezier" pushed)
      % c7 H* n/ Q* y' b3 @2 k0 n
6454.        )
      % X5 j6 W, y+ x' H
6455.         (set_tile "none" "1")
      
6456.         nil
      ' u8 h. a# T5 z1 m
6457.       )
      
6458.       (T)
      " [' C% o: D1 D( P# X) b
6459.     )
      % X9 p1 M( x" q7 L( H1 y+ b. `- o
6460.   )
      
6461.   ;;
      
6462.   (defun set_uv (type_n)
      + w$ {* j- Y" a; v6 Y! z
6463.     (setq spltype type_n)
      7 M& o2 Z: {, D) x) ~: `
6464.     (if (= pltype "3D mesh")
      % P- J0 y* G& I2 ^
6465.       (if (= spltype 0)
      
6466.         (progn
      # a) ?5 D( S* j6 ?6 U
6467.           (set_tile "u" (itoa (setq u 0)))
      
6468.           (set_tile "v" (itoa (setq v 0)))
      : v- B' R% g, m  t! u
6469.         )
      1 z4 Z- c7 |* s4 d- O# d
6470.         (progn
      
6471.           (if (= u 0)
      9 p) x+ Y1 `5 t/ r
6472.             (set_tile "u" (itoa (setq u (getvar "surfu"))))
      9 j6 i. P1 ^& _8 t2 ~, ]  Z  C
6473.           )
      
6474.           (if (= v 0)
      & b4 Y% H: j9 L; Q% {2 M
6475.             (set_tile "v" (itoa (setq v (getvar "surfv"))))
      8 S. [+ B( P1 D. M
6476.           )
      
6477.         )
      2 j  [$ f3 q2 h, }& `" }. ~  m8 F
6478.       )
      
6479.     )
      , A* M+ X% Z; |# c) ^
6480.   )
      ( o' {$ z: S2 `3 o) T, v
6481. 
      
6482. 
      ' ^2 a+ h, Z5 V% t* `. ?
6483.   ;;
      2 ?$ x7 n, p; `' K: \% {/ J; ?
6484.   ;; Verification functions
      ( e& i9 @3 `+ i! o, ?
6485.   ;;
      
6486.   ;; Verify distance function.  This takes a new X, Y, or Z coordinate or
      
6487.   ;; distance value, the tile name, and the previous value as arguments.
      4 {5 e- P0 J9 L+ p- n+ T
6488.   ;; If the distance is valid, it returns the distance and resets the tile.
      / _+ ]' o+ W& j# t* H# \" R) ~2 W
6489.   ;; Otherwise, it returns the previous value, sets the error tile and keeps
      # L) M' f( s5 Z' {6 a
6490.   ;; focus on the tile.  Shifting focus to the tile with invalid value can
      , ?  u; a8 }7 _* C0 k
6491.   ;; trigger a callback from another tile whose value is valid.  In order
      7 p# ?* h. O& G
6492.   ;; to keep the error message from being cleared by this secondary callback,
      
6493.   ;; the variable errchk is set and checked.  The last-tile variable is set
      ; ~2 u% e# ?2 g- d7 e
6494.   ;; and checked to ensure the error message is properly cleared when the
      . A/ P% }0 O* ~! B# [
6495.   ;; user corrects the value and hits return.
      / J( Q( J; n, e: n% l* E" T' h
6496.   ;;
      9 C3 O" {0 l' [$ T7 }' R' }
6497.   (defun verify_d (tile value old-value / coord valid errmsg)
      , V3 o! ]* A- |( c" Z
6498.     (setq valid nil errmsg "Invalid input value.")
      ) z$ o0 U, F( f) v. v  {3 L/ Q
6499.     (if (setq coord (distof value))
      
6500.       (progn
      ) N2 f4 t4 v8 F8 A8 a
6501.         (cond
      7 J) c1 S# d" ~3 j5 V5 W
6502.           ((or (= tile "radius")
      
6503.                (= tile "hght")
      
6504.                (= tile "wid")
      5 @7 \' y2 ]* W( a6 {: G& m
6505.                (= tile "majrad")
      
6506.                (= tile "minrad")
      
6507.                (= tile "eb_ltscale")
      . x: ?; Z+ T4 K! e" f8 A% f
6508.            )
      / w. q/ }/ t# I( [4 ]% e) k
6509.            (if (> coord 0)
      
6510.              (setq valid T)
      0 t  E' U. O+ L! g1 Y) O
6511.              (setq errmsg "Value must be positive and nonzero.")
      
6512.            )
      
6513.           )
      # a6 L8 k, E7 Q  y8 ~( D+ [
6514.           ((or (= tile "xscale")
      2 G' E" C1 m( L- Y& g( M
6515.                (= tile "yscale")
      # w/ v5 g8 D- W
6516.                (= tile "zscale")
      
6517.            )
      ' _# U; [3 E" @) b+ M0 k9 d; n
6518.            (if (/= coord 0)
      & c8 ^* H% _8 |
6519.              (setq valid T)
      
6520.              (setq errmsg "Value must be nonzero.")
      2 L( q: {+ E1 E, s% W) @% e4 G
6521.            )
      
6522.           )
      / J  W! r5 m) B8 R+ {
6523.           (T (setq valid T))
      
6524.         )
      7 P% }8 A9 t3 H  Z9 k6 g' @
6525.       )
      
6526.       (setq valid nil)
      
6527.     )
      
6528.     (if valid
      . G) M4 e( m# k$ g2 L. C
6529.       (progn
      
6530.         (if (or (= errchk 0) (= tile last-tile))
      
6531.           (set_tile "error" "")
      7 l/ J& U3 G8 g" O
6532.         )
      
6533.         (set_tile tile (ai_rtos coord))
      2 O$ X: s9 `8 ~* w9 a
6534.         (setq errchk 0)
      6 K/ ]1 M1 q- k$ v
6535.         (setq last-tile tile)
      
6536.         coord
      
6537.       )
      
6538.       (progn
      
6539.         (mode_tile tile 2)            ; Move focus to offending field
      
6540.         (mode_tile tile 3)            ; Select offending text
      3 _5 c2 U# k9 {6 Q& L9 s
6541.         (set_tile "error" errmsg)
      
6542.         (setq errchk 1)
      + ^) S* @/ B/ m" g/ H0 D, J0 |
6543.         (setq last-tile tile)
      
6544.         old-value
      
6545.       )
      9 C2 a1 G. ^$ e9 l  r% [. I
6546.     )
      & p( O- B) N, A2 O
6547.   )
        O2 b. A9 R$ ?# h
6548.   ;; Function for Xline coord edit box checking.
      
6549.   (defun verify_xline (tile value old-value / coord valid errmsg)
      
6550.     (setq valid nil errmsg "Invalid input value.")
      
6551.     (if (setq coord (distof value))
      
6552.       (setq valid T)
      0 y- U/ L" L3 [
6553.       (setq valid nil)
      
6554.     )
      " @% o5 T7 ]0 t; e* }/ a' G9 k6 P! {
6555.     (if (and coord
      " S8 {% t. ^( Z3 Q* _7 w8 N2 F
6556.           (and (= (atof (get_tile "xline_x1")) (atof (get_tile "xline_x2")) )
      2 |- b/ [. A! p) z) n( N$ q9 b
6557.                (= (atof (get_tile "xline_y1")) (atof (get_tile "xline_y2")) )
      
6558.                (= (atof (get_tile "xline_z1")) (atof (get_tile "xline_z2")) )
      
6559.           )
      2 w" Y% h% L6 E/ N3 Z
6560.         )
      : I! h% c& t, ]5 X# A) l4 T, k
6561.        (progn
      
6562.          (setq errmsg
      ! L, R! C2 A% ^' r+ z
6563.                   "The Root point and the Second point cannot be equal.")
      2 f# F5 Y+ @- D/ t7 T
6564.          (setq valid nil)
      
6565.        )
        R( k  ~6 L" i/ Q$ N3 J* u
6566.     )
      
6567.     (if valid
      
6568.       (progn
      6 Q0 a% h; B( l+ N# A& u
6569.         (if (or (= errchk 0) (= tile last-tile))
      ; a1 T8 q4 T& o2 D6 v  C
6570.           (set_tile "error" "")
      6 z7 |' }3 Z# C' g
6571.         )
      
6572.         (set_tile tile (ai_rtos coord))
      
6573.         (setq errchk 0)
      2 ?  Q& B3 Q  F
6574.         (setq last-tile tile)
      " B6 W$ Z7 x8 o8 l0 Z
6575.         coord
      & E. f  S2 ]+ D2 {* L2 e
6576.       )
      9 ^; y5 \6 V7 X' F2 j' y5 M
6577.       (progn
      
6578.         (mode_tile tile 2)            ; Move focus to offending field
      
6579.         (mode_tile tile 3)            ; Select offending text
      
6580.         (set_tile "error" errmsg)
      
6581.         (setq errchk 1)
      ) {4 a! c9 Q7 x5 r
6582.         (setq last-tile tile)
      ' c- ?' I" F; H2 v7 _# x6 \) i
6583.         old-value
      
6584.       )
      4 R5 w2 Q: x8 D4 W
6585.     )
      1 V3 n3 x( u  z8 f/ v( S
6586.   )
      
6587. 
      ; X. r$ t: {6 L; v# ^- |2 Y
6588.   ;;
      
6589.   ;; Verify angle function.  This takes an angle and a tile name as arguments.
      
6590.   ;; If the angle is valid, it returns the angle and resets the tile.
      
6591.   ;; Otherwise, it sets the error tile and keeps focus on the tile.
      $ Z: q. T5 V, c1 S8 {0 e
6592.   ;;
      4 |  f) C, D( n0 X. w) e2 \& ^
6593.   (defun verify_a (tile value old-value / ang valid errmsg oblqmax)
      ; ~! z9 O! F$ F* o
6594.     (setq valid  nil
      
6595.           errmsg "Illegal input value."
      3 S. Q% o% }/ D+ h3 v* i
6596.     )
      
6597.     (if (setq ang (angtof value))
        B- e( D1 J; B  x  i( c* X
6598.       (cond
      
6599.         ((= tile "obl")               ; Restrict obliquing angle
      
6600.          (setq oblqmax (+ (* (/ PI 2.0) (/ 85.0 90.0)) 0.000001))
      
6601.          (if (or (<= ang oblqmax)
      # l+ @  u' n$ b+ F3 }
6602.                  (>= ang (- (* 2.0 PI) oblqmax))
      
6603.              )
      : m% ?- Q' I- s1 [* Q4 F+ H" v
6604.            (setq valid T)
      
6605.            (setq errmsg
      " n$ q3 P: q3 J7 U- z
6606.                  "Value must be between -85 and +85 degrees.")
      " A5 _# x- P* _2 Q) ?5 o4 ?
6607.          )
      
6608.         )
      ' \: W/ h9 E* f0 d
6609.         (T (setq valid T))            ; Other angles not restricted
      ' _$ e) v; z0 G& N
6610.       )
      
6611.       (setq valid nil)                ; Invalid angle input
      
6612.     )
      % B- n" H  q! P8 f9 n% t& m* G% l
6613.     (if valid
      
6614.       (progn
      
6615.         (if (or (= errchk 0) (= tile last-tile))
      
6616.           (set_tile "error" "")
      
6617.         )
      ) I1 c+ v+ r* l+ u, U% h' I
6618.         (set_tile tile (ai_angtos ang))
      
6619.         (setq errchk 0)
      1 ]. B1 K2 q9 D1 i2 b
6620.         (setq last-tile tile)
      7 {" C; Y5 @, N* B
6621.         ang
      9 @4 \9 M5 F8 V9 N
6622.       )
      
6623.       (progn
        q! I6 F& s! @, w
6624.         (mode_tile tile 2)            ; Move focus to offending field
      
6625.         (mode_tile tile 3)            ; Select offending text
      # u$ e6 y$ i" p
6626.         (setq last-tile tile)
      ! }3 a8 c" ?* m0 o3 i) P3 r
6627.         (setq errchk 1)
      
6628.         (set_tile "error" errmsg)
      3 c; t" w/ M1 @
6629.         old-value
      % R. R* v# r3 d9 @
6630.       )
      
6631.     )
      4 d; P- M& M) j+ E; j; I: i
6632.   )
      
6633.   ;;
      
6634.   ;; Verify angle function.  This takes an angle and a tile name as arguments.
      3 _4 l) X0 O8 W% ?  C9 O
6635.   ;; If the angle is valid, it returns the angle and resets the tile.
      
6636.   ;; Otherwise, it sets the error tile and keeps focus on the tile.
      
6637.   ;; This function is specifically for the end angle of the ellipse object. If
      
6638.   ;; the end angle resolves to zero then we want to display it as 360.
      : y* n7 Y* A7 c/ Y$ K
6639.   ;;
      
6640.   (defun verify_ae (tile value old-value / ang tempend)
      # C4 y; B5 i5 f& N- a  f0 z8 u
6641.     (if (setq ang (angtof value))
      
6642.       (progn
      % B) |# X1 [, e% j2 t
6643.         (if (or (= errchk 0) (= tile last-tile))
      ( E  k4 ~( P. A5 G1 k
6644.           (set_tile "error" "")
      ) C: T# [9 a, u; Z5 ~
6645.         )
      6 R8 @  J- I  ~0 P6 j0 z, p
6646.         (setq tempend (ai_angtos ang))
      
6647.         (if (= tempend "0")
      
6648.            (set_tile tile "360")
      ( i9 A2 }# k8 E7 I
6649.            (set_tile tile tempend)
      
6650.         )
      
6651.         (setq errchk 0)
      
6652.         (setq last-tile tile)
      
6653.         ang
      ! }. U8 }! G' Z: s' V* q& r* s. ^: r
6654.       )
      
6655.       (progn
      
6656.         (mode_tile tile 2)            ; Move focus to offending field
      
6657.         (mode_tile tile 3)            ; Select offending text
      $ n* @/ Z# j* S- S2 m- X# h( x$ I
6658.         (setq last-tile tile)
      % J( F3 `8 a& W. v- O
6659.         (setq errchk 1)
      0 g8 H" @' N# d$ m
6660.         (set_tile "error" "Illegal input value.")
      & C" g% j2 d5 _
6661.         old-value
      
6662.       )
      : R7 W7 U4 W$ l" }. e4 i1 D* o
6663.     )
      ! P6 s4 _/ ~* P. [
6664.   )
      3 N. G# o. r. C) f) G1 g6 H
6665.   ;;
        q3 ?& D) n# L& L4 D" r& O
6666.   ;; Verify integer function.  This takes an integer and a tile name as
      ; G) l! u' ]- F) A) Q$ v7 M& X# Q( z
6667.   ;; arguments.  If the integer is valid, it returns the integer and resets the
      
6668.   ;; tile.  Otherwise, it sets the error tile and keeps focus on the tile.
      
6669.   ;;
      : s; @2 z8 @3 {# A
6670.   (defun verify_i (tile value old-value / int valid errmsg)
      ! Z. }, C! s6 r; n9 L8 L+ [
6671.     (setq valid nil)
      * @' k' D4 n9 @+ C+ F* W/ \
6672.     (setq errmsg "Value must be an integer.")
      . z' Y1 R7 s$ W( `4 g. V9 ~
6673.     (setq int (atoi value))
      $ @$ i+ B$ ~% j" z7 c8 [
6674.     (if (setq intchk (distof value))
      9 K/ v/ \  r, O0 I
6675.       (cond
      
6676.         ((or (= tile "columns") (= tile "rows"))
      
6677.          (if (and (= int intchk)
      
6678.                   (>= int 0)
      
6679.                   (<= int 32767)
      
6680.              )
      
6681.            (setq valid T)
      
6682.            (setq errmsg "Value must be an integer between 0 and 32767.")
      ; X% h! F6 ~) Z. J# I3 [
6683.          )
      , k! s, w  W0 Z2 r) O! M- M
6684.         )
      & ?6 W* C+ w1 S0 R# Y
6685.         ((and (or (= tile "u") (= tile "v")))
      
6686.          (if (and (= int intchk)
      & k' ^5 x3 S3 F# T, H+ z, n/ Q* E
6687.                   (>= int 0)
      
6688.                   (< int 201)
      
6689.              )
      
6690.            (setq valid T)
      , ^1 L6 j& N0 d$ y* v+ F! C: I/ |
6691.            (setq errmsg "Value must be an integer between 0 and 200.")
      1 e. A7 b6 X& F( n
6692.          )
      
6693.         )
      & k: X" V* g% @  S, W
6694.       )
      " c# _# h, C; ?+ {& q: s3 Z5 q# _
6695.     )
      4 P& c+ ^1 t5 D" h5 A" c; O1 q
6696.     (if valid
      
6697.       (progn
      
6698.         (if (or (= errchk 0) (= tile last-tile))
      
6699.             (set_tile "error" "")
      
6700.         )
      ; {8 r4 b, k# p  U4 C0 Y
6701.         (set_tile tile (itoa int))
      
6702.         (setq errchk 0)
      
6703.         (setq last-tile tile)
      
6704.         int
      
6705.       )
      " c# s4 r5 s; H  g& O9 M5 C+ L
6706.       (progn
      
6707.         (mode_tile tile 2)            ; Move focus to offending field
      : `& h. D) f! w  L; j* Y
6708.         (mode_tile tile 3)            ; Select offending text
      
6709.         (set_tile "error" errmsg)
      - y/ O& s. J/ x: m) K+ w* P6 D
6710.         (setq errchk 1)
      
6711.         (setq last-tile tile)
      
6712.         old-value
      
6713.       )
      6 y2 }) u  J' j& \! K$ m
6714.     )
      5 s5 S, X! x/ ~% x
6715.   )
      
6716.   ;;
      + I1 H; D# N7 s  o- u9 M
6717.   ;; Functions that verify tile values for integers
      ! G( W* r5 U1 i0 P' ^3 L
6718.   ;;
      
6719.   (defun ver_col (value)
      
6720.     (setq columns (verify_i "columns" value columns))
      
6721.   )
      0 Q& \" e/ S) k1 e0 A$ p- w, n; f$ c
6722.   (defun ver_row (value)
      
6723.     (setq rows (verify_i "rows" value rows))
      
6724.   )
      " ]; m/ A/ [  T! x8 k% d
6725.   (defun ver_u (value)
      / ~/ B0 ^7 e0 }9 \+ @
6726.     (setq u (verify_i "u" value u))
      
6727.   )
      
6728.   (defun ver_v (value)
      , K1 t) u+ d' F7 E/ H% v, {  @
6729.     (setq v (verify_i "v" value v))
      
6730.   )
      
6731.   ;;
      
6732.   ;; Functions that verify tile values for reals
      ; x( a: i) x# o" L
6733.   ;;
      
6734.   (defun ver_x1 (value)
      $ B, h0 l- ?4 Z: ^% C
6735.     (if (setq x1 (verify_d "x1_pt" value x1)) (calc))
      - D/ F* y: V2 a) N# _4 q
6736.   )
      / w8 Z) b. z/ d& f) h, S7 q6 I
6737.   (defun ver_y1 (value)
      9 P4 U( @( D) s5 j- D6 O
6738.     (if (setq y1 (verify_d "y1_pt" value y1)) (calc))
      7 m- b" O  R4 S
6739.   )
      
6740.   (defun ver_z1 (value)
      
6741.     (if (setq z1 (verify_d "z1_pt" value z1)) (calc))
      
6742.   )
      ' G! Q9 P/ S. G9 o$ k
6743.   (defun ver_x2 (value)
      " T* ?: ]* o. v. A- H3 D9 O* r  i
6744.     (if (setq x2 (verify_d "x2_pt" value x2)) (calc))
      
6745.   )
      
6746.   (defun ver_y2 (value)
      
6747.     (if (setq y2 (verify_d "y2_pt" value y2)) (calc))
      . N) t4 q* |: S, Q$ b- }4 Y
6748.   )
      
6749.   (defun ver_z2 (value)
      
6750.     (if (setq z2 (verify_d "z2_pt" value z2)) (calc))
      
6751.   )
      
6752.   (defun ver_x3 (value)
      
6753.     (setq x3 (verify_d "x3_pt" value x3))
      
6754.   )
      
6755.   (defun ver_y3 (value)
      
6756.     (setq y3 (verify_d "y3_pt" value y3))
      % }2 U* c& d" v) X4 m" L1 z
6757.   )
      
6758.   (defun ver_z3 (value)
      
6759.     (setq z3 (verify_d "z3_pt" value z3))
      1 X! h/ }6 K3 }, m& B3 z! ^+ r
6760.   )
      % D! b( J0 n) O( `" j, x' X4 ~7 T
6761.   (defun ver_x4 (value)
      
6762.     (setq x4 (verify_d "x4_pt" value x4))
      1 r7 _* k+ E( c/ H$ w8 f- G
6763.   )
      3 ^- \% w# b. p7 [& M
6764.   (defun ver_y4 (value)
      # A& Q0 r# T# s7 E, b/ E$ k7 x; ~
6765.     (setq y4 (verify_d "y4_pt" value y4))
      
6766.   )
      
6767.   (defun ver_4 (value)
      ; ~& _5 v6 b8 g0 r  [9 \  \( V) {
6768.     (setq z4 (verify_d "z4_pt" value z4))
      
6769.   )
      , V7 j9 s$ m: {( i2 }2 ^, W1 x& G. G0 S
6770.   (defun ver_xscl (value)
      
6771.     (setq xscale (verify_d "xscale" value xscale))
      
6772.   )
      
6773.   (defun ver_yscl (value)
      
6774.     (setq yscale (verify_d "yscale" value yscale))
      / k* @& A& S8 V' ]8 Y
6775.   )
      * w$ n# n  i/ F; Y9 `0 G
6776.   (defun ver_zscl (value)
      9 Y) H6 f. }8 a, o
6777.     (setq zscale (verify_d "zscale" value zscale))
      0 f: k% i! L& P4 q4 G3 s; n
6778.   )
      / e7 E* ]2 L3 Y5 Z4 D. T  ^
6779.   (defun ver_colsp (value)
      
6780.     (setq col-sp (verify_d "col_sp" value col-sp))
      8 X7 O9 t7 D. I7 x4 C, M
6781.   )
      
6782.   (defun ver_rowsp (value)
      
6783.     (setq row-sp (verify_d "row_sp" value row-sp))
      $ `1 o6 m% D3 \/ |
6784.   )
      
6785.   (defun xclip ()
      
6786.     (setq xclipmode t)
      
6787.     (if (= xcliponoff "1")
      : F7 p3 J! z4 o* H# o
6788.       (command "_.xclip" (cdr(assoc -1 elist)) "" "_on")
      
6789.       (command "_.xclip" (cdr(assoc -1 elist)) "" "_off")
      
6790.     )
      
6791.   )
      1 h, C, A- C- l, B& h
6792.   (defun ver_rad (value)
        ~& C# D9 z6 M) e3 E2 X
6793.     (if (setq radius (verify_d "radius" value radius))
      
6794.       (calc)
      
6795.     )
      
6796.   )
      
6797.   (defun ver_majrad (value)
      ! @  ?" p0 {( R0 s- H
6798.     (if (setq majrad (verify_d "majrad" value majrad))
      2 B' @+ m/ H" X1 l3 T; G$ w2 i
6799.       (ell_calc_newval "majrad")
      
6800.     )
      
6801.   )
      ' `% ~1 ?/ t1 @
6802.   (defun ver_minrad (value)
      
6803.     (if (setq minrad (verify_d "minrad" value minrad))
      7 B- r9 }8 ?) v% Z. i9 p- P% A3 C
6804.       (ell_calc_newval "minrad")
      
6805.     )
      ; h, u8 U2 Z' f! u- W; F
6806.   )
      
6807.   (defun ver_hght (value)
      3 [0 j/ H7 Q9 e5 Z& W" b) u. S$ [; X
6808.     (setq hght (verify_d "hght" value hght))
      
6809.   )
      : [" F$ F3 u3 P. o% h4 K
6810.   (defun ver_wid (value)
      ) v1 k" ^' A/ _/ @4 W3 C  l
6811.     (setq wid (verify_d "wid" value wid))
      
6812.   )
      9 V, W- T" o4 |' L% N, j2 c
6813.   (defun ver_xline_x1 (value / temp)
      . R% ~' h  S! D8 ~
6814.     (setq temp xline_x1)
      
6815.     (setq xline_x1 (verify_xline "xline_x1" value xline_x1))
      
6816.     (if (/= temp xline_x1)
      6 C4 z0 K# X' A
6817.       (progn (modify_xline 0) (set_tile_dirv) )
      
6818.     )
      
6819.   )
      9 N9 m: z% j0 f1 |8 |# _
6820.   (defun ver_xline_y1 (value / temp)
      
6821.     (setq temp xline_y1)
      2 s7 R7 A2 Y2 c" U7 e  d& H- a6 K0 f
6822.     (setq xline_y1 (verify_xline "xline_y1" value xline_y1))
      
6823.     (if (/= temp xline_y1)
        k% K- I6 I8 u
6824.       (progn (modify_xline 0) (set_tile_dirv) )
      
6825.     )
      4 ^/ R- J" K; @& H0 H, `
6826.   )
      
6827.   (defun ver_xline_z1 (value / temp)
      
6828.     (setq temp xline_z1)
      
6829.     (setq xline_z1 (verify_xline "xline_z1" value xline_z1))
      7 l' B; R& G' s. l
6830.     (if (/= temp xline_z1)
      ) x/ v1 P; L+ V  F9 x
6831.       (progn (modify_xline 0) (set_tile_dirv) )
      
6832.     )
      
6833.   )
      
6834.   (defun ver_xline_x2 (value / temp)
        ~" B7 T* ^# L
6835.     (setq temp xline_x2)
      
6836.     (setq xline_x2 (verify_xline "xline_x2" value xline_x2))
      ! v" V9 j+ t) o+ T
6837.     (if (/= temp xline_x2)
      
6838.       (progn (modify_xline 0) (set_tile_dirv))
      
6839.     )
      
6840.   )
      ) P2 O; D/ Y4 ?! V5 ~
6841.   (defun ver_xline_y2 (value / temp)
      
6842.     (setq temp xline_y2)
      * f6 J, {+ M& Z. V  T$ S
6843.     (setq xline_y2 (verify_xline "xline_y2" value xline_y2))
      8 j; i7 t, ~4 x# I3 ?
6844.     (if (/= temp xline_y2)
      
6845.       (progn (modify_xline 0) (set_tile_dirv) )
      
6846.     )
      ' E. V+ ]3 N6 g" L
6847.   )
      ( q  z9 s2 p4 v, y& t; Y$ |; |! o
6848.   (defun ver_xline_z2 (value / temp)
      0 I2 n$ V+ l" ~+ {
6849.     (setq temp xline_z2)
      , ?# r& p1 X! {1 }) u
6850.     (setq xline_z2 (verify_xline "xline_z2" value xline_z2))
      
6851.     (if (/= temp xline_z2)
      ' d1 s: E. |1 ^4 }8 ?
6852.       (progn (modify_xline 0) (set_tile_dirv) )
      
6853.     )
      
6854.   )
      ; f; f, _& u$ c- _: p3 }1 G: h
6855.   ;;
      
6856.   ;; Functions that verify tile values for angles
      
6857.   ;;
      
6858.   (defun ver_ang1 (value)
      
6859.     (if (setq st_ang (verify_a "st_ang" value st_ang))
      
6860.       (calc)
      3 O9 U- o& ]% _) c1 @" r+ t, d
6861.     )
      % O- R; A* J" @: E9 d  K! x& Y
6862.   )
      ' N6 H6 E) I$ b& C9 ~
6863.   (defun ver_ang2 (value)
      
6864.     (if (setq end_ang (verify_a "end_ang" value end_ang))
      & M* k9 o& W( I( G* y$ T  R8 n
6865.       (calc)
      5 \% A$ [. l* H* Z6 A
6866.     )
      " p1 U4 A( J2 L) o. H
6867.   )
        @1 `1 t, B9 }1 Z( [7 c, o' H
6868.   ;;
      
6869.   ;; Verify tile value for ellipse end angle. Handled slightly
      7 `" q7 z* ^( \' c
6870.   ;; differently than the other angles.
      
6871.   ;;
      
6872.   (defun ver_eang (value)
      $ J3 D) r6 v" l5 M5 w
6873.     (setq end_eang (verify_ae "end_eang" value end_eang))
      
6874.   )
      
6875.   (defun ver_rot (value)
      
6876.     (setq rot (verify_a "rot" value rot))
      
6877.   )
      ) H% G8 t, I- o8 Z9 A6 ?$ T* ~/ X
6878.   (defun ver_obl (value)
      
6879.     (setq obl (verify_a "obl" value obl))
      
6880.   )
      + j+ a7 U+ X2 W5 ~
6881.   ;;
      # B# o+ M- [; I# S
6882.   ;; Function that verifies attribute tag field for null string,
      
6883.   ;; or a string that contains one or more spaces.  Tile value
      . S# p* T4 }& B& b! q
6884.   ;; is also converted to upper-case as well.
      ' b) I. D& o3 v0 o9 t. m
6885.   ;;
      * Z1 m9 p% @4 U9 v
6886.   ;;
      & b6 t: S% ^% ?- C3 B
6887.   (defun ver_tag ( / tval)
      
6888.      (setq tagval (get_tile "tag"))
      ' r" q3 E! f+ {3 X  h
6889.      (set_tile "error" "")
      - P1 \! W0 F, ~$ i* `# ]
6890.      (cond
      ; V/ i+ {/ \' d7 z
6891.         (  (or (eq "" (setq tval (strcase (ai_strtrim tagval))))
      * ]8 F% z, q- r& |% u
6892.                (wcmatch tval "* *"))
      7 k2 A) n7 p$ ?- f1 Y% e0 i; |
6893.            (set_tile "error" "Invalid attribute tag.")
      7 |! W* G8 T3 l2 W2 ^% W3 _' i8 ^
6894.            (mode_tile "tag" 2)
      5 Z$ p6 L7 C7 b
6895.            (mode_tile "tag" 3))
      
6896.         (t (set_tile "error" "")
      - Q8 A' J6 W( @5 \( @3 f0 a5 m' j
6897.            (set_tile "tag" tval)
      
6898.            (setq attag tval)))
      
6899.   )
      4 c* p. N7 \, ]) S
6900.   ;;
      * b& S' }- f* r8 x8 f
6901.   ;; Calculation functions
      & V! N0 G  C; }7 }5 x
6902.   ;;
      2 B) B; F- D0 ^1 s% W
6903.   (defun calc ()
      
6904.     (if (= etype "LINE") (line_calc))
      
6905.     (if (= etype "ARC") (arc_calc))
      
6906.     (if (= etype "CIRCLE") (cir_calc))
      - E, o  K7 y! F/ D& `/ O& B6 _
6907.   )
      2 G5 ?7 [, q" G$ ~' Q9 Q
6908.   ;;
      / F+ y% z/ E: [  {
6909.   ;; Calculation functions for lines, arcs, and circles
      
6910.   ;;
      
6911.   (defun line_calc ()
      
6912.     (setq stpt  (list x1 y1 z1))
      " i& ^4 d6 B* j, b8 {9 d0 {% Z
6913.     (setq endpt (list x2 y2 z2))
        K7 ]( R8 a; r( z: \4 c
6914.     (set_tile "delta_x" (rtos (- x2 x1)))
      
6915.     (set_tile "delta_y" (rtos (- y2 y1)))
      
6916.     (set_tile "delta_z" (rtos (- z2 z1)))
        q( i9 n  b$ q! [& e
6917.     (set_tile "l_length" (rtos (distance stpt endpt)))
      
6918.     (set_tile "l_angle" (angtos (angle stpt endpt)))
      
6919.   )
      
6920. 
      
6921.   (defun cir_calc ( / area units)
      & X- G- D% x) @' F; z" |# Z- p, B) R+ c
6922.         (setq radtest radius)
      % X. W" a) Q0 A6 g6 F
6923.         (set_tile "Dia" (rtos (* 2 radius)))
      . V+ g/ y8 |  _3 p6 r
6924.         (set_tile "Circum" (rtos (* 2 pi radius)))
      / d; F" X% v+ v! x1 T  ^" C; r
6925.         (setq area  (* pi (* radius radius)))
      
6926.         (setq units (getvar "LUNITS"))
      
6927.         (if (or (= units 3) (= units 4))
      
6928.             (progn
      2 D5 H/ M1 x' e3 ?) E" a
6929.                (setq area (/ area 144.0))
      $ T* Q% J+ ]' ]1 A0 ~: w# q
6930.                (set_tile "Area" (strcat (rtos area 2) " square ft"))
      + Q+ m2 W& x7 h0 Y6 n
6931.             )
      
6932.             (set_tile "Area" (rtos area))
      4 s' M! o8 h0 ]; p: ?
6933.         )
      
6934.   )
      # F+ j) l3 b$ `2 e# t8 @' g5 x& {
6935. 
      
6936.   (defun arc_calc ()
      
6937.     (setq totang (- end_ang st_ang))
      ( A) h+ U- O) ]2 e- N0 d: k$ B
6938.     (while (< totang 0)
      . L% J; ^2 p% R3 _% f2 `& u
6939.       (setq totang (+ totang (* 2 pi)))
      * L% |& B: u% @/ D! R. V
6940.     )
      
6941.     (while (> totang (* 2 pi))
      
6942.       (setq totang (- totang (* 2 pi)))
        j! M+ s* V" g1 ^
6943.     )
      4 [- |# t2 w( y4 d
6944.     (set_tile "tot_angle" (angtos totang))
      
6945.     (setq arclen (* (* 2 pi radius) (/ totang (* 2 pi))))
      2 j# c' j+ j- b' _
6946.     (set_tile "arclen" (rtos arclen))
      
6947.   )
      . G" f9 Q, T+ _# _- u, [
6948.   ;;
      
6949.   ;; Calculate the major radius, minor radius, major axis direction.
      : V4 E; r/ q, {8 E
6950.   ;; Get radius ratio. Convert Start, end parameters to start and end
      7 ^6 h1 b* X# z
6951.   ;; angles. Save Major Radius value in "old_majrad" in case the user
      
6952.   ;; chooses to input a new Major Radius value later. It's needed to
      1 I" t3 b( c  p, U) D
6953.   ;; calculate a new Major Axis Vector value.
      
6954.   ;;
      
6955.   (defun ell_calc ()
      
6956.         ;; Get major radius from the major axis vector.
      
6957.         (setq majaxis (cdr (assoc 11 elist)))
      / _6 X$ M; `0 _+ e; _8 W& `; O
6958.         (setq xx (car majaxis))
      , w8 F* y7 t7 k8 {
6959.         (setq yy (cadr majaxis))
      
6960.         (setq zz (caddr majaxis))
      & T3 z# i. `; w
6961.         (setq majrad (sqrt (+ (* xx xx) (* yy yy) (* zz zz) )))
      7 u* F8 S# z) m1 m
6962.         (set_tile "majrad" (ai_rtos majrad))
      
6963.         (setq old_majrad majrad)
      
6964.         ;; Get radius ratio
      
6965.         (setq rrat (cdr (assoc 40 elist)))
      
6966.         (set_tile "rratio" (rtos rrat))
      
6967.         ;; Calculate minor radius
      2 t- T, C* v7 O0 X6 Q6 q
6968.         (setq minrad (* majrad rrat))
      
6969.         (set_tile "minrad" (ai_rtos minrad))
      4 D5 g3 U- O8 o- `/ c, ?
6970.         ;; display major axis vector
      ) r7 b# ~4 B2 p/ u
6971.         (set_tile "Majraddirx" (rtos xx))
      
6972.         (set_tile "Majraddiry" (rtos yy))
      
6973.         (set_tile "Majraddirz" (rtos zz))
      
6974. 
      
6975.         ;; Convert start parm to start angle
      
6976.         (setq stparm (cdr (assoc 41 elist)))
      3 m: S9 H& z7 ~+ z4 }
6977.         (setq vecx (cos stparm))
      " p- S5 y) d/ p( [6 C9 U# E
6978.         (setq vecy (sin stparm))
      
6979.         (setq st_ang (atan (* rrat vecy) vecx))
      
6980.         (setq tempst_ang (ai_angtos st_ang))
      9 o: f2 O8 \! }/ B
6981.         (set_tile "st_ang" tempst_ang)
      5 T0 U: A2 x4 q2 n/ Z" o
6982.         ;; Convert end parm to end angle. If end angle evaluates to 0
      
6983.         ;; degrees then display it as 360 degrees.
      
6984.         (setq endparm (cdr (assoc 42 elist)))
      
6985.         (setq evecx (cos endparm))
      
6986.         (setq evecy (sin endparm))
      
6987.         (setq end_eang (atan (* rrat evecy) evecx))
      ( C3 b4 ]6 O/ o/ T' k
6988.         (setq tempend_eang (ai_angtos end_eang))
      2 R1 I" W( V6 }2 z; ^
6989.         (if (= tempend_eang "0")
      
6990.             (set_tile "end_eang" "360")
      
6991.             (set_tile "end_eang" tempend_eang)
      & r8 _' Q$ B+ u$ ?
6992.         )
      
6993.         ;; Get area of the ellipse.
      % b, v. f* J5 t6 c! ^
6994.         (ell_calc_area)
      0 f: o" j* _3 I1 A4 \% v/ O
6995.   )
      & D' d! ]* Q' v( G: }
6996.   ;; Calculate area of ellipse. If it is an arc then
      
6997.   ;; grey out area display.
      6 q8 K$ [8 ?9 n  ^# Q
6998.   ;;
      
6999.   (defun ell_calc_area ( / area units)
      
7000.      (if (and (= tempst_ang "0") (= tempend_eang "0"))
      
7001.          (progn
      , J4 h( U+ }$ C$ s/ n
7002.              (setq area  (* pi majrad minrad))
      2 X( O8 _) W% b* I. @3 ]. X
7003.              (setq units (getvar "LUNITS"))
      7 p1 S6 K. @% x5 x* o) s; h
7004.              (if (or (= units 3) (= units 4))
      
7005.                  (progn
      
7006.                      (setq area (/ area 144.0))
      
7007.                      (set_tile "Area" (strcat (rtos area 2)" square ft"))
      
7008.                  )
      - f3 W" x3 v! m" Y+ x& B5 N4 X
7009.                  (set_tile "Area" (rtos area))
      
7010.              )
      
7011.          )
      
7012.         (mode_tile "Area_text" 1)
      - V8 G8 f. a8 W& n) I
7013.      )
      1 B( l" _9 F  S' x7 f# ^
7014.   )
      
7015.   ;;
      8 U) Z! L8 L5 K. W
7016.   ;; Calculate new values for ELLIPSE
      " w+ }4 c  r- H" z- ~
7017.   ;; Minor Radius, Area
      + Y2 v! o$ P$ H2 Z0 X
7018.   ;;
      6 U2 Q' U, A2 l; N0 h  `# i
7019.   (defun ell_calc_newval (ell_tile)
      2 p$ h# i9 ?& w$ r( ]
7020.     (if (= ell_tile "majrad")
      
7021.       (progn
      : W9 X, t8 ~5 E- C* g
7022.          (setq rrat (/ minrad majrad))
      
7023.          (set_tile "rratio" (rtos rrat))
      
7024.          (ell_calc_area)
      & a8 A+ |5 e) i* n9 r  K; _- K& G
7025.       )
      
7026.     )
      # i# D) x) H$ R
7027.     (if (= ell_tile "minrad")
      
7028.       (progn
      
7029.          (setq rrat (/ minrad majrad))
      5 H- ]/ r0 F( Q& U" J9 \9 |
7030.          (set_tile "rratio" (rtos rrat))
      & n6 Q% y. t# v3 H3 q
7031.          (ell_calc_area)
      % f6 ?, r8 k3 t, F+ H" w6 i
7032.       )
      ; Q! r% k5 C* U7 }
7033.     )
      5 J* \0 a* X8 g7 E- Z. D; A
7034.   )
      7 R! t" R. i! v( f, k- Z7 T  R
7035. 
      
7036.   (defun set_dimen_props (/ loop a stl txstyname)
      7 B2 p% [' E4 d( L. ]; y0 \( y
7037. 
      + K. {( l' g0 e. R4 L- |, S) ^
7038.     (setq stname (cdr (assoc 3 elist)) ; get style name
      1 n, d# i/ g2 s5 @7 T
7039.           stl (tblnext "DIMSTYLE" T)
      * J, C/ Q8 Y* f4 A1 \& ]2 w( z
7040.           stlist nil)
      
7041.     ;; Get all style names and list them in alphabetical order
      
7042.     (while stl
      
7043.       (setq sname (cdr (assoc 2 stl)))
      
7044.       (if (/= (logand 16 (cdr (assoc 70 stl))) 16)
      : t7 j9 v1 E' D4 Y6 R7 r& |
7045.            (setq stlist (cons sname stlist)))
      4 g% ?1 Q  R" ], t
7046.       (setq stl (tblnext "DIMSTYLE")))
      5 I3 ~  ]3 s1 @' K" D# v4 \5 L
7047. 
      & S7 A, ^; Q  z, g& f2 i$ w, N* e
7048.     (setq len    (length stlist)
      
7049.           loop   0
      8 ?/ s3 l. C9 V  T4 C  s
7050.           dimsty stname
      
7051.     )
      ' |/ E2 Y3 k: [( M. B$ Q
7052. 
      6 G3 F, e8 {4 u. Q
7053.     ;; alphabetize style list, depending on maxsort
      
7054.     (if (>= (getvar "maxsort") len)
      
7055.         (setq stlist (acad_strlsort stlist))
      * U% ]! B) h0 y' W& t
7056.       (setq stlist (reverse stlist)))
      
7057. 
      
7058.     ; *UNNAMED style (dimsty = nil at this point) is replaced with
      
7059.     ; the current style.  After R13, we require dimensiosn to have a
      9 s# o, a( D( @$ n3 D; y0 s
7060.     ; dimstyle, so we plug any holes where we find them.
      
7061.     (if (null dimsty)
      
7062.       (setq dimsty (getvar "dimstyle"))
      4 ~) G7 X9 j1 z, v! S! I: Z
7063.     )
      
7064.     ; Show the styles in combo box
      , `) u$ n( Z8 k. q+ ]
7065.     (start_list "mod_style" 2)
      " b0 U" s" J( y& w: n# W  e
7066.     (while (< loop len)
      2 j8 S, b1 p5 b( [0 C5 Q
7067.       (add_list (nth loop stlist))
      
7068.       (setq loop (1+ loop))
      7 h9 E$ h. E5 U) M+ b3 O* |5 m1 n
7069.     )
      * ~) F' G, D0 J3 Z# s
7070. 
      1 o* I1 f+ `3 R- g
7071.     (end_list)
      5 |, [$ e5 ?6 d4 N
7072. 
      + A- s5 ], g* |+ g# a
7073.     ; Hilight the style name of the selected entity
      , Z" \" B$ x3 x* Y1 z: p
7074.     (while (and (< 0 loop) (/= dimsty (nth loop stlist)))
      , T9 c+ _. s/ O
7075.       (setq loop (1- loop))
      & J0 y' y9 n2 R3 S9 z/ N! c
7076.     )
      
7077.     (set_tile "mod_style" (itoa loop))
      
7078. 
      8 p' s9 e" n4 m0 Y2 }$ i. M4 D
7079.     ; The following is the list dimvars. It must be sorted in the same
      
7080.     ; order as the resfub returned from DDIM (ADS module).
      5 z$ e0 {: P# R  L9 P
7081. 
      
7082.     (setq dimtbl (list "DIMSTYLE"  "Style name"  "Standard flag values"
      
7083.         "dimpost"   "dimapost"    "dimblk"    "dimblk1"    "dimblk2"
      3 L- K9 ?$ X) v5 `
7084.         "dimscale"  "dimasz"      "dimexo"    "dimdli"     "dimexe"
      
7085.         "dimrnd"    "dimdle"      "dimtp"     "dimtm"      "dimtxt"
        U& E9 u5 n; L5 S3 W% p
7086.         "dimcen"    "dimtsz"      "dimaltf"   "dimlfac"    "dimtvp"
      
7087.         "dimtfac"   "dimgap"      "dimtol"    "dimlim"     "dimtih"
      2 A' A7 W5 r1 R- O6 n
7088.         "dimtoh"    "dimse1"      "dimse2"    "dimtad"     "dimzin"
      
7089.         "dimalt"    "dimaltd"     "dimtofl"   "dimsah"     "dimtix"
      
7090.         "dimsoxd"   "dimclrd"     "dimclre"   "dimclrt"    "dimunit"
      0 R8 X) i% w4 a" t
7091.         "dimdec"    "dimtdec"     "dimaltu"   "dimalttd"
      
7092.         "dimaunit"  "dimjust"     "dimsd1"    "dimsd2"     "dimtolj"
      
7093.         "dimtzin"   "dimaltz"     "dimalttz"  "dimfit"     "dimupt"
      
7094.         "dimtxsty"
      " N3 U* J8 e: m& K6 ]0 V5 Q; N. T
7095.     ))
      
7096.     (progn
      
7097.         (setq sv_dvlist (ddimen_getostate dimsty)
      
7098.               txstyname (assoc 340 sv_dvlist)
      
7099.               sv_dvlist (subst (cons 340 (tblobjname "STYLE" (cdr txstyname)))
      & t2 T7 O. [; X$ J/ J' ]: Q
7100.                                 txstyname sv_dvlist)
      " u8 }4 u- u5 u1 ~- s4 ^" y1 x
7101.               dimlist sv_dvlist
      
7102.         )
      1 Z7 \% ]; n% Z
7103.     )
      : A. W% b9 W. I0 W: M- \& P- z8 {& }: |
7104.     (if (= dimtype "DDLEADER")
      ; `( G( w! n# @
7105.       (mode_tile "mod_format" 1)
      7 Z, p2 R* y- v3 Y/ [# L
7106.     )
      
7107.     (action_tile "mod_style" "(setq dimsty (ddimen_style))")
      0 |+ j3 M& X0 q! ^" C: c; _9 ?
7108.     (action_tile "mod_text"  "(done_dialog 4)")
      
7109.     (action_tile "mod_geom" "(setq dimlist (ddimen_dlg dimtype 11 dimsty dimlist))")
      # q. j. i1 W4 F' X
7110.     (action_tile "mod_format" "(setq dimlist (ddimen_dlg dimtype 12 dimsty dimlist))")
      
7111.     (action_tile "mod_annot" "(setq dimlist (ddimen_dlg dimtype 13 dimsty dimlist))")
      ! @6 R5 G3 g* c4 ?/ V0 L% h1 E
7112.     (action_tile "accept" "(done_dialog 1)")
      ' R; Z, r# r* f) D' p( X; ^1 q% r
7113.   )
      # J7 X' s6 @$ m' q. u
7114.   ;;
      
7115.   ;; Get dimvars that have been restored.
      
7116.   ;;
      
7117.   (defun ddimen_getvars (/ elm dvlist dv i)
      
7118.     (setq i 3
      
7119.           dvlist (list (cons 0 "DIMSTYLE")
      + t/ d1 b2 e+ O! W. Q
7120.                   (cons 2 (getvar "dimstyle")) (cons 70 0))
      
7121.     )
      
7122.     (while (setq dv (nth i dimtbl))
        L, K" J' X3 {2 y. ?% ?' N' w* Z
7123.       (setq elm (getvar dv)
      - A7 C+ W5 S' O% Q
7124.             dvlist (append dvlist (list (cons dv elm)))
        R2 N  ?; S, o
7125.             i (1+ i)
      % b7 H" f. E. Z9 c; y
7126.       )
      
7127.     )
      $ g. r+ T0 M& ?* x% U
7128.     dvlist
      
7129.   )
      
7130. 
      " w! @" {2 Y3 N" u+ @) G# m
7131.   ;;
      
7132.   ;; Get the original states of dimvars. This is for DIMENSION entities.
      / a4 X7 D! L: N- t: @  o
7133.   ;;
      $ m4 W# l& {9 t3 S0 X6 m2 L
7134.   (defun ddimen_getostate (dimsty / dvlist elm i dvvars)
      
7135.     (setq dvlist (tblnext "dimstyle" T) ; Get a skelton list
      
7136.           dvvars (ddimen_getvars)       ; Get dimvars for that entity
      
7137.           i 1
      8 C+ v8 S! i# Y
7138.     )
      , A; `5 \6 S2 h) j
7139. 
      0 ?- ^( s$ K5 d  B) b0 Y
7140.     ; Create a list that contains values of the selected entity.
      0 ?6 N" z) A* s( K! X7 ?
7141. 
      ! y2 c: d1 C" b& r/ E
7142.     (while (setq elm (nth i dvlist))
      ' ?/ y% f5 w2 P8 u
7143.       (setq dvlist (subst (cons (car elm) (cdr (nth i dvvars))) elm dvlist)
      
7144.             i (1+ i)
      ; o4 }5 O: ^* C; ?" l( Q
7145.       )
      " a" ]. @- d, x" L2 O. P
7146.     )
      
7147.     dvlist
      # d7 b' c  y5 k  _" |# e0 L
7148.   )
      
7149. 
      
7150.   ;;
      3 Z" D5 P5 U1 V1 b& o) i* B
7151.   ;; Restores dimvars of the selected enity.
      % x7 |% j' k( s; w' p( L# g+ s
7152.   ;;
      
7153.   (defun ddimen_dimsty_restore(/ dimtbl dimsvcurset en)
      ( W2 A5 z2 l8 _4 U* n& ]. R
7154.     (setq dimtbl (list "DIMSTYLE"  "Style name"  "Standard flag values"
      9 Z3 D+ C6 x1 \1 S6 e; c
7155.         "dimpost"   "dimapost"    "dimblk"    "dimblk1"    "dimblk2"
      
7156.         "dimscale"  "dimasz"      "dimexo"    "dimdli"     "dimexe"
      
7157.         "dimrnd"    "dimdle"      "dimtp"     "dimtm"      "dimtxt"
      1 Y: s! x" Q% `. u7 T
7158.         "dimcen"    "dimtsz"      "dimaltf"   "dimlfac"    "dimtvp"
      1 z1 @- c4 b" N' B7 p4 _' u
7159.         "dimtfac"   "dimgap"      "dimtol"    "dimlim"     "dimtih"
      $ t! U; W* U1 W: [9 ]1 M+ s
7160.         "dimtoh"    "dimse1"      "dimse2"    "dimtad"     "dimzin"
      
7161.         "dimalt"    "dimaltd"     "dimtofl"   "dimsah"     "dimtix"
      $ \8 v- G& P  E, d
7162.         "dimsoxd"   "dimclrd"     "dimclre"   "dimclrt"    "dimunit"
      
7163.         "dimdec"    "dimtdec"     "dimaltu"   "dimalttd"
      + e* y4 ?# i$ T* I' z% D; t
7164.         "dimaunit"  "dimjust"     "dimsd1"    "dimsd2"     "dimtolj"
      . ]: h6 ~1 P7 M4 h% I5 X
7165.         "dimtzin"   "dimaltz"     "dimalttz"  "dimfit"     "dimupt"
      
7166.         "dimtxsty"
      
7167.     ))
      
7168.     (setq dimsvcurset (ddimen_getvars))  ; Save current variable settings
      ; U, W8 z! \7 C$ J' q
7169.     (progn
      
7170.         (setq en (cdr (assoc -1 elist)))
      
7171.         (command "_.dimstyle" "" "" en)
      
7172.     )
      + x) A3 k: P+ R* \% u5 I- z0 v
7173.     dimsvcurset
      ; f' y% b) c# C$ |" f. L" z
7174.   )
      ) u9 q. x: [6 p& h; V. H; Z
7175.   ;;
      " U3 b* s; l1 F. w) u( f
7176.   ;; Modify Leader
      
7177.   ;;
      " ~% R8 C$ f8 k0 r1 o
7178.   (defun ddleader (/ dtypebit blkname bename sublist a  stname n dimtbl
      
7179.                    dimsty dimlist dimtext svtext dimovr sv_dvlist stlist
      
7180.                    dimtype dimsvcurset)
      , Q: o: P  o+ [* H% ?  y
7181.     (setq dimtype "DDLEADER"
      
7182.           dimsvcurset (ddimen_dimsty_restore)
      
7183.     )
      ) n9 [7 U0 s  {5 T  z7 F- |
7184.     (if (not (new_dialog "ddleader" dcl_id)) (exit))
      
7185.     ;; Set initial tile values
      8 c! D! E: z- f% M$ \
7186.     (set_tile_props)
      
7187.     (set_dimen_props)
      
7188.     (set_tile_handle)
      
7189.     ;; Define action for tiles
      
7190.     (set_action_tiles)
      
7191.     (mode_tile "mod_text" 1)
      1 H) W6 ~" {3 C+ f5 u6 R7 V
7192. 
      
7193.     (action_tile "mod_style" "(setq dimsty (ddimen_style))")
      
7194.     (action_tile "accept" "(setq leadtype (get_tile \"s-s\"))(setq arrow (get_tile \"arrow\"))(done_dialog 1)")
      
7195.     ;; Get ARROW and TYPE.
      
7196.     (if (= 1 (logand (cdr (assoc '71 elist)))) (set_tile "arrow" "1"))
      0 }: U, t* r4 ?0 i1 y' \- h
7197.     (if (= 1 (logand (cdr (assoc '72 elist))))
      
7198.       (set_tile "s-s" "spline")
      & T9 ~. C0 o0 S$ z
7199.       (set_tile "s-s" "straight")
      
7200.     )
      $ w! H3 S; e# ^# R
7201.     ;; Start the dialogue.
      $ F) G" ~6 v; q7 B: Y
7202.     (setq dialog-state (start_dialog))
      / T: p7 u6 E4 W3 f+ O6 W
7203.     (if (= dialog-state 1)
        m; W% p5 v9 r/ l! w. y7 s
7204.       (progn
      3 v! @7 U! o- h8 g/ }" R
7205.         ;; update the style
      + K  C9 P1 L9 ]5 [
7206.         (if (/= dimsty stname)
      
7207.           (progn
      ' U. a  _8 [, i# x: m* ~9 I3 Z
7208.             ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
      
7209.             ; doesn't have it.
      ( l* F+ s' X3 K! }  ^- u
7210.             (if (null (assoc 3 elist))
      5 h, N" _( A8 h; f% I" W$ ?
7211.               (setq elist (append elist (list (cons 3 dimsty))))
      : ?" S4 E5 A" Q8 _% I+ v6 B
7212.               ; else just replace it.
      $ t2 L" ^3 D/ W0 J
7213.               (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
      
7214.             )
      ) c' |4 f  F# u3 Z( X1 F' G
7215.             ; refresh sv_dvlist with new dimstyle.
      6 t) F0 p' m& N* e2 g
7216.             (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      
7217.           )
      # b4 M1 C5 P" ^, j- Y$ }
7218.         )
      
7219.         (if (not (null dimlist))   ; attempted to change dimvars
      " j! M  y/ L6 T2 X5 Z; ~
7220.           (ddimen_complist sv_dvlist dimlist dimtbl)
      
7221.         )
      ' i9 \% {5 n3 c* {( \
7222.         ;; update for ARROW.
      
7223.         (if (= "1" arrow)
      5 `4 O$ h* k: x! A4 a
7224.           (setq elist (subst (cons 71 (logior 1 (cdr (assoc 71 elist)))) (assoc 71 elist) elist))
      
7225.           (setq elist (subst (cons 71 (logand (~ 1) (cdr (assoc 71 elist)))) (assoc 71 elist) elist))
      
7226.         )
      
7227.         ;; update the TYPE.
      
7228.         (if (= "spline" leadtype)
      8 s# {5 L0 U- q# y
7229.           (setq elist (subst (cons 72 (logior 1 (cdr (assoc 72 elist)))) (assoc 72 elist) elist))
      
7230.           (setq elist (subst (cons 72 (logand (~ 1) (cdr (assoc 72 elist)))) (assoc 72 elist) elist))
      6 D3 g9 i. \% t4 f: z+ q4 Q
7231.         )
      
7232.         (modify_prop_geom)
      
7233.         ;; update the Color
      0 f. o8 R$ M7 v9 F
7234.         (setq elist (subst (cons 77 ecolor) (assoc 77 elist) elist))
      & n/ T* g$ z/ F& v) q
7235.         (entmod elist)
      * J7 ]' i3 P% T/ x. K. v# N8 x1 q' J
7236.       )
      7 k6 J9 Q0 R' a; |
7237.     )
      . I: ?$ h3 X1 U3 ?$ z
7238.     (ddimen_setvars dimsvcurset)      ; Prepare to exit
      2 {5 V- a$ W- o; C7 n- R
7239.   )
      + D- l: C0 v, N9 f4 [1 D
7240. 
      ' S/ r  x+ `+ ?2 o  Y6 J1 \
7241.   ;;
      
7242.   ;; Get dimvars of a dimstyle with overrides.
      
7243.   ;;
      9 e! {2 |9 ~: c5 o7 ^% B
7244. 
      9 \$ |; ?& A. L. b0 j5 f7 d
7245.   (defun ddimen_getdimvars (dimsty / dimovr dvlist elm i)
      
7246. 
      ( N1 o( k' P/ v% |( X
7247.     ;; Get override information for the specified entity.
      ; L& f& ]8 k! L: U+ h
7248.     ;; Leader/Tolerance cannot be restored by DIMSTYLE command, so we
      
7249.     ;; must obtain override information through this tedious operation.
      
7250.     (setq dimovr (car (cdr (assoc -3 (entget (cdr (assoc -1 elist)) (list "*")))))
      9 e) l4 i' d: y
7251.           dvlist (tblsearch "dimstyle" dimsty)
      3 G4 h  L; a5 u# I1 N
7252.           i 2
      + x  Y7 z9 c- g
7253.     )
      
7254. 
        [5 j. g0 `: w3 v
7255.     ; Update the list with overrides if overrides exist.
      % Z2 K4 |1 Z- s( S- k2 p/ q: G
7256. 
      & b6 h; f: K6 I, q+ q. ]! R! `0 A
7257.     (if (and dimovr (= "DSTYLE" (cdr (nth 1 dimovr))))
      
7258.       (progn
      
7259.         (while (setq elm (cdr (nth i dimovr)))
      * k! g, P! B0 E
7260.           (progn
      
7261.             (if (or (= elm "{") (= elm "}"))
      . E4 G$ }) I9 C5 y- a2 F# ]  |
7262.               (setq i (1+ i))
      
7263.               (progn
      5 }" [! E/ q1 N/ a& K3 r- B/ p# E- L
7264.                 (if (or (and (< 180 elm)
      
7265.                              (< elm 190)
      + D/ m( b+ x+ q
7266.                         )
      
7267.                         (and (< 80 elm)
      " U+ O( R, i) M& p$ b
7268.                              (< elm 90)
      
7269.                         )
      
7270.                     )
      # f: C5 A3 C9 p3 i  D
7271.                   (setq elm (- elm 10))
      
7272.                 )
      0 R  g1 W" B' A7 S) v+ F: k
7273.                 (setq i (1+ i)
      
7274.                       elm (cons elm (cdr (nth i dimovr)))
      * F% P+ h- z- b; ?4 O: u, x
7275.                       dvlist (subst elm (assoc (car elm) dvlist) dvlist)
      
7276.                       i (1+ i)
      8 ^5 ]$ H. g6 M# B  y3 R& f# v
7277.                 )
      
7278.               )
      
7279.             )
      + k: i  Y/ z+ ?8 L$ i3 ~' B
7280.           )
      $ O$ L7 j* h) Z) E; Y
7281.         )
      
7282.       )
      * |; o6 J) X  \/ e1 `7 g# u
7283.     )
      
7284.     dvlist
      
7285.   )
      
7286. 
      , O- a" h' O+ ^" W& a2 P6 B& M% ^
7287.   ;;
      
7288.   ;; Modify POINT
      
7289.   ;;
      ! I; C$ a* o1 l7 X
7290.   (defun modify_point ()
      & w. o0 h; y+ [" G
7291.     (modify_properties)
      8 g3 N" M6 H9 x6 D( o" @
7292.     (setq pt1 (list x1 y1 z1))
      % z) V8 M* @/ b1 U
7293.     (tempmod pt1 10 0)
      
7294.     (entmod elist)
      - ^7 C0 W0 Q4 M/ q$ a
7295.   )
      
7296. 
      ! T4 K# n+ J& w2 }% t/ @
7297.   (defun ddpoint ()
      - R* m" s/ b$ n' E& M
7298.     (if (not (new_dialog "ddpoint" dcl_id)) (exit))
      ; [9 z0 r  K; {
7299.     ;; Set initial tile values
      % Q0 g9 |# X% B3 J5 |
7300.     (set_tile_props)
      4 c3 ~4 _5 F3 `& [2 _5 ~" i5 X
7301.     (set_tile_handle)
      $ Y; F/ d+ x4 o% W  C- @
7302.     (set_tile_pt1 0)
      
7303.     ;; Define action for tiles
      
7304.     (set_action_tiles)
        M! ?, O/ t3 _8 r, ?8 A
7305.     (setq dialog-state (start_dialog))
      
7306.     (if (= dialog-state 0)
      
7307.       (reset)
      
7308.     )
      
7309.     (if (= dialog-state 3)
      
7310.       (progn
      
7311.         (modify_point)
      1 T  d; s, U' M
7312.         (setq pt1 (getpoint (list x1 y1 z1)  "\nPoint: "))
      
7313.         (ver_pt1 0)
      ; L6 o- q) ~: {+ `
7314.         (ddpoint)
      
7315.       )
      
7316.     )
      
7317.     (if (= dialog-state 1)
      * w" \( [4 }% ?! Z7 q& N
7318.       (modify_point)
      : U' D% Y5 a+ i  u
7319.     )
      
7320.   )
      ' z% k* w8 f7 a
7321.   ;;
      
7322.   ;; Modify LINE
      
7323.   ;;
      
7324.   (defun modify_line ()
      
7325.     (modify_properties)
      0 _' @! E6 B" `4 M1 M. l
7326.     (setq pt1 (list x1 y1 z1))
      % a2 f# f; O0 G, X: f9 u: {
7327.     (setq pt2 (list x2 y2 z2))
      $ V; I; P5 w+ }
7328.     (tempmod pt1 10 0)
      
7329.     (tempmod pt2 11 0)
      
7330.     (entmod elist)
      : j4 {5 j, B' }% R& K, \4 b+ T
7331.   )
      2 |# Y, f8 O. y9 W/ \* q
7332.   (defun ddline ()
      
7333.     (if (not (new_dialog "ddline" dcl_id)) (exit))
      + H. G5 Q) L) B' T0 ~+ E  z
7334.     ;; Set initial tile values
      
7335.     (set_tile_props)
      * I6 b/ Z; u6 n# B3 ?
7336.     (set_tile_handle)
      
7337.     (set_tile_pt1 0)
      / S- {: W/ K8 z- L) J7 F& {
7338.     (set_tile_pt2 0)
      : ?; m$ E- E1 B% ^
7339.     (line_calc)
      
7340.     ;; Define action for tiles
      
7341.     (set_action_tiles)
      ' }! c+ q% {$ S+ N
7342.     (setq dialog-state (start_dialog))
      2 X  w# n9 f1 |; Z0 {1 M" T
7343.     (if (= dialog-state 0)
      : S6 H# k. t: U" r
7344.       (reset)
      . u0 t6 D! ]: Q" I; A
7345.     )
      : T. e) h2 l; v5 T+ }
7346.     (if (= dialog-state 3)
      . R9 H' F' e# q6 h; T* l7 l/ k$ f7 O2 S
7347.       (progn
      ! t$ }2 v+ k* a: k
7348.         (modify_line)
      # o+ h& k$ q5 [: ~2 t& H6 I
7349.         (setq pt1 (getpoint (list x2 y2 z2)  "\nFrom point: "))
      3 Q5 r0 a' k: q* O
7350.         (ver_pt1 0)
      
7351.         (ddline)
      - q# c  ?$ }8 |5 l' ]
7352.       )
      
7353.     )
      
7354.     (if (= dialog-state 4)
      6 c& e, Q7 m, R; F2 l
7355.       (progn
      + a( k4 M$ P" _" ?+ |. m
7356.         (modify_line)
      
7357.         (setq pt2 (getpoint (list x1 y1 z1) "\nTo point: "))
      2 V/ [; G3 f/ K# \( K- e  W
7358.         (ver_pt2 0)
      
7359.         (ddline)
      # y6 e$ S8 m. j+ f0 v* C9 t' p
7360.       )
      
7361.     )
      8 Y( e* F" a3 ]
7362.     (if (= dialog-state 1)
      9 @. b- z; L) ^
7363.       (modify_line)
      
7364.     )
      0 Q8 f* u& P$ o$ V* q1 E. w
7365.   )
      
7366.   ;;
      
7367.   ;; Modify MLine
      $ S& F$ x" V/ V& b' b2 \: r
7368.   ;;
      
7369.   (defun modify_mline ()
      
7370.     (modify_properties)
      $ w# }- P2 ~. z' ?' C9 O1 ]
7371.     (entmod elist)
      0 W# _4 `( i4 f! w( _3 E1 z+ a% j
7372.   )
      
7373.   (defun ddmline ()
      9 t2 }; P6 a$ i) H1 t
7374.     (if (not (new_dialog "ddmline" dcl_id)) (exit))
      
7375.     ;; Set initial tile values
      
7376.     (set_tile_props)
      
7377.     (set_tile_handle)
      5 v2 b8 d1 M4 t. f+ o
7378.     ;; Set mline style text field.
      
7379.     (set_tile "ml_style" (cdr (assoc '2 elist)))
      
7380. 
      * q5 J( E3 F# F+ G
7381.     ;; Define action for tiles
      
7382.     (set_action_tiles)
      
7383.     (action_tile "ml_edit" "(done_dialog 3)")
      9 s; M9 h7 W) t; {# p' n$ A$ d# f, W
7384.     (setq dialog-state (start_dialog))
      % e% U5 K% F3 a6 ?# m
7385.     ;; Dialog cancelled, reset to original values.
      9 @1 }  k) m6 D% L% D/ p
7386.     (if (= dialog-state 0)
      
7387.       (reset)
      
7388.     )
      
7389.     ;; Dialog OKed, update the mline.
      6 x1 O! a$ l9 O  n
7390.     (if (= dialog-state 1)
      
7391.       (modify_mline)
      0 D! c  r; q" R: `0 w& K; _- ~5 g
7392.     )
      
7393.     ;; Edit Mline, call MLEDIT.
      
7394.     (if (= dialog-state 3)
      
7395.       (progn
      
7396.         (modify_mline)
      0 I0 F4 J; ^7 h! Z' f4 S! C
7397.         (command "_mledit")
      * m# I' l7 m& l/ m
7398.         (ddmline)
      
7399.       )
      
7400.     )
      - K7 E/ {/ s# z( h
7401.   )
      
7402.   ;;
      
7403.   ;; Modify Xline
        T) S- [, s2 X
7404.   ;;
      
7405.   (defun modify_xline (flag)
      ; f  w4 i' \6 N% y" U
7406.     (modify_prop_geom)
      6 x, _: ~3 a4 P
7407.     (setq xline_pt1 (list xline_x1 xline_y1 xline_z1))
      . G8 x1 d  P0 R) P, i) ~2 y! E  U9 g
7408.     (setq xline_pt2 (list xline_x2 xline_y2 xline_z2))
      4 i' [" Z& P4 f2 T! J) S& S& p
7409.     ;; Update the Root point.
      8 `5 d/ N1 Q1 g) v0 ?+ k0 D
7410.     (setq elist (subst (cons 10 (trans xline_pt1 1 0))
      
7411.                        (assoc 10 elist)
      ( W* ~9 f$ C/ l
7412.                        elist
      
7413.                 )
      
7414.     )
      - O: v% ]; Q* T! E8 J) g
7415.     ;;
      
7416.     ;; Calculate new Direction Vector WCS
      - D$ o$ m, b9 J/ L- T4 M
7417.     ;; x / (sqrt ( (x**2) + (y**2) + (z**2)     ))
      
7418. 
      6 _' A7 M! }4 C4 ~: w5 t
7419.     (setq temp_dir (trans xline_pt2 1 0))
      - C3 e" e4 o: G) x: P
7420.     (setq temp_dir_x (car temp_dir))
      
7421.     (setq temp_dir_y (cadr temp_dir))
      
7422.     (setq temp_dir_z (caddr temp_dir))
      : `8 T2 F/ A0 `. Z# z9 k9 a
7423. 
      
7424.     (setq temp_xline_pt1 (trans xline_pt1 1 0))
      
7425.     (setq temp_xline_x1 (car temp_xline_pt1))
      ' S' r% j% u4 F8 E# M+ U* _
7426.     (setq temp_xline_y1 (cadr temp_xline_pt1))
      2 N+ z' q6 N4 A: H3 e" E. R
7427.     (setq temp_xline_z1 (caddr temp_xline_pt1))
      
7428. 
      ! i2 o8 E' `6 ?4 P0 a5 v  C4 ?
7429.     (setq denom (sqrt (+ (expt (- temp_dir_x temp_xline_x1) 2)
      
7430.                          (expt (- temp_dir_y temp_xline_y1) 2)
      
7431.                          (expt (- temp_dir_z temp_xline_z1) 2)
      
7432.     )))
      
7433.     (setq temp_dir_x (/ (- temp_dir_x temp_xline_x1) denom))
      
7434.     (setq temp_dir_y (/ (- temp_dir_y temp_xline_y1) denom))
      
7435.     (setq temp_dir_z (/ (- temp_dir_z temp_xline_z1) denom))
      
7436.     (setq elist (subst (cons 11 (list temp_dir_x temp_dir_y temp_dir_z))
      
7437.                        (assoc 11 elist)
      
7438.                        elist
      $ n- O0 ]' A7 X# `
7439.                 )
      
7440.     )
      # `! |' u0 E; G- T
7441.     (if (= 1 flag)
      
7442.       (entmod elist)
      
7443.     )
      
7444.   )
      
7445. 
      
7446.   (defun ddxline ()
      * q3 }$ c- `+ w
7447.     (if (= etype "XLINE")
      
7448.       (if (not (new_dialog "ddxline" dcl_id)) (exit))
      
7449.       (if (not (new_dialog "ddray" dcl_id)) (exit))
      
7450.     )
      
7451.     ;; Set initial tile values
      
7452.     (set_tile_props)
      ) M; Y& S. h" W$ H) z3 Y
7453.     (set_tile_handle)
      
7454.     (set_tile_xline_pt1)
      6 @6 V& g- N6 F1 n
7455.     ;; Convert to UCS and post Direction vector.
      
7456.     (set_tile_dirv)
      ! d( `2 }, Z5 B$ c0 M$ x
7457.     ;; Calculate second point by adding Root Point + Direction Vector.
      
7458.     (set_tile_xline_pt2)
      
7459.     ;; Define action for tiles
      0 i' I5 |! a6 ^% m. }
7460.     (set_action_tiles)
      5 k! G) l8 @* ]! U$ v" z: \
7461.     (setq dialog-state (start_dialog))
      ; N- Y0 A: i+ p7 b6 i
7462.     (if (= dialog-state 0)
      
7463.       (reset)
      % r' I9 i. d9 C" u7 m$ P" i/ K
7464.     )
      
7465.     (if (= dialog-state 3)
      
7466.       (progn
      + }' B$ z9 N: r6 v+ l" V5 o
7467.         (modify_xline 1)
      5 M% o& D- K& Q7 {5 t+ _' V2 U9 I
7468.         (while (equal xline_pt2
      " o& E7 C# l0 _: A' b
7469.           (setq xline_pt1 (getpoint xline_pt2 "\nRoot point: ")) 0.000001)
      
7470.           (princ "The Root point cannot equal the Second point.")
      % h5 A' {5 n" S+ v) o* r2 C
7471.         )
      
7472.         (ver_xline_pt1)
      
7473.         (ver_xline_pt2)
      
7474. (princ)
      
7475.         (ddxline)
      . M5 Q7 a5 `2 J; g! E9 R
7476.       )
      
7477.     )
      . ]- v8 m* `5 a
7478.     (if (= dialog-state 4)
      8 g# g8 q6 Y: M" @* c$ ~9 \
7479.       (progn
      
7480.         (modify_xline 1)
      1 C" H! k1 V# N! A9 Z
7481.         (while (equal xline_pt1
      
7482.           (setq xline_pt2 (getpoint xline_pt1 "\nSecond point: ")) 0.000001)
      
7483.           (princ "The Second point cannot equal the Root point.")
      
7484.         )
      " T/ E. K9 F  q# M" V0 C: z
7485.         (ver_xline_pt2)
      + U0 u& u$ n: Y, C3 M
7486. (princ)
      
7487.         (ddxline)
      
7488.       )
      1 ]. W! ?  y  z( b. @+ u
7489.     )
      5 N  ]! t& O1 M
7490.     (if (= dialog-state 1)
      
7491.       (modify_xline 1)
      
7492.     )
      
7493.   )
      1 r+ E* c2 f$ H7 d! u$ F2 o
7494.   ;;
      5 `! Z" b8 f( g" e1 F/ ^
7495.   ;; Modify ELLIPSE
      
7496.   ;;
      
7497.   (defun modify_ellipse ()
      : A2 t# B: Q# G& o# I4 z
7498.     (modify_prop_geom)
      , Z: v) w2 N2 }0 j  q/ J- s
7499.     ;; Update Ellipse Center Point value.
      
7500.     (setq pt1 (list x1 y1 z1))
      0 o# `- C& a/ z7 K$ M
7501.     (tempmod pt1 10 1)
      1 R4 _% b* ]# x
7502.     ;; Update Start Parameter value.
      ( a* F% A8 Q5 c, d4 V) m
7503.     (setq y_val (sin st_ang))
      
7504.     (setq x_val (* rrat (cos st_ang)))
      
7505.     (setq stparm (atan y_val x_val))
      
7506.     (setq elist (subst (cons 41 stparm) (assoc 41 elist) elist ))
      $ d( D& a" q! r4 o# p
7507.     ;; Update End Parameter value. Normalize it, if it's less than
      8 a  J$ Z6 m! [8 v2 C+ @
7508.     ;; the start parameter.
      7 W' R0 V' h0 R* P6 [! g
7509.     (setq y_eval (sin end_eang))
      0 @$ o' G% ?, t( L4 d6 b
7510.     (setq x_eval (* rrat (cos end_eang)))
      
7511.     (setq endparm (atan y_eval x_eval))
      6 O' _( B7 f  @% T  r
7512.     (setq diffparm (- endparm stparm))
      7 L$ s5 c1 s" Q  n9 }& D9 a
7513.     ;; Epsilon of 1.0e-6 radians for checking a zero length arc.
      
7514.     ;; Since zero length arcs are not allowed - construct the full
      
7515.     ;; ellipse in this case.
      # N) N& M( _) p9 b, D$ a. H
7516.     (if (<= (* diffparm diffparm) 1.0e-12)
      
7517.         (setq endparm (+ stparm (* 2 pi)))
      3 w+ _( L3 [  L3 O
7518.     )
      
7519.     (if (<= endparm stparm)
      6 B5 ]0 C6 f; S( `$ u9 X* ~6 n
7520.         (setq endparm (+ endparm (* 2 pi)))
      0 B8 ]3 K' B" B
7521.     )
      6 j' p! _" M4 \# o2 H
7522.     (setq elist (subst (cons 42 endparm) (assoc 42 elist) elist ))
      * F2 [/ B: g5 C; i$ z0 N5 g
7523.     ;; Calculate the Major Axis Vector by first calculating
      
7524.     ;; a unit vector using the old Major Radius value. Then
      
7525.     ;; Multiplying that by the (possibly) new Major Radius
      , C* t, h1 F$ d' V* x# r1 A4 W
7526.     ;; value to get the new Major Axis Vector value.
      1 Z8 s% ?, O0 t9 _" ~9 O
7527.     (setq unitxx (/ xx old_majrad))
      
7528.     (setq unityy (/ yy old_majrad))
      - \4 d2 r. ]6 N, H+ {0 F& |
7529.     (setq unitzz (/ zz old_majrad))
      ' L7 g- C& {0 D8 q
7530.     (setq newvecxx (* unitxx majrad))
      4 P- }) }2 Q# [
7531.     (setq newvecyy (* unityy majrad))
      
7532.     (setq newveczz (* unitzz majrad))
      
7533.     (setq newmajaxis (list newvecxx newvecyy newveczz))
      
7534.     ;; Update Major Axis Vector value
      
7535.     (setq elist (subst (cons 11 newmajaxis) (assoc 11 elist) elist ))
      # P8 k) d! B. p9 ]; E$ D; S2 F
7536.     ;; Update Radius Ratio value
      4 k( g5 e8 M0 v1 G  R7 ]
7537.     (setq elist (subst (cons 40 rrat) (assoc 40 elist) elist ))
      
7538.     (entmod elist)
      ! e8 U* u; b& U7 x3 u' h3 a7 ?. u: h
7539.   )
      ' o* R: ^  V4 b  S
7540. 
      
7541.   (defun ddellipse ()
      - y* f1 O: w: r0 E9 O
7542.     (if (not (new_dialog "ddellipse" dcl_id)) (exit))
      
7543.     ;; Set initial tile values
      
7544.     (set_tile_props)
      ) V# c- B4 M5 x
7545.     (set_tile_handle)
      
7546.     (set_tile_pt1 1)
      
7547.     (ell_calc)
      / |1 l' K, v3 w7 i  v6 `) J
7548.     ;; Define action for tiles
      * ~$ D; ?& z! r# {
7549.     (set_action_tiles)
      
7550.     (setq dialog-state (start_dialog))
      9 F0 R9 x" |  b" @% ?/ T
7551.     (if (= dialog-state 0)
      5 ]+ L- N, ?1 d0 a
7552.       (reset)
      ' |3 ^5 f9 A5 q$ s* S9 e8 |
7553.     )
        B5 F* Y, K; [, \
7554.     (if (= dialog-state 1)
      % x# p) V) q+ S1 g. I. k8 g
7555.       (modify_ellipse)
      ) f9 h$ z4 h# K1 G# A- L& X  A
7556.     )
      3 |! N$ v2 W8 d0 m, s
7557.     (if (= dialog-state 3)
      
7558.       (progn
      2 O( ?' k) j9 s  k
7559.         (modify_ellipse)
      9 E9 `- W6 w7 O* T
7560.         (setq pt1 (getpoint (list x1 y1 z1)  "\nCenter point: "))
      5 p" \' x- V8 D, ~  V
7561.         (ver_pt1 1)
      ( w9 X, N! s; T# @
7562.         (ddellipse)
      0 ]5 x! Y7 D0 M% r, p, V
7563.       )
      , y4 I9 w; \4 R% j8 L9 u- |, f
7564.     )
      
7565.   )
      
7566.   ;;
      
7567.   ;; Modify REGION
      7 r  T& S4 U, R  Z) P; Z6 B
7568.   ;;
      
7569.   (defun modify_region ()
      
7570.     (modify_prop_geom)
      4 V2 V" ?+ m7 z- G
7571.     (entmod elist)
      8 k: f" u* r3 J
7572.   )
      
7573. 
      
7574.   (defun ddregion ()
      
7575.     (if (not (new_dialog "ddregion" dcl_id)) (exit))
      6 b# w& ]! |0 `/ O( a; t; U& h8 O
7576.     ;; Set initial tile values
      3 ^3 n. d: D) i# N/ b( K* Z" J
7577.     (set_tile_props)
        [+ j; `  R, [4 }) k
7578.     (set_tile_handle)
      
7579.     ;; Define action for tiles
      * E. m! l5 B8 K& j' F. [+ G" k& ~6 S8 j
7580.     (set_action_tiles)
      2 l3 x; ^# e8 A
7581.     (setq dialog-state (start_dialog))
      - N2 C1 d# E8 A( T5 ~4 Y7 n# A, k
7582.     (if (= dialog-state 0)
      3 w" F1 F( I" {; e; Y
7583.       (reset)
      
7584.     )
      2 M3 E( i% f/ @2 t; B# O1 A+ B
7585.     (if (= dialog-state 1)
      5 r6 c2 u7 p5 ^* T
7586.       (modify_region)
      
7587.     )
      
7588.   )
      
7589.   ;;
      
7590.   ;; Modify 3DSOLID
      * }1 q" y, y( t9 y, J
7591.   ;;
      3 s" c3 D( u8 g/ ~% v( c
7592.   (defun modify_3dsolid ()
      # M  n5 Q4 v& m: K+ A
7593.     (modify_prop_geom)
      , X7 W" E8 D0 ?( s# r9 U
7594.     (entmod elist)
      
7595.   )
      . P2 s% x) g& u* S& I. e. o
7596. 
      : |& P+ H$ R) h1 W0 u0 g. f
7597.   (defun dd3dsolid ()
      
7598.     (if (not (new_dialog "dd3dsolid" dcl_id)) (exit))
      
7599.     ;; Set initial tile values
      % o% c6 J3 ?  i5 m
7600.     (set_tile_props)
      5 |' X% G4 j" J9 F$ ?4 E# }
7601.     (set_tile_handle)
      
7602.     ;; Define action for tiles
      * T7 {2 F3 ]+ B. {# m  A( X9 u8 w
7603.     (set_action_tiles)
      / d! s+ @7 N' K. U1 i" \
7604.     (setq dialog-state (start_dialog))
      
7605.     (if (= dialog-state 0)
      
7606.       (reset)
      2 l, o1 Q: E' U5 c+ A
7607.     )
      
7608.     (if (= dialog-state 1)
      & x! a+ N7 M1 Y* O7 }7 }
7609.       (modify_3dsolid)
      
7610.     )
      : k' a( C. e. l1 t
7611.   )
      
7612.   ;;
      
7613.   ;; Modify AcDbHatch
      9 b$ ?9 I( g- [( Z2 R  H
7614.   ;;
      5 `9 Q' v  U1 ^& g* x2 d; Z
7615.   (defun modify_hatch ()
      
7616.     (modify_prop_geom)
      
7617.     (entmod elist)
      
7618.   )
      
7619. 
      
7620.   (defun ddnewhatch ()
      . b6 i$ I9 n0 }0 v
7621.     (if (equal hatch-elist nil)
      
7622.          (setq hatch-elist old-elist)
      . I& Y' ^7 ]6 D. I8 B
7623.     )
      1 G( O" n, M* q9 m" ], X5 z& B
7624. 
      : i. c) n. M$ [8 Z
7625.     (if (not (new_dialog "ddnewhatch" dcl_id)) (exit))
      
7626. 
      
7627.     ;; disable the thickness tile
      4 c6 q) s5 ~& I- K3 s9 p/ w
7628.     (mode_tile "eb_thickness" 1)
      
7629.     (mode_tile "e_thickness" 1)
      % X3 T# I% M& c2 N1 R- Y; c
7630. 
      
7631.     (setq help_entry "modify_associative_hatch_dialog")
      
7632.     (set_tile_props)
      3 R/ t6 k( k& p* \
7633.     (set_tile_handle)
      : {) e! C- |8 T$ N' [. w2 Q6 |
7634. 
      
7635.     ;; Define action for tiles
      * b3 M/ [  H7 F$ Q. F
7636.     (set_action_tiles)
      
7637.     (action_tile "b_hatch" "(done_dialog 2)")
      
7638.     (setq dialog-state (start_dialog))
      
7639.     (cond
      
7640.        (  (eq dialog-state 0)
      1 e+ s5 E$ F) p9 F
7641.           (setq old-elist hatch-elist)
      
7642.           (setq hatch-elist nil)
      " J% e- I- m1 d, t4 ~) z. f
7643.           (if (= (checkforlockedlayer ename) nil)
      
7644.              (reset)
      
7645.              (progn         ;;; special handling for locked layer reset
      
7646.                 ;; unlock the layer
      
7647.                 (setq layername (cdr (assoc 8 (cdr (entget ename)))))
      ' e% ~! @& }! c: [2 t
7648.                 (command "_.-LAYER" "_Unlock" layername "")
      8 b! t% @" [1 l2 {% U7 k- T% i
7649.                 ;; reset modifiction
      9 D* N  G. F: X* R( B+ _  E% |* x" E
7650.                 (reset)
      
7651.                 ;; lock the layer again
      1 l- s# p6 V, Q; W8 W  O
7652.                 (command "_.-LAYER" "_Lock" layername "")
      
7653.             )
      + P: S: X# o  q9 p% F( p9 V7 |; h
7654.           )
      
7655.           nil       ;;; makes (ddnewhatch) return nil for Cancel
      
7656.        )
      
7657.        (  (eq dialog-state 1)
      
7658.           (setq hatch-elist nil)
      
7659.           (modify_hatch)
      
7660.           T         ;;; makes (ddnewhatch) return T for Ok
      
7661.        )
      1 u# i) T! a) F/ B& z7 k) I9 p
7662.        (  (eq dialog-state 2)
      
7663. 
      # Y+ a  Q  ?" t
7664.           (if (= (cdr (assoc 70 (tblsearch "LAYER" elayer)))
      
7665.                  4
      ' W7 d" @/ V; J( x, V, w- G
7666.               )            
      - D6 [$ P" d, [0 W5 C' S2 @. L
7667.               ;;; new selected layer is on a locked layer
        Q9 M' X9 `7 ]+ I( f
7668.               ;;; we can simply modify the hatch properties
      $ l) v/ I) H1 X: k( l
7669.               (modify_hatch)
      
7670.               (progn
      
7671.                     (if (= (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (cdr elist))))))
      9 ?5 j# X% i9 C$ y" Q/ \
7672.                             4
      " M  {- X  i0 M) g/ Z. u
7673.                         )           
      4 L' K4 L/ _0 Z8 |3 W
7674.                         ;;; We changed the layer previously and now the hatch lies on a locked layer.
      
7675.                         ;;; We have to unlock the layer forethat we can update the hatch properties.
      6 C! n- s5 z! d: K4 f9 F
7676.                         ;;; If we don't do that (entmod) fails to update to the new layer.
      & u1 w; c6 y( l4 ~
7677.                         (progn
      
7678.                             (setq layername (cdr (assoc 8 (cdr elist))))
      
7679.                             (command "_.-LAYER" "_Unlock" layername "")     ;;; unlock the layer
      
7680.                             (modify_hatch)                                  ;;; update the properties
      ! c/ a0 E, h% V  @* A( X+ {& Y
7681.                             (command "_.-LAYER" "_Lock" layername "")       ;;; lock the layer again
      
7682.                         )
      8 r' o9 g9 v6 u* d; y
7683.                         ;;;  All other cases we simply update the properties
      , H! Y, l5 j4 ^; x
7684.                         (modify_hatch)
      
7685.                     )
      / e& y6 `& ~7 R, X. Q2 m
7686.               )
      
7687.           )
      
7688.           (if (= (checkforlockedlayer ename) nil)
      1 @; c' H  ~' }
7689.               (command "_hatchedit" ename)
      : P: L" e5 o/ n4 D$ u
7690.               (alert ;|MSG111|;"The hatch object is on a locked layer.")
      
7691.           )
      
7692.           (ddmodify ename)
      ' R- X% T: U$ I# n3 j
7693.        )
      
7694.     )
      ! _4 N( f4 d* a
7695.   )
      
7696.   ;;
      $ q- u: J* `4 m5 u
7697.   ;; Modify BODY
      5 N4 Z8 y- U% i7 W/ b" n! `  f% _
7698.   ;;
      
7699.   (defun modify_body ()
      
7700.     (modify_prop_geom)
      
7701.     (entmod elist)
      : a; t1 I# y' l4 z
7702.   )
      # t- q% ~% V7 @% K0 L# s
7703. 
      
7704.   (defun ddbody ()
      
7705.     (if (not (new_dialog "ddbody" dcl_id)) (exit))
      5 T8 E) M# f8 o3 G& J5 n+ C
7706.     ;; Set initial tile values
      
7707.     (set_tile_props)
      
7708.     (set_tile_handle)
      
7709.     ;; Define action for tiles
      # X- X4 c; x6 C4 i
7710.     (set_action_tiles)
      ; }* p( a  n) L) N1 m* ^3 b# |0 K
7711.     (setq dialog-state (start_dialog))
      9 M. A6 f. ?7 k) n- ~
7712.     (if (= dialog-state 0)
      
7713.       (reset)
      * n4 K- F6 G0 H! Z9 |
7714.     )
      # W$ H" t8 V9 R3 x, Z
7715.     (if (= dialog-state 1)
      . E! u' M: P# T" G% i9 N8 X2 m! v: `% [
7716.       (modify_body)
      
7717.     )
      
7718.   )
      ; O" s9 s/ @9 }
7719.   ;;
      
7720.   ;; Modify CIRCLE
      + M" [/ U' F8 x0 W. X
7721.   ;;
      
7722.   (defun modify_circle ()
      . s7 w4 n, ^, v$ F2 o
7723.     (modify_properties)
      
7724.     (setq pt1 (list x1 y1 z1))
      
7725.     (tempmod pt1 10 1)
      " [9 x3 S" }% p& |% Q" f9 x) k
7726.     (tempmod radius 40 nil)
      
7727.     (entmod elist)
      # {4 O, N7 h* j/ Q
7728.   )
      
7729. 
      
7730.   (defun ddcircle ()
      4 @5 E2 L% h5 }- d% W
7731.     (if (not (new_dialog "ddcircle" dcl_id)) (exit))
      ! S$ L4 r( v7 u! U
7732.     ;; Set initial tile values
      3 J# b* O/ Q) q+ C7 F1 k: i
7733.     (set_tile_props)
      4 D. S$ s$ o$ s: ?  T
7734.     (set_tile_handle)
      
7735.     (set_tile_pt1 1)
      : ^/ S# h( ]- X6 a5 c4 E
7736.     (set_tile_rad)
      ; k  r+ \9 y8 H- j
7737.     (cir_calc)
      5 H' D# u3 b$ K$ A; b, }0 z
7738.     ;; Define action for tiles
      
7739.     (set_action_tiles)
      ) p8 K) T* d- \' k; r9 T  T
7740.     (set_tile_pt1 1)
      ! J0 ~3 v* V1 I; c( Q% v8 x
7741.     (setq dialog-state (start_dialog))
      
7742.     (if (= dialog-state 0)
      
7743.       (reset)
      . S0 {  x. n( m) U0 w
7744.     )
      % f+ k+ j- L: W* J
7745.     (if (= dialog-state 1)
      * o8 _. X6 X+ H
7746.       (modify_circle)
      " W# \! |; r1 Q  v/ k
7747.     )
      , t  P7 l: i# R. l0 r
7748.     (if (= dialog-state 3)
      ( B' l/ F0 |/ H
7749.       (progn
      3 ]3 B. W, f  B7 a! y" n( [/ O
7750.         (modify_circle)
      
7751.         (setq pt1 (getpoint (list x1 y1 z1)  "\nCenter point: "))
      & @; _* `* L7 K8 Q* B9 c
7752.         (ver_pt1 1)
      
7753.         (ddcircle)
      
7754.       )
      
7755.     )
      
7756.   )
      
7757.   ;;
      ( K9 A! V' b" g& [
7758.   ;; Modify ARC
      - T: {" ~0 m* Z- r# p6 b; z* P* f
7759.   ;;
      
7760.   (defun modify_arc ()
        o2 f3 n+ X* o0 z$ t  D- T( q8 ~  F
7761.     (modify_properties)
      % R. k& R5 p* m3 c
7762.     (setq pt1 (list x1 y1 z1))
      
7763.     (tempmod pt1 10 1)
      
7764.     (tempmod radius 40 nil)
      7 Y! d# @! `2 U4 t
7765.     (tempmod st_ang 50 nil)
      . t- O( L& w9 a; I
7766.     (tempmod end_ang 51 nil)
      5 N/ H3 t$ A+ C0 g) c! c
7767.     (entmod elist)
      
7768.   )
      ( m0 O+ ^. i+ X* @3 c
7769.   (defun ddarc ()
      
7770.     (if (not (new_dialog "ddarc" dcl_id)) (exit))
      
7771.     ;; Set initial tile values
      " ?2 H0 U% s5 u* l8 [+ P3 z* B) q
7772.     (set_tile_props)
      + O' l( l8 @! j. `2 y
7773.     (set_tile_handle)
      
7774.     (set_tile_pt1 1)
      
7775.     (set_tile_rad)
      
7776.     (set_tile_stang)
      
7777.     (set_tile_endang)
      
7778.     (arc_calc)
      ; m, c0 Q8 v/ V/ k, i* h' k
7779.     ;; Define action for tiles
      " {) I' }5 p% e7 n
7780.     (set_action_tiles)
      % w! \/ t1 u4 m" B9 R
7781.     (setq dialog-state (start_dialog))
      
7782.     (if (= dialog-state 0)
      # M. D, `& S# U& ^" O
7783.       (reset)
      
7784.     )
      
7785.     (if (= dialog-state 1)
      
7786.       (modify_arc)
      7 A9 t8 Y9 X7 E1 W
7787.     )
      
7788.     (if (= dialog-state 3)
      6 b8 Z# G* l. ?0 j0 y9 L& w6 f
7789.       (progn
      0 q0 N4 {! G! R. ?
7790.         (modify_arc)
      
7791.         (setq pt1 (getpoint (list x1 y1 z1) "\nCenter point: "))
      2 I  z- S$ @% f, V! v, a
7792.         (ver_pt1 1)
      
7793.         (ddarc)
      ) R4 g! G) {5 |" \" Z& m6 O' t8 M
7794.       )
      . ]. B. @) B% l! W. f9 ~* u
7795.     )
      
7796.   )
      
7797.   ;;
      
7798.   ;; Modify SOLID or TRACE
      
7799.   ;; Note the Z value of the object is determined by the Z value of the fourth
      
7800.   ;; point - code 13.  Changing the point values of a solid or trace from a UCS
      
7801.   ;; that is nonplanar to the UCS the object was created may confuse the user.
      * I. R$ |8 ~9 T  c6 T- }0 {7 G! I
7802.   (defun modify_solid ()
      
7803.     (modify_properties)
      
7804.     (setq pt1 (list x1 y1 z4))
      ( L4 w+ Z& c3 E, ]
7805.     (setq pt2 (list x2 y2 z4))
      
7806.     (setq pt3 (list x3 y3 z4))
      
7807.     (setq pt4 (list x4 y4 z4))
      
7808.     (tempmod pt1 10 1)
      
7809.     (tempmod pt2 11 1)
      ( A4 @3 n, u) X- Z
7810.     (tempmod pt3 12 1)
      
7811.     (tempmod pt4 13 1)
      / O" _1 X/ E# e) w" T
7812.     (entmod elist)
      * J- ]3 R5 F+ V8 H
7813.   )
      # ]0 w- Z$ d, p8 {9 p+ }
7814. 
      ; `0 Q+ V; y) R4 U7 z0 x
7815.   (defun ddsolid ()
      
7816.     (if (= etype "SOLID")
      + i, I0 D2 t9 y% P3 X$ n8 E
7817.         (if (not (new_dialog "ddsolid" dcl_id)) (exit))
      . L* y+ [7 W# Z
7818.         (if (not (new_dialog "ddtrace" dcl_id)) (exit))
      
7819.     )
      ) M) ^8 S( T+ K4 y3 ~
7820.     ;; Set initial tile values
      : w4 f8 n2 e6 n# C
7821.     (set_tile_props)
      4 e! q! j6 k: B' x
7822.     (set_tile_handle)
      
7823.     (set_tile_pt1 1)
      9 F* u- \" _! }& i  F/ J
7824.     (set_tile_pt2 1)
      
7825.     (set_tile_pt3 1)
      $ e& {5 Y8 P1 [* `9 M: {- v
7826.     (set_tile_pt4 1)
      
7827.     ;; Define action for tiles
      
7828.     (set_action_tiles)
      9 a# ]4 D; Q, p
7829.     (setq dialog-state (start_dialog))
      ; A5 L$ b: E6 n3 s5 P9 j* P/ }8 p$ h
7830.     (if (= dialog-state 0)
      
7831.       (reset)
      
7832.     )
      9 ^( E# j$ T/ N* ]9 @. s) m0 V
7833.     (if (= dialog-state 1)
      
7834.       (modify_solid)
      
7835.     )
      0 w& s+ p! w$ K* F
7836.     (if (= dialog-state 3)
      
7837.       (progn
      2 c4 k0 \! ?( S  ]! I: b7 a) U# a
7838.         (modify_solid)
      
7839.         (setq pt1 (getpoint (list x1 y1 z1) "\nFirst point: "))
      
7840.         (ver_pt1 1)
      
7841.         (ddsolid)
      ' o$ K4 U, t. f) k
7842.       )
      
7843.     )
      
7844.     (if (= dialog-state 4)
      ) I: `% h5 c) r7 ]* A! e
7845.       (progn
      
7846.         (modify_solid)
      
7847.         (entmod elist)
      & A8 I# G$ d3 M. [
7848.         (setq pt2 (getpoint (list x2 y2 z2) "\nSecond point: "))
      
7849.         (ver_pt2 1)
      # m6 G- P6 g7 k. M0 v: J2 v
7850.         (ddsolid)
      ' [+ C) Y$ V5 K$ d8 w2 J- k2 j5 Y  `( F! i
7851.       )
      6 @: ?7 C8 g0 J4 a! g; N
7852.     )
      & g1 [! p5 G" v0 g! y9 ?/ Q
7853.     (if (= dialog-state 5)
      7 }0 A% h& @$ |( i. ^8 C& {7 g8 @
7854.       (progn
      
7855.         (modify_solid)
      
7856.         (setq pt3 (getpoint (list x3 y3 z3) "\nThird point: "))
      
7857.         (ver_pt3 1)
      
7858.         (ddsolid)
      : U& Z; L& c8 [, x4 g
7859.       )
      
7860.     )
      
7861.     (if (= dialog-state 6)
      
7862.       (progn
      ( h) u' Y( z# r- t5 w3 _. g
7863.         (modify_solid)
      ' A$ {9 J. [" g9 j. k1 l
7864.         (setq pt4 (getpoint (list x4 y4 z4) "\nFourth point: "))
      
7865.         (ver_pt4 1)
      
7866.         (ddsolid)
      
7867.       )
      
7868.     )
      
7869.   )
      6 `8 c% w( w  B1 u; X/ ~
7870.   ;;
      6 A  ~& }& |4 `/ R
7871.   ;; Modify 3DFACE
      
7872.   ;;
      
7873.   ;; Check visibility of edges
      
7874.   ;;
      
7875.   (defun edgetest (/ bit1 bit2 bit3 bit4)
      . ~- {3 g) N& Z: E( m2 D5 Y6 }
7876.     (if (= edge1 "1") (setq bit1 0) (setq bit1 1))
      
7877.     (if (= edge2 "1") (setq bit2 0) (setq bit2 2))
      
7878.     (if (= edge3 "1") (setq bit3 0) (setq bit3 4))
      5 l. ^3 z; M8 Z7 {- M; c
7879.     (if (= edge4 "1") (setq bit4 0) (setq bit4 8))
      / N4 x8 |9 F; u6 C  V
7880.     (+ bit1 bit2 bit3 bit4)
      & w  Q9 t2 k" |: M& I
7881.   )
      
7882. 
      
7883.   (defun modify_3dface ()
      
7884.     (modify_properties)
      
7885.     (setq pt1 (list x1 y1 z1))
      / m6 E" @) c9 I/ N
7886.     (setq pt2 (list x2 y2 z2))
        P6 Q2 X! ?( {
7887.     (setq pt3 (list x3 y3 z3))
      
7888.     (setq pt4 (list x4 y4 z4))
      
7889.     (tempmod pt1 10 0)
      3 K* W3 ?& }) ?7 l
7890.     (tempmod pt2 11 0)
      ! {+ K' b& m4 V, k
7891.     (tempmod pt3 12 0)
      
7892.     (tempmod pt4 13 0)
      
7893.     (tempmod (edgetest) 70 nil)
      
7894.     (entmod elist)
      
7895.   )
      
7896. 
      & {6 O; d. I! D
7897.   (defun dd3dface ()
      * I. k5 i9 |( W' E$ _) g9 l3 L' f& i
7898.     (if (not (new_dialog "dd3dface" dcl_id)) (exit))
      
7899.     (set_tile_props)
      
7900.     (set_tile_handle)
      ' d4 x4 z% k% C7 B- b3 }
7901.     (set_tile_pt1 0)
      * \- E" f8 E* o" C8 a
7902.     (set_tile_pt2 0)
      
7903.     (set_tile_pt3 0)
      
7904.     (set_tile_pt4 0)
      
7905.     (set_tile_edges)
      2 ^8 l  t8 M. V0 I9 M
7906.     ;; Define action for tiles
      + o+ J& K0 V% `& n; K
7907.     (set_action_tiles)
      
7908.     (setq dialog-state (start_dialog))
      5 E1 h* Z8 |1 g! m4 z
7909.     (if (= dialog-state 0)
      
7910.       (reset)
      
7911.     )
      * N: _2 X: |5 v$ h1 M
7912.     (if (= dialog-state 1)
      * D7 c8 b8 {6 H  J  a7 O
7913.       (modify_3dface)
      ; _- m6 L! m- }
7914.     )
      
7915.     (if (= dialog-state 3)
      
7916.       (progn
      3 W' W5 Y) C! R2 A: T3 F! U( z
7917.         (modify_3dface)
      
7918.         (setq pt1 (getpoint (list x1 y1 z1) "\nFirst pt: "))
      
7919.         (ver_pt1 0)
      8 k# F( X8 S3 Q. ?9 I5 N$ j/ F
7920.         (dd3dface)
      $ B% e/ f7 R& i) h
7921.       )
      
7922.     )
      
7923.     (if (= dialog-state 4)
      5 y" X6 T+ D$ |  @1 q
7924.       (progn
      
7925.         (modify_3dface)
      
7926.         (setq pt2 (getpoint (list x2 y2 z2) "\nSecond point: "))
      + `) _8 `  L. P9 s$ t( j8 p$ G. T
7927.         (ver_pt2 0)
      
7928.         (dd3dface)
      " M5 ]1 G' A& s( E0 a  Z/ e
7929.       )
      + L0 Q; a; w: c$ d- Q, A3 v0 D
7930.     )
      - D" a0 F# H7 S: y: k: _% X
7931.     (if (= dialog-state 5)
      
7932.       (progn
      
7933.         (modify_3dface)
      
7934.         (setq pt3 (getpoint (list x3 y3 z3) "\nThird point: "))
      ( j! Y9 `6 _9 d! k9 k2 g
7935.         (ver_pt3 0)
      4 o3 v9 J+ M( Q8 ~# U$ a) \
7936.         (dd3dface)
      
7937.       )
      
7938.     )
      
7939.     (if (= dialog-state 6)
      % x2 o! s3 ?6 I0 [% u4 e
7940.       (progn
      
7941.         (modify_3dface)
      7 i3 J7 P2 F5 n! d* @
7942.         (setq pt4 (getpoint (list x4 y4 z4) "\nFourth point: "))
      ) j$ r. |4 g+ f. L3 _# e
7943.         (ver_pt4 0)
      
7944.         (dd3dface)
      3 M6 V# ]# L' U( w
7945.       )
      
7946.     )
      & `9 o2 x/ E2 C. [& _/ n
7947.   )
      9 \0 x# Y' E& D) j
7948. 
      
7949.   ;;
        E$ ?4 j8 f  ]
7950.   ;; Image functions
      % p$ A6 t+ b- n7 y
7951.   ;;
      + P$ P8 l, a+ Q2 }( t) h" N9 w4 {8 V
7952.   (defun image_scale (/ upixel en n userscale temp)
      
7953.     ;; Calculate the size of an image pixel in AutoCAD units
      
7954.     (setq upixel (distance '(0 0 0) (cdr (assoc 11 elist))))
      / S# X$ c% t2 Z; h) s
7955. 
      
7956.     ;; Retrieve the user scale
      ' q; B# w1 Y1 r7 ]6 u" L: f
7957.     (setq en (dictsearch (namedobjdict) "ACAD_IMAGE_VARS"))
      $ o- W; `& N" V! J* ]* u
7958. 
      6 \* E0 L. \$ H, A5 c) f
7959.     ;; Next, extract the image units and pixel resolution
      
7960.     (if (or (= 0 (cdr (assoc 281 image:olist))) (= 0 (cdr (assoc 72 en))))
      
7961.       (setq image:scale (* (cadr (assoc 13 elist)) upixel))
      : O% W# i" P( G$ [* ^, I; F# y7 j- d! \
7962.       (progn
      
7963.         ;; Convert the user scale to the proper word
      
7964.         (setq n (cdr (assoc 72 en)))
      
7965.         (setq temp (getvar "LUNITS"))
      ) `/ v1 p. [; ]5 [' m
7966.         (if (and (/= n 0) (or (= temp 3) (= temp 4))) (setq n 5))
      2 w9 }2 M0 J1 x# I( C) q0 @
7967.         (if (= n 1) (setq userscale "Millimeter"))
      
7968.         (if (= n 2) (setq userscale "Centimeter"))
      
7969.         (if (= n 3) (setq userscale "Meter"))
      " _8 A0 S- ^' }, i9 l$ D% l5 b' _
7970.         (if (= n 4) (setq userscale "Kilometer"))
      6 V8 x& c/ ?0 z
7971.         (if (= n 5) (setq userscale "Inch"))
      % p7 T* l4 I" |* p+ z  d: S5 y
7972.         (if (= n 6) (setq userscale "Foot"))
      
7973.         (if (= n 7) (setq userscale "Yard"))
      $ _1 J6 p* j+ T9 Y) I! h
7974.         (if (= n 8) (setq userscale "Mile"))
      . q' _( n7 }3 I* D! y& ]" u% a
7975.         (setq image:scale (/ upixel (cvunit 1 "Millimeter" userscale) (cadr (assoc 11 image:olist))))
      & E5 R$ r, r6 Q  Z9 _" c; L8 I$ z
7976.       )
      
7977.     )
      
7978.   )
      2 U9 e" X) X4 ^9 X, D3 v" L
7979. 
      
7980.   ;;
      " y0 r- K7 \* l2 ~& t6 T# i
7981.   ;; Scale factors for block insertions
      
7982.   ;;
      
7983.   (defun image_set_tile_scale (/ temp)
      
7984.     (setq temp (getvar "LUNITS"))
      ' B! B7 V3 Q/ p* A* H8 F3 u
7985.     (setvar "LUNITS" 2)
      
7986.     (set_tile "xscale" (ai_rtos (* image:scale image:mult)))
      ( T) P: S5 L8 y. ^7 E# m
7987.     (set_tile "wid" (ai_rtos (* image:width image:mult)))
      & T7 v' n! k7 X! p! s5 S# Y# h, K) D" {
7988.     (set_tile "hght" (ai_rtos (* image:height image:mult)))
      " I; O! C$ F9 m2 h4 f
7989.     (setvar "LUNITS" temp)
      
7990.   )
      
7991. 
      
7992.   ;;
      
7993.   ;; Set the scale, width and height values appropriately.
      3 ]2 e: e+ Q, n: K/ t" |
7994.   ;;
      
7995.   (defun image_update (field value / orig_value new_value mult)
      " B0 V/ g# q3 x" N
7996.     (if (= field "xscale")
      
7997.         (setq orig_value image:scale)
      2 E  t9 Q5 d- i: a1 J$ y* S8 w, h
7998.     )
      & X# W- U' M* Y/ u% P! j& i
7999.     (if (= field "wid")
      
8000.         (setq orig_value image:width)
      
8001.     )
      
8002.     (if (= field "hght")
      " a4 K# j! @, @+ {  A
8003.         (setq orig_value image:height)
      9 B0 C* ~  V2 M
8004.     )
      1 c2 O3 J# d: e* ]1 P
8005.     (setq new_value (verify_d field value (* image:mult orig_value)))
      - w* {3 _& U& ^- e  n1 h
8006.     (if (/= new_value old_value)
      
8007.       ;; Make sure the user has entered a sufficiently large value
      
8008.       (if new_value
      
8009.         (progn
      ( T1 q6 |4 J" l8 ?% O
8010.           (if (< new_value 1e-8)
      
8011.             (setq mult image:mult)
      
8012.             (setq mult (/ new_value orig_value))
      
8013.           )
      
8014.           (setq image:mult mult)
      
8015.           (image_set_tile_scale)
      
8016.         )
      
8017.       )
      
8018.     )
      
8019.   )
      ; H( P/ R' m: k3 A1 Q
8020. 
      
8021.   (defun image_disp_opt (bit)
      ; _  R+ D/ L' N/ l( C* k
8022.     (setq image:options (Boole 6 image:options bit))
      / \! ?1 P% x9 v) k/ _: Q
8023.   )
      , j* H, q' T5 `! }
8024. 
      - c( y- g1 _: n
8025.   (defun image_modify ()
        o# e$ M# H" m
8026.     (modify_properties)
      1 p" L2 g) g. d- G" B
8027.     (setq pt1 (list x1 y1 z1))
      
8028.     (tempmod pt1 10 0)
      9 {0 T$ E; ^8 B4 H, l# E6 E
8029.     (entmod elist)
      7 g% l9 {1 S; @% Q+ }5 _0 B' Q
8030.   )
      
8031. 
      
8032.   (defun image_clean_variables ()
      
8033.     ;; Clean up global variables used here
      
8034.     (setq image:scale nil)
      
8035.     (setq image:angle nil)
      # b5 Z) @$ X& [- I( r. X  R
8036.     (setq image:width nil)
      
8037.     (setq image:height nil)
      
8038.     (setq image:options nil)
      
8039.     (setq image:oname nil)
      
8040.     (setq image:olist nil)
      
8041.     (setq image:mult nil)
      ! D' `- J+ n) |" o! d, o
8042.     (setq st_ang nil)
      
8043.   )
      + t! m, [. Q9 x( x/ \, X6 q
8044. 
      
8045.   (defun image_scale_vector (v1 value)
      
8046.     (list (* (car v1) value) (* (cadr v1) value) (* (last v1) value))
      
8047.   )
      
8048. 
      
8049.   (defun image_cross_product (v1 v2 / vx vy vz)
      
8050.     (setq vx (- (* (cadr v1) (last v2)) (* (cadr v2) (last v1))))
      
8051.     (setq vy (- (* (car v2) (last v1)) (* (car v1) (last v2))))
      + i2 L# R6 T) f4 W+ ^
8052.     (setq vz (- (* (car v1) (cadr v2)) (* (car v2) (cadr v1))))
      0 w4 |6 q- z1 z- C' }
8053.     (list vx vy vz)
      
8054.   )
      
8055. 
      
8056.   (defun image_dot_product (v1 v2)
      8 j: ?+ ^: _' [: j; t8 M
8057.     (+ (* (car v1) (car v2)) (* (cadr v1) (cadr v2)) (* (last v1) (last v2)))
      ! v1 k/ c# z$ U/ o+ b. I. _
8058.   )
      
8059. 
      1 b& z" w% W6 D# f7 o* b
8060.   (defun image_add_vector (v1 v2)
      
8061.     (list (+ (car v1) (car v2)) (+ (cadr v1) (cadr v2)) (+ (last v1) (last v2)))
      
8062.   )
      + x( N9 S7 s/ M9 M
8063. 
      
8064.   (defun image_subtract_vector (v1 v2)
      / ?" _9 K  M$ Y1 ~) D: L* u
8065.     (list (- (car v1) (car v2)) (- (cadr v1) (cadr v2)) (- (last v1) (last v2)))
      - G9 i/ i: r* b/ g; h
8066.   )
      
8067. 
      , U6 X) [( v" Y" }$ x5 T+ ]
8068.   (defun image_normalize_vector (v1)
      
8069.     (image_scale_vector v1 (/ 1. (sqrt (image_dot_product v1 v1))))
      
8070.   )
      
8071. 
      & d) V4 C! t' `  E& u8 z0 f8 I" ?! _8 x
8072.   (defun image_rotate_vector (vector angle axis / along_axis axis_x_in_rot_plane axis_y_in_rot_plane in_rot_plane)
      
8073.     ;; Normalize the axis
      4 D0 W$ F* n) N# u; E* b" i' L
8074.     (setq axis (image_normalize_vector axis))
      
8075.     (setq along_axis (image_scale_vector axis (image_dot_product vector axis)))
      
8076.     (setq axis_x_in_rot_plane (image_subtract_vector vector along_axis))
      2 P9 c# Y4 J8 s' P
8077.     (setq axis_y_in_rot_plane (image_cross_product axis axis_x_in_rot_plane))
      
8078.     (setq in_rot_plane
      % [9 x, L. Z3 ]0 D, v' r
8079.       (image_add_vector
      
8080.         (image_scale_vector axis_x_in_rot_plane (cos angle))
      
8081.         (image_scale_vector axis_y_in_rot_plane (sin angle))
      
8082.       )
      - n2 p. @: \) ^6 L0 N' |- Q9 G
8083.     )
      
8084.     (image_add_vector along_axis in_rot_plane)
      
8085.   )
      ; G6 O- A$ P& i0 y* m0 |$ B3 Z
8086. 
      , N" m2 A8 [3 b
8087.   ;;
      # T* `  H/ Z, O# l) _
8088.   ;; Calculate current rotation angle if appropriate.
      
8089.   ;; If not, grey out the rotation field.
      " k1 r  l+ s2 `. @* p4 \2 e/ v4 U# I, q
8090.   ;;
      0 G7 ]: \5 E; I
8091.   (defun image_rotation (/ normal rlength zlength sqrt_tolerance)
      ( a% T, H* @3 E0 _9 W. h
8092.     ;; Determine if image normal is codirectional with
      
8093.     ;; the current UCS Z-vector.
      . F* n( K$ p$ {/ M  C( W
8094.     ;;
      % D4 F6 C7 z2 z
8095.     (setq normal (trans (image_normalize_vector (image_cross_product (cdr (assoc 11 elist)) (cdr (assoc 12 elist)))) 0 1 1))
      ' p% V! k7 l6 @1 U7 {
8096.     (setq rlength (+ (* (car normal) (car normal)) (* (cadr normal) (cadr normal))))
      5 Z1 y0 b$ L& x3 f& V
8097.     (setq zlength (* (last normal) (last normal)))
      + g1 B$ i! T6 ~: @+ I; I7 j
8098.     ;; Note that the value .0001 in the radians is approximately 0.0057 degrees.
      
8099.     ;;
      
8100.     ;;                cos(.0001)^2
      
8101.     ;;   Tolerance = --------------
      
8102.     ;;                sin(.0001)^2
      
8103.     ;;
      
8104.     (setq sqrt_tolerance (/ (cos 0.0001) (sin 0.0001)))
      ' l, x! C) P- w7 H4 w
8105.     (if (and (< (* rlength sqrt_tolerance sqrt_tolerance) zlength) (> (last normal) 0))
      
8106.       (setq image:angle (angle '(0 0 0) (trans (cdr (assoc 11 elist)) 0 1 1)))
      
8107.       (progn
      
8108.         (mode_tile "st_ang" 1)
      
8109.         (setq image:angle 0)
      
8110.       )
      & p" y+ k" b2 o3 n" x
8111.     )
      ( l. B* k( ~6 @; ~6 m/ N
8112.   )
      * K1 f5 `" c" }, n$ {, F- b
8113. 
      9 O  B& V5 C. B& ^$ Y( N0 G
8114.   ;;
      0 C: `7 v/ [: H; M7 s! y+ p
8115.   ;; Modify Image
      ( x( S# h4 W. `& a) N
8116.   ;;
      
8117.   (defun modify_image (/ u_vector v_vector z_vector)
      " [' d/ n+ Z! b6 `7 B2 j" @% t, J9 t: K/ q
8118.     (modify_properties)
      
8119.     (setq pt1 (list x1 y1 z1))
      ! s& |; T6 [, ~' l, Q
8120.     (tempmod pt1 10 0)
      
8121.     ;; Make display option changes to image
      
8122.     (emod image:options 70)
      ; D( B! d" H' g+ w
8123.     ;; Get the u and v vectors
        |9 Z% E) @) u9 _: o8 R
8124.     (setq u_vector (cdr (assoc 11 elist)))
      
8125.     (setq v_vector (cdr (assoc 12 elist)))
      
8126. 
      
8127.     ;; Make scale changes to the vectors
      $ s+ P& ?7 D" m5 `4 o3 n6 |4 G* K
8128.     (if (/= image:mult 1)
      - Y4 S( \& B) |' z
8129.       (progn
      
8130.         (setq u_vector (image_scale_vector u_vector image:mult))
      , x( T8 T0 G% @! z) s& q6 _
8131.         (setq v_vector (image_scale_vector v_vector image:mult))
      $ p  N6 c6 m* U9 v
8132.       )
      
8133.     )
      
8134.     ;; Rotate the vectors
      
8135.     (setq st_ang (- st_ang image:angle))
      
8136.     (if (/= st_ang 0)
      
8137.       (progn
      , M6 x% P2 D& N$ ^
8138.         (setq z_vector
      * N4 ]2 a) A5 X1 T5 T
8139.           (image_cross_product
      : y) F5 {) p/ z5 Q, L- S
8140.             (image_normalize_vector u_vector)
      ( U5 r& B: M( f. E
8141.             (image_normalize_vector v_vector)
      
8142.           )
      7 Z1 h7 _; K6 W- _8 B
8143.         )
      . r# w% h% x! r) T8 Q
8144.         (setq u_vector (image_rotate_vector u_vector st_ang z_vector))
      
8145.         (setq v_vector (image_rotate_vector v_vector st_ang z_vector))
      ; U1 o# H$ v' g( g7 t
8146.       )
      3 Q, X, n. b  s/ j: Z) U; X
8147.     )
      
8148.     (emod u_vector 11)
        L9 w& W* W, `( I1 _+ G# p- y' x2 c
8149.     (emod v_vector 12)
      4 F, R& t% b: \/ `
8150.     (entmod elist)
      
8151.   )
        B. o6 V  \: l9 j
8152. 
      ; s& Z* q6 [6 S2 M# j7 H
8153.   ;;
      
8154.   ;; Run imageadjust on given entity, working around possible
      
8155.   ;; re-entrancy problems
      5 R% W& Y0 c. q" t  K: L
8156.   ;;
      - F) c( ~* [: z" d; w- T
8157.   (defun image_adjust (ename)
      8 Y7 O; P3 F( L1 T9 a
8158.     (verify_arxapp_loaded "ism.arx") ;; make sure it's loaded...
      
8159.     (imageadjust ename)
      
8160.   )
      6 K7 c% a9 P  [  `) g' f
8161. 
      8 E, M2 t, N& }0 d1 K
8162.   (defun ddimage ()
      
8163.     (if (not (new_dialog "ddimage" dcl_id)) (exit))
      
8164. 
      , X# {+ ?' O4 N7 F6 N7 U
8165.     ;; Grey out the thickness field.
      
8166.     (mode_tile "b_thickness" 1)
      
8167.     (mode_tile "eb_thickness" 1)
      
8168. 
      
8169.     ;; Get the associated def object.
      
8170.     (setq image:oname (cdr (assoc 340 elist)))
      
8171.     (setq image:olist (entget image:oname))
      / w2 K% n) Y4 E1 k  o3 L1 R
8172. 
      
8173.     ;; Set initial tile values
      
8174.     (set_tile_props)
      
8175.     (set_tile_handle)
      8 ?9 W0 d( f' Z1 d
8176.     (set_tile_pt1 0)
      / q8 i1 A5 O/ d: E. S7 e
8177.     (setq image:scale (image_scale))
      
8178.     (setq st_ang (image_rotation))
      
8179.     (setq image:width (* (distance '(0 0 0) (cdr (assoc 11 elist))) (cadr (assoc 13 elist))))
      
8180.     (setq image:height (* (distance '(0 0 0) (cdr (assoc 12 elist))) (caddr (assoc 13 elist))))
      # S  ~( }# r* C5 l- M; _8 G
8181.     (setq image:options (cdr (assoc 70 elist)))
      - \# b  |5 v! X2 x  \7 b. p
8182. 
      
8183.     ;; Record the last multiplier for use in image_update function
      
8184.     (setq image:mult 1)
      9 b6 t- j! ]2 h6 E9 M  L8 U
8185. 
      
8186.     ;; Retrieve the image name
      
8187.     (setq fn (reverse (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")))
      
8188.     (setq flag 0)
      
8189.     (foreach n fn
      
8190.       (if (= flag 1)
      
8191.         (progn
      
8192.           ;; Display the image name
      
8193.           (set_tile "image_name" (cdr n))
      - k+ l. c2 r3 k: a% K* F
8194.           (setq flag 2)
      8 t3 v- L6 A1 w. D# H) R7 a* f' g
8195.         )
      $ g& R/ H0 a$ s% S
8196.       )
      ( G6 P- Q7 }$ g, k5 `& |+ |
8197.       (if (= flag 0)
      
8198.         (if (equal (cdr n) image:oname) (setq flag 1))
      
8199.       )
      
8200.     )
      8 L) ^; D0 N) D8 D
8201. 
      
8202.     (set_tile "image_path" (cdr (assoc 1 image:olist)))
      
8203.     (set_tile "st_ang" (ai_angtos image:angle))
      / n, ^* T- I! V  k$ {
8204.     (image_set_tile_scale)
      
8205. 
      ( `: _7 y! N* [& G% g. w
8206.     ;; Check the appropriate boxes
      
8207.     (if (/= (Boole 1 image:options 1) 0) (set_tile "image_show" "1"))
      ; R5 K# K7 C1 z! D
8208.     (if (/= (Boole 1 image:options 2) 0) (set_tile "image_non_ortho" "1"))
      ; F4 g5 E: e4 A7 Z& g" j* {4 o/ F9 G# G
8209.     (if (/= (Boole 1 image:options 4) 0) (set_tile "image_clipped" "1"))
      4 h/ G7 o2 F8 q. g. x
8210.     (if (/= (Boole 1 image:options 8) 0) (set_tile "image_transparency" "1"))
      
8211. 
      
8212.     ;; Define action for tiles
      
8213.     (set_action_tiles)
      $ I  w: n4 ]% m: H0 ?  Z9 M
8214.     (action_tile "xscale" "(image_update \"xscale\" $value)")
      
8215.     (action_tile "st_ang" "(ver_ang1 $value)")
      $ q& `' G0 x$ E/ }( G
8216.     (action_tile "wid" "(image_update \"wid\" $value)")
      0 |+ _  Y0 t1 r5 |
8217.     (action_tile "hght" "(image_update \"hght\" $value)")
      
8218.     (action_tile "image_show" "(image_disp_opt 1)")
      % @5 B  f- v1 b- o) y6 W2 Z- u, n* v
8219.     (action_tile "image_non_ortho" "(image_disp_opt 2)")
      5 `# n6 }$ K& {7 P. ]
8220.     (action_tile "image_clipped" "(image_disp_opt 4)")
      
8221.     (action_tile "image_transparency" "(image_disp_opt 8)")
      
8222.     (action_tile "image_adjust" "(done_dialog 4)")
      
8223. 
      
8224.     (setq dialog-state (start_dialog))
      
8225.     (if (= dialog-state 0)
      + a# g+ i. A1 E: }6 @
8226.       (progn
      4 b* {1 W5 c: S" D$ X, Y# Y
8227.         (reset)
      
8228.         (image_clean_variables)
      * |& `. V: ~2 [$ m, D& u1 C& w6 B
8229.       )
      7 Z- X' f3 X+ N  x/ z
8230.     )
      
8231.     (if (= dialog-state 1)
      
8232.       (progn
      2 @$ q  f- U7 k& |- N: B; @) ^
8233.         (modify_image)
      
8234.         (image_clean_variables)
      " L" K! }& n5 J( {7 R
8235.       )
      
8236.     )
      8 B& Z+ Q" e6 s+ \# k
8237.     (if (= dialog-state 3)
      5 A; f5 m7 d& {* @( p
8238.       (progn
      
8239.         (modify_image)
      
8240.         (image_clean_variables)
      ( |! Z. ~9 k" E
8241.         (setq pt1 (getpoint (list x1 y1 z1) "\nNew Insertion Point: "))
      ( @% {, }2 ~& G! \) K! I( K; M4 r
8242.         (ver_pt1 0)
      
8243.         (ddimage)
      
8244.       )
      
8245.     )
      
8246.     (if (= dialog-state 4)
      
8247.       (progn
      
8248.         (modify_image)
      
8249.         (image_adjust ename)
      
8250.         (setq elist (entget ename))
      ; P- d# ^$ j1 y0 Y9 j
8251.         (ddimage)
      2 c, }. m. e' B9 d
8252.       )
      
8253.     )
      # Y# m. q2 \5 u6 e# C
8254.   )
      ' m" p- ]" F* |& I+ u% T
8255. 
      
8256.   ;;
      % q0 R% g6 l. {" X6 W7 z. M0 E
8257.   ;; Modify BLOCK (and its Attributes, if any)
      
8258.   ;;
      - L/ p% i4 ^1 u, V3 S8 X3 W
8259.   (defun modify_block ( / el en2 p1 p2 oldp1 oldp2 new_hgt old_hgt attr
      ( m2 E' T1 i7 P6 x, Q/ Z
8260.                           new_wid old_wid old_rot scaling old_scale
      
8261.                           xdelta ydelta zdelta xbase ybase zbase ipos)
      ; j% A; Y5 J5 h" q: K# _0 p/ d
8262.     (modify_properties)
      
8263. 
      . p1 {5 ^) u+ |0 j
8264.     ;; First, translate and scale the Attributes, if there are any.
      
8265.     (setq old_rot   (cdr (assoc 50 elist))
      
8266.           old_scale (list (cdr (assoc 41 elist))
      
8267.                           (cdr (assoc 42 elist))
      
8268.                           (cdr (assoc 43 elist))
      
8269.                     )
      ' T1 z) k1 k4 w' \5 w# G* J- F, v
8270.           scaling   (or (/= xscale (car   old_scale))
      " O3 s5 c8 V( U  G
8271.                         (/= yscale (cadr  old_scale))
      
8272.                         (/= zscale (caddr old_scale))
      7 a5 X& P, q! W/ P1 L
8273.                     )
      
8274.           attr      nil               ; No Attributes modified yet
      4 J3 e! w! {, Q
8275.     )
      
8276.     (if scaling
      5 i9 V4 U7 i7 Q! p3 d. j3 o1 ?
8277.       (progn
      . }/ e/ u5 K8 n& t
8278.         (setq xdelta (/ xscale (car   old_scale))
      
8279.               ydelta (/ yscale (cadr  old_scale))
      4 ?" U" B" R# N3 x
8280.               zdelta (/ zscale (caddr old_scale))
      + h) D/ X  Z% n9 i9 s2 f0 U5 [
8281.               ipos   (cdr (assoc 10 elist))
      
8282.               xbase  (car   ipos)
      
8283.               ybase  (cadr  ipos)
      
8284.               zbase  (caddr ipos)
      
8285.               en2    (entnext ename)  ; First Attribute
      - s2 D+ c% n* b) V) h+ G
8286.         )
      ' C2 D$ H+ b+ u/ r  \- F6 O) `4 P
8287. 
      * @$ X) G8 E, D8 l  `  D+ p
8288.         ; If the Block is rotated, temporarily un-rotate it, along
      
8289.         ; with all its Attributes, so the scaling/translation of the
      
8290.         ; Attributes won't have to take the Block rotation into account.
      9 b4 k, A* y# y) n9 u" _
8291.         (if (/= old_rot 0.0)
      
8292.           (progn
      / V0 W2 ]4 }' k& c) V' X
8293.             (command "_rotate" ename "" pt1 (ai_angtos (- old_rot)))
      , S: y: d8 _  B; V+ ~
8294.             (setq old_rot 0.0
      $ A) \. N: c! ?- N# b8 y$ j
8295.                   elist   (subst (cons 50 0.0) (assoc 50 elist) elist)
      
8296.             )
      
8297.           )
      & F; H9 Q1 ?5 a$ n" ~& U
8298.         )
      1 N7 l2 d+ |$ J2 Z! ~" Z
8299. 
      
8300.         (while en2
      ) t! B. n; V- A, A  J+ v4 M9 Q8 l
8301.           (setq el (entget en2))
      : V' [" V8 @! N& g, r( k
8302.           (if (= (cdr (assoc 0 el)) "ATTRIB")
      % w+ n. O  A5 Y8 k4 I
8303.             (progn
      + w" d8 P; G' F: \
8304.               (setq old_hgt (cdr (assoc 40 el))  ; Height
      
8305.                     old_wid (cdr (assoc 41 el))  ; Width-factor
      
8306.                     oldp1 (cdr (assoc 10 el))  ; Generation start point
      1 B6 Z: r8 J+ e! g
8307.                     oldp2 (cdr (assoc 11 el))  ; Optional alignment pt
      
8308.                     ha    (cdr (assoc 72 el))  ; Horizontal alignment
      3 v4 B, M1 L' l/ o5 w' z9 r" F/ W
8309.                     va    (cdr (assoc 74 el))  ; Vertical alignment
      ' X3 s" ?# ]7 o; D. r
8310. 
      
8311.                     ; Translate gen. start point
      
8312.                     p1    (list (+ xbase (* xdelta (- (car   oldp1) xbase)))
        G: j. x7 l  G, P0 D
8313.                                 (+ ybase (* ydelta (- (cadr  oldp1) ybase)))
      1 |4 s. S1 S4 b& f2 @( g, N) s5 [
8314.                                 (+ zbase (* zdelta (- (caddr oldp1) zbase)))
      
8315.                           )
      
8316.                     el    (subst (cons 10 p1) (assoc 10 el) el)
      
8317.               )
      
8318. 
      0 ~6 A7 t# Q- I0 `+ b5 H
8319.               ; Translate alignment pt similarly, if present and applicable
      7 s" G0 g7 N# j, g. Q* D8 X! c
8320.               (if (and oldp2 (or (/= ha 0)
      
8321.                                  (/= va 0)
      
8322.                              )
      - B! O4 {: J! }- ^1 g
8323.                   )
        O1 Z: d2 K$ o9 \) k
8324.                 (setq p2 (list (+ xbase (* xdelta (- (car   oldp2) xbase)))
      % Y0 D6 D" }+ M7 s0 Y
8325.                                (+ ybase (* ydelta (- (cadr  oldp2) ybase)))
      
8326.                                (+ zbase (* zdelta (- (caddr oldp2) zbase)))
      
8327.                          )
      
8328.                       el (subst (cons 11 p2) (assoc 11 el) el)
      & D  l" M$ G/ s2 J
8329.                 )
      1 w; A1 s& k7 @  x
8330.               )
      * K7 e# X& Y, e4 [3 F* g2 ~" g
8331. 
      
8332.               ; Each Attribute's height and width-factor were computed
      
8333.               ; based on the Block's scale factors.  Adjust them now,
      9 Q5 \! t4 x" O3 p6 e/ t1 O
8334.               ; by first reducing to values for 1x1 scale...
      
8335.               (setq new_hgt (/ old_hgt (cadr old_scale))
      ) }9 g* g1 Z) t  o& X  @" i
8336.                     new_wid (/ old_wid (/ (car old_scale) (cadr old_scale)))
      
8337.               )
      
8338.               ; ...and then rescaling.
      
8339.               (setq new_hgt (* new_hgt yscale)
      6 V) [& O7 w, ^: x+ u) _3 m, H: [8 F
8340.                     new_wid (* new_wid (/ xscale yscale))
      7 F. I/ E! Z9 w' o0 @1 P
8341.               )
      * A' b  M  M5 ]/ x4 Q" D
8342.               (if (/= new_hgt old_hgt)
      6 O# S; V9 o: X
8343.                 (setq el (subst (cons 40 new_hgt) (assoc 40 el) el))
      ( p" q: Y3 Y: ?+ S2 G
8344.               )
      
8345.               (if (/= new_wid old_wid)
      
8346.                 (setq el (subst (cons 41 new_wid) (assoc 41 el) el))
      " q- l+ Y0 O0 h4 {4 @% h
8347.               )
      - f6 n% m7 d3 q/ a& m% X
8348.               (entmod el)
      ! z+ i7 e+ e/ @" H# e
8349.               (setq attr T             ; At least one Attribute modified
      
8350.                     en2  (entnext en2) ; Next Attribute
      ; {7 |) S9 `- o
8351.               )
      
8352.             )
      $ |5 c2 C  u) T8 {) B5 b
8353.             (setq en2 nil)          ; No more attributes
      : Z% Z6 u2 x' U" t8 C& r7 w
8354.           )
      
8355.         )
      % u2 g. Z$ N. |3 H& |; b
8356.       )
      
8357.     )
      6 t2 R3 N6 ?, c; n+ \
8358. 
      
8359.     (setq pt1 (list x1 y1 z1))
      2 W2 E2 ]4 g, c" b1 e
8360.     (tempmod xscale 41 nil)
      
8361.     (tempmod yscale 42 nil)
      , _$ H* b- R4 V5 g- ?% l: ~
8362.     (tempmod zscale 43 nil)
      
8363.     (tempmod col-sp 44 nil)
      
8364.     (tempmod row-sp 45 nil)
      
8365.     (tempmod columns 70 nil)
      
8366.     (tempmod rows 71 nil)
      - i4 T6 p7 C2 n1 G
8367.     (if (= xclipmode nil)
      
8368.        (entmod elist)
      2 i3 Y  {( b+ _* B& j
8369.        (setq xclipmode nil)
      6 ?- F7 o, G. o# f0 z# S; H
8370.     )
      6 R: A& g4 d- E- S4 e8 o
8371.     (move_pt1 1)
      " P1 ]5 B2 w0 e/ |1 K! B  k& P6 @
8372. 
      
8373.     ;; Now do the rotation with the ROTATE command.
      
8374.     (if (/= old_rot rot)
      : B+ \7 G) ?5 ^/ _
8375.       (command "_rotate" ename "" pt1 (ai_angtos (- rot old_rot)))
      2 i3 m, }/ |5 X" E3 L* z
8376.       (if attr                          ; Else, if attributes were modified,
      4 Y# ]; ^6 z$ H3 r; h- i& N
8377.         (entupd ename)                  ;   just regen to force attrib display
      " J. b4 |' j8 f- k/ ?
8378.       )
      / I8 Q2 C( c/ {
8379.     )
      / v' {4 X3 X5 [7 o
8380.     (setq elist (entget ename))
      & t  F: _* I  e) M
8381.   )
      6 n7 Q  h5 X/ Y7 n
8382.   (defun ddblock (/ temp temp_xclip newhatch blkname blklist blktype program xrefpath)
      
8383.     (setq newhatch 0)
      , S: R  _% ^- W) D. ~8 G
8384.     (setq blkname (cdr (assoc 2 elist)))
      
8385.     (setq blklist (tblsearch "block" blkname))
      4 R, ^7 N6 i( a& x" J
8386.     (setq blktype (cdr (assoc 70 blklist)))
      : B1 G7 T4 z5 x- u
8387.     (setq xcliponoff 0)
      
8388.     (if (or (= blktype 0)(= blktype 36))
      
8389.             (progn
      
8390.               (setq xcliponoff (xclipon elist))
      3 E2 n+ F1 k1 G# \
8391.           (setq temp_xclip xcliponoff)
      
8392.         )
      . `) g1 m0 B8 F1 u5 k3 \
8393.     )
      ( O) z' {1 d5 o+ y
8394.     (if (= (logand blktype 4) 4)
        b# d! k" W; q' i1 z5 y0 @
8395.       (progn
      ) b5 R5 _, j, _7 D8 J5 M# x
8396.         (setq xrefpath (cdr (assoc 1 blklist)))
      
8397.         (setq help_entry "modify_External_Reference_dialog")
      
8398.         (if (not (new_dialog "ddxref" dcl_id)) (exit))
      
8399.         (set_tile "Bl_name" blkname)
      
8400.         (set_tile "path" xrefpath)
      5 N' [4 E7 f+ I# s- ]; D
8401.       )
      - }6 e$ i0 @0 g
8402.       (progn
      
8403.         ;; Get program name for use as Xdata app name
      
8404.         (if (not (setq program (getvar "program")))
      
8405.            (setq program "acad")
      
8406.         )
      
8407.         (if (and (setq temp (assoc -3 (entget ename (list program))))
      + ^6 w! _' z' y. V% q) s
8408.                  (= (cdr (assoc 1000 (cdadr temp))) "HATCH")
      ) J- d+ b+ O3 s0 }9 k# n
8409.                  (assoc 1005 (cdadr temp))
      8 T2 l% g0 v$ [3 E; ~0 q4 E) M
8410.             )
      
8411.           (progn
      
8412.               (setq newhatch 1)
      
8413.               (setq help_entry  "modify_Hatch_dialog")
      9 O  S8 N: e' P: t. D( w
8414.               ;;; convert the object into a new hatch
      # T; ?7 u$ k: B4 ^( k- j# K
8415.               (ai_undo_on) ;; enable undo
      3 d/ e4 m$ F$ z5 y! L7 E1 f
8416.               (COMMAND "_.UNDO" "_Mark")
      
8417.               (COMMAND "_.CONVERT" "_Hatch" "_Select" (cdr (assoc -1 elist)) "")
      " S) u& c3 J! ~/ k
8418.               ;;; suppress nasty message from convert command
      - b: l6 a7 g1 D; Y
8419.               (princ "\r                                                                      \r")
      
8420.               (setq elist (entget (setq ename (cdr (assoc -1 elist)))))
      
8421.               (setq old-elist elist)
      % P* H$ O4 i  j- S( s! d  I
8422.               ;;; If we have cancelled ddmodify
      
8423.               (if (not (ddnewhatch))      ;;; (ddnewhatch) returns nil for Cancel or T for Ok
      ( W0 p6 U3 H( k# ~$ p5 p
8424.                    (command "_.UNDO" "_Back")
      * u/ c: D9 H) F6 r! u! M
8425.               )
      
8426.               (ai_undo_off) ;; restore undo state
      % ^  D) R4 `  [: k& p9 H8 g  _
8427.           )
      4 r' M" H% {( g2 o3 S2 I
8428.           (progn
      
8429.             (if (not (new_dialog "ddblock" dcl_id)) (exit))
      
8430.             (if ( = "*" (substr blkname 1 1))
      
8431.               (set_tile "Bl_name" (strcat blkname " - Anonymous block"))
      8 b  c' C' ]- g; l) Z
8432.               (set_tile "Bl_name" blkname)
      
8433.             )
      - ?  `1 W7 W: h# y  t
8434.             (setq help_entry  "modify_Block_Insertion_dialog")
      : Z$ Z2 O1 }4 b3 q+ N) A  u& x
8435.           )
      ) _" O9 w  y% G* B( L4 W
8436.         )
      
8437.       )
      
8438.     )
      & `. l3 @1 i, x) u0 p, Z4 B- y
8439.     (if (= newhatch 0)
      
8440.       (progn
      
8441.         (set_tile_props)
      - |2 D4 S% U" t- K( V6 M
8442.         (set_tile_handle)
      
8443.         (set_tile_pt1 1)
      
8444.         (set_tile_rot)
      ; l: q7 i+ y/ ?) L9 V+ d% _  m: [4 B! l
8445.         (set_tile_scale)
      
8446.         (set_tile_rc)
      
8447.         (if (= (logand blktype 1) 1)
      
8448.           (progn
      $ j* M3 d* `# [2 f: c
8449.             (mode_tile "xscale" 1)
      # F- P5 [9 y5 U  f  t/ o; ?7 c
8450.             (mode_tile "yscale" 1)
      # ~/ q% v2 X/ R7 {8 v- h! W
8451.             (mode_tile "zscale" 1)
      9 E5 v1 t3 n" r* g; i
8452.             (mode_tile "rot" 1)
      5 m$ F  t7 x3 U
8453.             (mode_tile "columns" 1)
      
8454.             (mode_tile "rows" 1)
      
8455.             (mode_tile "col_sp" 1)
      3 G$ E4 F$ K; [) H
8456.             (mode_tile "row_sp" 1)
      
8457.           )
      
8458.         )
      
8459.         ;; Define action for tiles
      * g+ \2 z  X1 b
8460.         (set_action_tiles)
      
8461.         (setq dialog-state (start_dialog))
      
8462.         (cond
      
8463.            (  (eq dialog-state 0)
      * P  y4 L) ]0 I
8464.               (setq pt1 (trans (cdr (assoc 10 old-elist)) ename 1))
      
8465.               (move_pt1 1)
      7 ^* j( ]) L6 I/ K- E
8466.               (reset))
      
8467.            (  (eq dialog-state 1)
      
8468.               (if (and (/= temp_xclip xcliponoff) (or (= blktype 0)(= blktype 36)))
      
8469.                 (xclip)
      & F6 ~7 V" S4 S% j! E  ?4 x, j
8470.               )
      * l6 J/ l9 o2 u  O4 q
8471.               (modify_block))
      
8472.            (  (eq dialog-state 3)
      9 _3 [  H5 p% ?2 _) x& j' G
8473.               (modify_block)
      
8474.               (setq pt1 (getpoint (list x1 y1 z1)  "\nInsertion point: "))
      
8475.               (move_pt1 1)
      7 ]3 p9 ^' J$ z9 T$ Z% i  C6 A  f5 a
8476.               (ddblock))
      & A5 G5 F( r+ I! s) N4 r8 F4 |
8477.            (  (eq dialog-state 4)
      0 M: b( ?5 L& ^% W
8478.               (modify_block)
      0 A: k0 a; C) M; c- y1 c
8479.               ;; Get current handle.
      8 h  ]' a  ]3 q8 {3 S
8480.               (setq hand (cdr (assoc 5 elist)))
      
8481.               (command "_hatchedit" ename)
      % d! P  g8 {  t) g$ T
8482.               ;; If OK in hatchedit, a *new* entity is created and the old one
      0 h, I$ |4 r7 J9 g/ N" f0 V( D( x
8483.               ;; is deleted.  So if the old one exists, it must have been a
      
8484.               ;; so rest the entity.
      
8485.               (if (entget (handent hand)) (reset))
      - r% l' `3 c# L' W# R
8486.            )
      
8487.         )
      
8488.       )
      3 {5 r. W9 ~5 n) ^5 ]2 G5 x
8489.     )
      1 \' `1 i4 m7 f% R
8490.   )
      8 J; L' q, r& q8 g4 O; X; N/ S" p# W
8491.   ;;
      ; J- P. z% z4 h. F: P
8492.   ;; Modify SHAPE
      
8493.   ;;
      2 X% h$ B4 o, C1 M$ x
8494.   (defun modify_shape ()
      8 x2 }. a8 D! a) D% P, ~. ?
8495.     (modify_properties)
      6 Q8 x# z8 ]9 q- w5 z# O" S
8496.     (setq pt1 (list x1 y1 z1))
      * l  e, ?7 z7 x2 R; w
8497.     (tempmod pt1 10 1)
      
8498.     (tempmod hght 40 nil)
      
8499.     (tempmod wid 41 nil)
      
8500.     (tempmod rot 50 nil)
      6 x  b2 X) @1 c( }. h& n
8501.     (tempmod obl 51 nil)
      1 k: G  g: y0 t, A8 t! x3 d! I
8502.     (entmod elist)
      
8503.   )
      
8504. 
      - M1 A" q( R9 X* m
8505.   (defun ddshape ()
      $ K1 R  |( m& R# l
8506.     (if (not (new_dialog "ddshape" dcl_id)) (exit))
      
8507.     (set_tile_props)
      0 R- P* L$ E: _. i; q; E
8508.     (set_tile_handle)
      & Z7 |; I0 y' q; f
8509.     (set_tile_pt1 1)
      
8510.     (set_tile_rot)
      
8511.     (set_tile_hght)
      
8512.     (set_tile_wid)
      
8513.     (set_tile_obl)
      ' _. V  G. \+ w0 u0 O1 ~
8514.     (set_tile "sh_name" (cdr (assoc 2 elist)))
      
8515.     ;; Define action for tiles
      8 B. Z/ P8 v- K  W4 b
8516.     (set_action_tiles)
      ; G  V: r: X1 w- X, C- i) _
8517.     (setq dialog-state (start_dialog))
      
8518.     (if (= dialog-state 0)
      & f/ n5 X6 t* |& R
8519.       (reset)
      
8520.     )
      8 ^6 q9 N7 E& x
8521.     (if (= dialog-state 1)
      
8522.       (modify_shape)
      
8523.     )
      + o! A' v) G& b
8524.     (if (= dialog-state 3)
      " V; @) l& o: p: [
8525.       (progn
      # K5 A) U+ x- |, }
8526.         (modify_shape)
      " `4 d, d" t9 d7 F  u, I. j
8527.         (setq pt1 (getpoint (list x1 y1 z1)  "\nInsertion point: "))
      
8528.         (ver_pt1 1)
      
8529.         (ddshape)
      
8530.       )
      
8531.     )
      * T/ n/ B; l4 t  N$ U
8532.   )
      4 v/ ?  R# C! e  l
8533.   ;;
      
8534.   ;; Modify TEXT or ATTDEF
      
8535.   ;;
      
8536.   ;; Set bit code for upside-down and backwards setting
      
8537.   ;;
      # P/ b, X& t, v1 H4 F
8538.   (defun code_71 ()
      
8539.     (cond ((and (= bkwd "0") (= upsd "0")) 0)
      
8540.           ((and (= bkwd "1") (= upsd "0")) 2)
      
8541.           ((and (= bkwd "0") (= upsd "1")) 4)
      5 O/ f3 s" {, J3 B, V
8542.           ((and (= bkwd "1") (= upsd "1")) 6)
      
8543.     )
      $ }7 H& Y* ~4 n7 b- _
8544.   )
      
8545.   ;;
      3 J( |/ U9 D" Q# Q
8546.   ;; Style action.  Reset widget values to style defaults
      6 S$ X: [6 b! d! s& s  V
8547.   ;;
      5 r/ I3 p4 O# F# ?* m: O
8548.   (defun style_act (index / style-list)
      * k3 c  ?; h5 b* J' K1 K; t4 Q
8549.     (setq style-idx (atoi index))
      
8550.     (setq tstyle (nth style-idx slist))
      
8551.     (setq style-idx (itoa style-idx))
      
8552.     (set_tile "style" style-idx)
      . m# i$ i; v' [# S' D
8553.     (setq style-list (tblsearch "style" tstyle))
      ! H+ U" K' @# I: Z( l
8554.     (setq shght (cdr (assoc 40 style-list)))
      % y0 m$ H4 x" D; ~4 c8 ^6 Q* \6 ^
8555.     (if (/= shght 0)
      ) k- @$ p, x, l; S' R
8556.       (progn
      
8557.         (setq hght shght)
      , ~& _" x9 H4 O. {
8558.         (set_tile "hght" (ai_rtos hght))
      $ x. [: n7 ^& |2 |
8559.       )
      , h! O9 C' y6 f' ~5 s
8560.     )
      
8561.     (setq wid (cdr (assoc 41 style-list)))
      
8562.     (set_tile "wid" (ai_rtos wid))
      % H( J5 B9 F1 h" e" I
8563.     (setq obl (cdr (assoc 50 style-list)))
      
8564.     (set_tile "obl" (ai_angtos obl))
      . Z6 J9 m) H, |2 K7 b+ ]
8565.     (setq bk-up (cdr (assoc 71 style-list)))
      " y6 M/ u5 N, h8 ~  G
8566.     (if (= (logand bk-up 2) 2)
      
8567.       (set_tile "bkwd" (itoa (setq bkwd 1)))
      
8568.       (set_tile "bkwd" (itoa (setq bkwd 0)))
      * Q, O7 k1 n" B
8569.     )
      
8570.     (if (= (logand bk-up 4) 4)
      8 W/ D3 q& P& r) N1 P/ U7 o' k# w5 B
8571.       (set_tile "upsd" (itoa (setq upsd 1)))
      
8572.       (set_tile "upsd" (itoa (setq upsd 0)))
      / C; K& B0 O# u% m4 `8 c: n9 o
8573.     )
      
8574.   )
      
8575.   ;;
      ( m. g, a4 [3 n% K
8576.   ;; Justification action.  Set vertical and horizontal alignment variables,
      4 a7 R" ~/ o+ H5 k2 V: i
8577.   ;; grey out rotation and height if alignment = "aligned", grey out rotation
      " Z5 F# c) @8 H: A
8578.   ;; if alignment = "fit".
      
8579.   ;;
      & `# s; @/ u# {2 f
8580.   (defun jlist_act (index / templist)
      2 O$ M( @0 a6 d% b; D9 H. `0 G; \, ?) ]
8581.     (setq just-idx (atoi index))
      , A; T( y0 k  e  \, a: d' R  u- a
8582.     (cond
      
8583.       ((= just-idx 0) (setq va 0 ha 0))
      
8584.       ((= just-idx 1) (setq va 0 ha 1))
      ( E/ O/ O1 h9 O  X, o
8585.       ((= just-idx 2) (setq va 0 ha 2))
      3 |: E4 ~6 V$ n) j# w2 t  Y
8586.       ((= just-idx 3) (setq va 0 ha 3))
      , R  [- ]2 J1 ]1 ]: Y
8587.       ((= just-idx 4) (setq va 0 ha 4))
      $ c# m7 y1 _' N4 Q. W  [0 x
8588.       ((= just-idx 5) (setq va 0 ha 5))
      1 t9 f7 W: n7 @+ }! Q: u& n- n
8589.       ((= just-idx 6) (setq va 3 ha 0))
      
8590.       ((= just-idx 7) (setq va 3 ha 1))
      6 z6 J9 H* J! A) R) x) q( ^
8591.       ((= just-idx 8) (setq va 3 ha 2))
      * Y) S0 J$ |9 t# {8 a
8592.       ((= just-idx 9) (setq va 2 ha 0))
      # ^) l3 t' F. [0 c" t4 @
8593.       ((= just-idx 10) (setq va 2 ha 1))
      
8594.       ((= just-idx 11) (setq va 2 ha 2))
      0 p/ D' p% d2 K. k# L. U2 n
8595.       ((= just-idx 12) (setq va 1 ha 0))
      
8596.       ((= just-idx 13) (setq va 1 ha 1))
      ' X+ X$ b" y( T4 j) S3 ]7 `
8597.       ((= just-idx 14) (setq va 1 ha 2))
      
8598.     )
      . T$ W6 }% L& r
8599.     (if (or (= ha 3) (= ha 5))  ; If Aligned or Fit text
      
8600.       (mode_tile "rot" 1)
      
8601.       (mode_tile "rot" 0)
      
8602.     )
      $ f& G; B" V' D
8603.     (if (= ha 3)                ; If Aligned text
      
8604.       (mode_tile "hght" 1)
      
8605.       (mode_tile "hght" 0)
      
8606.     )
      
8607.     (if (= ha 5)                ; If Fit text
      
8608.       (mode_tile "wid" 1)
      
8609.       (mode_tile "wid" 0)
      8 V) l: N- f( v1 Y" v: k
8610.     )
      - a: C/ ~; V, Z; r- A+ N
8611.     ;; Reset rotation and height if changing from aligned.
      6 e. Y! ^7 K' c; D' T* K
8612.     (if (and (= ha-prev 3)  (/= ha 3))
      
8613.       (progn
      
8614.         (set_tile "rot"  (ai_angtos (setq rot 0.0)))
      
8615.         (set_tile "hght" (ai_rtos (setq hght 1.0)))
      ) |) H# {7 [1 ]. }1 r+ _; X; F* {
8616.       )
      
8617.     )
      
8618. 
      
8619.     ;; Reset rotation and width if changing from fit.
      ' N5 v- s4 o6 R6 D  y/ J3 g" v
8620.     (if (and (= ha-prev 5) (/= ha 5))
      2 ?3 E* J2 l! \3 p' s
8621.       (progn
      5 N( z8 {4 u2 G( H5 J7 Z
8622.         (set_tile "rot" (ai_angtos (setq rot 0.0)))
      
8623.         (set_tile "wid" (ai_rtos (setq wid 1.0)))
      
8624.       )
      
8625.     )
      9 F1 T& Z" f+ K: A
8626. 
      7 m! I( Y% a/ z7 b) z9 F  H* N, v
8627.     (setq ha-prev ha)           ; update ha-prev for next time
      
8628.     (setq just-idx (itoa just-idx))
      : `4 E5 ^! n/ l0 Y( j/ j
8629.   )
      5 ~, X, B' x8 `9 h7 {, y9 f
8630.   ;;
      
8631.   ;; Set intitial alignment setting based on vertical and horizontal alignment
      " z) C  t# K& Q6 {6 p
8632.   ;; bit codes.
      ) R" Q) Q! H4 r2 v" U
8633.   ;;
      
8634.   (defun set_just_idx ()
      : A0 x; ^! }; p+ u* X" h% h
8635.     (cond
        p$ v+ O4 Z. y+ y4 A4 p# d0 W
8636.       ((= ha 0)             ; Horiz alignment = Left
      
8637.         (cond
      * G2 Z$ o# W. ~8 A
8638.           ((= va 0) (setq just-idx "0"))
      1 u" w1 P' F3 w
8639.           ((= va 1) (setq just-idx "12"))
      2 X) c. e# D/ P% O
8640.           ((= va 2) (setq just-idx "9"))
      
8641.           ((= va 3) (setq just-idx "6"))
      
8642.         )
      
8643.       )
      5 o: w8 F/ a. n6 ?- c2 v! Z
8644.       ((= ha 1)             ; Horiz alignment = Center
      
8645.         (cond
      
8646.           ((= va 0) (setq just-idx "1"))
      7 W) ^0 W" N( i! ^
8647.           ((= va 1) (setq just-idx "13"))
      
8648.           ((= va 2) (setq just-idx "10"))
      # y) V7 y3 z: G8 v; n
8649.           ((= va 3) (setq just-idx "7"))
      9 _6 Z; W& p  ]0 p
8650.         )
      . Y3 |- U: K) ^3 k, G
8651.       )
      $ \0 v- N7 q) j- `0 e
8652.       ((= ha 2)             ; Horiz alignment = Right
      6 |' Q. Y$ T) T8 F- v/ u
8653.         (cond
      
8654.           ((= va 0) (setq just-idx "2"))
      
8655.           ((= va 1) (setq just-idx "14"))
      2 d# a' s8 K8 F8 _1 t! S, l
8656.           ((= va 2) (setq just-idx "11"))
      $ S7 W; }. m- H+ i
8657.           ((= va 3) (setq just-idx "8"))
      2 _+ h, ~. m; A. }  X6 G3 y
8658.         )
      
8659.       )
      : e# I) A: ~5 R1 @
8660.       ((= ha 3) (setq just-idx "3"))   ; Aligned
      $ z$ _, F" _% g& R& c8 M: p) a
8661.       ((= ha 4) (setq just-idx "4"))   ; Middle
      8 [9 b: Z% V# I
8662.       ((= ha 5) (setq just-idx "5"))   ; Fit
      ( G  k6 M! e0 R
8663.       (T (setq just-idx "0"))
      $ e; D2 ~& X" v# r
8664.     )
      " c. D2 t# d* ~% X: {* \/ c8 h
8665.     just-idx
      
8666.   )
      
8667. 
      
8668.   (defun modify_text ()
      2 K* V2 |+ K4 @( [: U
8669.     ;;  insertion point
      : l6 {) d- V& \. }, u
8670.     (setq showpt (list x1 y1 z1))
      7 {# W& Q" C4 [+ l7 V0 ^. T
8671.     (setq bit-10 (trans showpt 1 ename))
      
8672.     ;;  alignment point
      
8673.     ;;  for 'Aligned' or 'Fit', alignment point must be different
      
8674.     ;;  for all others, use insertion point
      1 X1 Q' `2 z1 T. M
8675.     ;;  (ACAD will recompute insertion point)
      
8676.     (if (or (= ha 3) (= ha 5))
      
8677.       (progn
      
8678.         ;;  if no alignment point, fabricate one
      
8679.         (if (not alipt)
      2 X( X  d+ b) `" J0 N" i
8680.           ;;  add text width to insertion point
      
8681.           (setq alipt
      
8682.             (list (+ (car showpt) (car (cadr (textbox elist))))
      
8683.                   (cadr showpt)
      
8684.                   (caddr showpt)
      
8685.             )
      6 z$ g. s" w- q  \# D
8686.           )
      
8687.         )
      
8688.         (setq bit-11 (trans alipt 1 ename))
      
8689.       )
      
8690.       (setq bit-11 bit-10)
      : y. `/ H) ?' N  l% q
8691.     )
      
8692.     (modify_properties)
      
8693.     (tempmod tstyle 7 nil)
      
8694.     (tempmod bit-10 10 nil)
      # {# y0 H* F- e" N. z
8695.     (tempmod bit-11 11 nil)
      & ]8 [% @* i, ]2 Q1 X( g% F! i7 t  h
8696.     (tempmod text 1 nil)
      
8697.     (tempmod hght 40 nil)
      " \2 L8 d9 o: r2 V$ }* `3 a% W
8698.     (tempmod wid 41 nil)
      
8699.     (tempmod rot 50 nil)
      
8700.     (tempmod obl 51 nil)
      & }. L% ]3 ~2 x
8701.     (setq bk-up (+ (* bkwd 2) (* upsd 4)))
      
8702.     (tempmod bk-up 71 nil)
      * |4 I" k' [/ K: _
8703.     (tempmod ha 72 nil)
      1 h. P, H" C7 l9 A
8704.     ;; Attdefs use 74, text 73
      
8705.     (if (= etype "ATTDEF")
      
8706.       (progn
      
8707.         (tempmod attag 2 nil)
      
8708.         (tempmod atprompt 3 nil)
      4 l: e1 u' S% i
8709.         (setq icvp (+ inv (* 2 con) (* 4 vfy) (* 8 pre)))
      
8710.         (tempmod icvp 70 nil)
      
8711.         (tempmod va 74 nil)
      9 d  f& {2 G6 F8 Y! O7 B) [
8712.       )
      
8713.       (tempmod va 73 nil)
      " D3 L3 W8 o. k4 {  ~7 x
8714.     )
      
8715.     (entmod elist)
      4 X: j: D9 r' N# J9 H6 b- [
8716.   )
      
8717. 
      
8718.   (defun ddtext (/ 2ndpt slist i)
      
8719.     (if (= etype "TEXT")
      
8720.       (if (not (new_dialog "ddtext" dcl_id)) (exit))
      ; s0 ^5 H+ p( R
8721.       (if (not (new_dialog "ddattdef" dcl_id)) (exit))
      ) o7 K1 B. Q( U# M% A
8722.     )
      9 |0 R+ n; ]; d9 R, T
8723.     (set_tile_props)
      
8724.     (set_tile_handle)
      
8725.     (set_tile_text)
      
8726.     (set_tile_tag)
      
8727.     (set_tile_prompt)
      
8728.     (set_tile_hght)
      # F7 B; O- Q7 f+ @
8729.     (set_tile_wid)
      . z: a. i; h7 J/ w/ F
8730.     (set_tile_rot)
      
8731.     (set_tile_obl)
      8 K: _6 G9 ?& N! T& G* z
8732.     (set_tile_bk-up)
      0 o$ [3 r2 ~& ?
8733.     (set_tile_icvp)
      1 X& _+ a' d" p" b6 {: w8 F
8734.     (set_tile_style)
      
8735.     (set_tile_just)
      
8736.     (setq pt1 (trans (cdr (assoc 10 elist)) ename 1))
      $ z" b$ K/ f/ g+ r
8737.     (if (not (assoc 11 elist))
      
8738.       (progn (setq pt2 pt1)
      
8739.         (setq elist (cons (cons '11 (cdr (assoc 10 elist))) elist ))
      2 m3 g3 B/ q+ Y5 g( c. H% @2 x  T
8740.       )
      
8741. ;;(trans '(0.0 0.0 0.0) ename 1))
      & N5 \7 Z$ u0 d% p' a0 R/ Q
8742.       (setq pt2 (trans (cdr (assoc 11 elist)) ename 1))
      
8743.     )
      & ~6 ~' R2 j) ]% Z$ L1 E
8744.     (if (or (and (= ha 0) (= va 0))
      6 }* ~7 x& j" {! S8 [" y9 g  _! S
8745.             (= ha 3)
      # {! `& U; o8 t) R. [
8746.             (= ha 5)
      
8747.         )
      1 y! Y: W  V6 m7 N' |
8748.       (setq showpt pt1)
      
8749.       (setq showpt pt2)
      
8750.     )
      
8751.     (if (or (= ha 3) (= ha 5))
      0 W4 P% F( R9 @1 p, y) [+ {
8752.       (setq alipt pt2)
      
8753.       (setq alipt nil)
      . m8 a7 I# t8 K
8754.     )
      ' d* M+ s* \' r3 C. N6 Z
8755. 
      
8756.     (set_tile "x1_pt" (ai_rtos (setq x1 (car showpt))))
      
8757.     (set_tile "y1_pt" (ai_rtos (setq y1 (cadr showpt))))
      
8758.     (set_tile "z1_pt" (ai_rtos (setq z1 (caddr showpt))))
      1 H8 _( l. s! A/ W
8759. 
      ; N. J, x6 E" e) I, B5 R
8760.     ;; Define action for tiles
      ( {! Z8 I5 ~) J4 w) J
8761.     (set_action_tiles)
      " p, o% |1 p- C8 @. K
8762.     ;; Set focus initially to the text edit box.
      
8763.     (if (not i) (progn (mode_tile "t_string" 2)(setq i 1)))
      4 Q1 _  O* @: i/ T7 p
8764.     (setq dialog-state (start_dialog))
      7 e. Y3 @( D2 h8 f( N
8765.     (if (= dialog-state 0)
      
8766.       (reset)
      5 J7 a7 u0 l! L" A) d4 |3 `: S3 y1 m: u1 i( d
8767.     )
      
8768.     (if (= dialog-state 1)
      , O7 C& Z$ i* B. J3 q" N9 p; w- s
8769.       (modify_text)
      / M) n. Y" k- u, m: ~0 h
8770.     )
      
8771.     (if (= dialog-state 3)
      ! |) \8 V" c* D; `
8772.       (progn
      
8773.         (modify_text)
      3 g" _' O# v" K
8774.         (if (or (= ha 3) (= ha 5))
      
8775.           (progn
      4 d/ P- y$ ~4 q$ H8 O1 j
8776.             (setq showpt (getpoint (list x1 y1 z1) "\nFirst point: "))
      % s) N* B7 H* u0 {1 r( @
8777.             (if (not showpt)
      & `; ?  G0 g1 K& L1 X* A. o/ x5 O3 ~$ r) L
8778.               (setq showpt (list x1 y1 z1))
      
8779.             )
      " D/ K- E6 Q$ ^, [$ ]" ~5 _  D
8780.             (setq 2ndpt (getpoint showpt "\nSecond point: "))
      5 P- r' V4 H$ W
8781.             (if 2ndpt
      / m8 U- a' m, z$ F9 T6 }
8782.               (progn
      # q- a0 m3 Y$ w/ _
8783.                 (setq alipt 2ndpt)
      
8784.                 (tempmod showpt 10 1)
      $ Q9 Y0 U: }5 ]) j. A
8785.                 (tempmod alipt 11 1)
      
8786.                 (entmod elist)
      
8787.               )
      
8788.             )
      & c6 E% b6 X, h$ f- I4 w  m( j
8789.             (setq elist (entget ename))
      
8790.           )
      
8791.           (progn
      
8792.             (setq showpt (getpoint (list x1 y1 z1) "\nInsertion point: "))
      
8793.             (if showpt
      - H& K% e# D" v$ n5 [
8794.               (progn
      4 N6 ^( a- @0 H2 Q4 P7 F# u- ?# l
8795.                 (if (and (= ha 0) (= va 0))
      0 ^/ L# \" h& l
8796.                   (tempmod showpt 10 1)
      / @; y( t2 R$ [! J( Q/ g
8797.                   (tempmod showpt 11 1)
      
8798.                 )
      
8799.                 (entmod elist)
      
8800.               )
      $ v6 ^* q7 L6 L. g$ Y
8801.               (setq showpt (list x1 y1 z1))
      
8802.             )
      / _$ O/ p8 l- z, e
8803.           )
      
8804.         )
      ; {1 G+ v) I% F
8805.         (ddtext)
      # f; P: x. Q  Q7 l
8806.       )
      
8807.     )
      
8808.   )
      
8809. 
      
8810.   ;;
        R: m; \5 K/ h. u& v( q
8811.   ;; Modify MTEXT
      
8812.   ;;
      
8813.   (defun modify_mtext ()
      7 T) F) E% X% R
8814.     (modify_properties)
        U! e0 d/ R6 W3 @0 c
8815.     (setq pt1 (list x1 y1 z1))
      
8816.     (tempmod pt1 10 0)
      * |8 M8 C' E6 W0 m
8817.     (tempmod text 1 nil)
      ' l/ g& d3 \+ [5 }
8818.     (tempmod tstyle 7 nil)
      . }, p! Q+ a8 Y6 s! e
8819.     (tempmod just-idx 71 nil)
      7 V# ~  H4 q& ]' g
8820.     (cond
      
8821.       ((= dir-idx 0) (setq dir-idx 1))
      
8822.       ((= dir-idx 1) (setq dir-idx 3))
      5 b. n3 }) [" @! R* y
8823.       ((= dir-idx 2) (setq dir-idx 5))
      
8824.       (T (setq dir-idx 1))
      
8825.     )
      
8826.     (tempmod dir-idx 72 nil)
      - B+ W' Z/ s* I& t$ M+ Q7 [1 r
8827.     (tempmod hght 40 nil)
      9 |3 `" H/ s7 v" j+ K1 Z8 E
8828.     (tempmod wid 41 nil)
      , j* @3 ~$ R4 c, Z2 E0 x- ?
8829.     (tempmod rot 50 nil)
        \9 R  `% _. k# C  {3 z
8830.     (entmod elist)
      7 I4 f( o  j: U# |. e" `0 c# T& R. X
8831.   )
      
8832. 
      : K6 a5 }7 |' I) S: Y
8833.   ;; Set MText text style
      
8834.   (defun MText_style (index / style-list)
      
8835.     (setq style-idx (atoi index))
        D4 Q8 b, |1 N; v" q8 ^0 a
8836.     (setq tstyle (nth style-idx slist))
      
8837.     (setq style-idx (itoa style-idx))
      
8838.     (set_tile "style" style-idx)
      ! f8 w9 R1 z: c* ]: _
8839.     (setq style-list (tblsearch "style" tstyle))
      4 |8 s9 j+ o, ]1 }2 z7 A, R7 D
8840.     (setq shght (cdr (assoc 40 style-list)))
      . S/ z. V6 z; \4 M; {+ i& x
8841.     (if (/= shght 0)
      $ g- x' P7 G# I" {. A# F
8842.       (progn
      5 B  j0 y- Y( Z2 e$ I2 ~/ E) Z
8843.         (setq hght shght)
      / D" T6 o* ~5 A5 U# H  R
8844.         (set_tile "hght" (ai_rtos hght))
        C9 k6 G. h" U1 t
8845.       )
      7 u5 T' O4 T6 O; w& i
8846.     )
      
8847.   )
      
8848. 
      
8849.   ;; Run DDEDIT on given entity, working around possible re-entrancy
      " N2 \2 n7 ?# F9 s& T8 @
8850.   ;; problems with MTEXTED
      
8851.   (defun safe_ddedit (ename / orgMTextEd work)
      ' D9 \1 q$ y' A5 ^- b( ^
8852.     (setq orgMTextEd (getvar "MTEXTED"))
      ) H' u5 _  H% u8 m, R8 @$ k
8853.     (setq work orgMTextEd)
      
8854.     (if (= ":" (substr work 1 1))
      
8855.       (progn
      3 e- O7 g+ u7 r; i" M
8856.         (while (and (< 0 (strlen work)) (/= "#" (substr work 1 1)))
      ' c; o! @: D9 ~/ F
8857.           (setq work (substr work 2))
      ' f( \3 K- ^; l; O5 R$ x
8858.         )
      
8859.         (if (= "#" (substr work 1 1))
      & n; k: W- s' i
8860.           (setq work (substr work 2))
        ]3 b: s8 ~; m: L, i/ U. l
8861.         )
      * Z, B# b7 T/ D6 o' l) G( W
8862.         (setvar "MTEXTED" work)
        m, s# i# {/ Q! }' I& b
8863.       )
      : E( d& a: t5 A9 V6 Q2 d
8864.     )
      % `- y4 [3 A' o
8865.     (verify_arxapp_loaded "acmted.arx") ;; make sure it's loaded...
      ; K1 @/ v/ @6 A9 \+ u1 k. O3 C! \
8866.     (command "_DDEDIT" ename "")
      
8867.     (setvar "MTEXTED" orgMTextEd)
      5 k" k) x2 k7 ]4 y8 i, x
8868.   )
      . Z5 A3 x  Z! K3 ^3 ?- s6 J
8869. 
      
8870.   ;; Verify MText object width
      
8871.   (defun ver_MtextWidth (value)
      $ i. J  ]3 ]7 F# A0 l2 J  ]
8872.     (setq value (distof value))
      % N8 h2 ~8 n5 r: n& O
8873.     (set_tile "MTextWidth" (ai_rtos value))
      
8874.     (set_tile "error" "")
      $ q* J2 t; }4 ]9 _  @- Z
8875.     (if (< value 0.0)
      
8876.       (set_tile "error" "Value must be zero or positive.")
      
8877.       (setq wid value)
      0 n8 J, i$ y2 ]
8878.     )
      9 q( R. I% v3 H+ C: {
8879.   )
      
8880. 
      & r6 _% w* m  A2 {; i+ V, L
8881.   (defun ddmtext ( / gc3)
      9 I3 ]$ U" j+ I9 O. N% {) T, g, i
8882.     ;; Get dialog
      $ i6 Z# K+ E5 T. n! Y$ k8 L  a2 p3 d
8883.     (if (not (new_dialog "ddmtext" dcl_id)) (exit))
      0 g% E' P4 ]# |7 P
8884. 
      ( J) }7 L5 T: n7 N+ k+ e, ~2 Q' Z
8885.     ;; Load list boxes
      
8886.     (start_list "MTextJustify")
      
8887.     (mapcar 'add_list '(
      & Q5 j. T+ [/ C0 {
8888.                         "Top Left"
      
8889.                         "Top Center"
      
8890.                         "Top Right"
      8 M0 o- m, A4 P; u
8891.                         "Middle Left"
      
8892.                         "Middle Center"
      
8893.                         "Middle Right"
      : C& T) W/ p8 I2 z" A4 ~3 m; g" [
8894.                         "Bottom Left"
      
8895.                         "Bottom Center"
      ' Q- q( u6 Z1 e/ m. r9 Q' |$ {$ @
8896.                         "Bottom Right"
      
8897.                        )
      
8898.     )
      2 i/ S  @! L" B( A' e2 s$ @
8899.     (end_list)
      % c5 ?9 [# x! W! W: J6 J: K. E/ J
8900. 
      
8901.     (start_list "MTextDirection")
      
8902.     (mapcar 'add_list '(
      
8903.                         "Horizontal"
      2 \3 J% l+ L% o
8904.                         "Vertical"
      
8905.                         "By Style"
      
8906.                        )
        q/ F& |2 @) @" z# V2 z
8907.     )
      
8908.     (end_list)
      
8909. 
      
8910.     ;; Set initial tile values
      
8911.     (set_tile_props)
      
8912.     (set_tile_handle)
      
8913.     (set_tile_pt1 0)
      . E' `2 @8 a7 p
8914.     (set_tile_style)
      6 b( w, M; ?/ _6 [; |
8915.     (setq just-idx (cdr (assoc 71 elist)))
      + X! S3 l7 w) e/ j
8916.     (set_tile "MTextJustify" (itoa (1- just-idx)))
      & k6 B9 v: s; E* P1 x1 A
8917.     (setq dir-idx (cdr (assoc 72 elist)))
      ) j) ]& A; w' A
8918.     (cond
      
8919.       ((= dir-idx 1) (setq dir-idx 0))
      9 r$ U" U. [; y  b$ L
8920.       ((= dir-idx 2) (setq dir-idx 0))
      9 c# `4 T6 J7 X- _. N: g
8921.       ((= dir-idx 3) (setq dir-idx 1))
      ! L+ s" n! }2 v( c
8922.       ((= dir-idx 4) (setq dir-idx 1))
      * g( K: y) a7 b. y( y
8923.       ((= dir-idx 5) (setq dir-idx 2))
      6 t) f& K1 a; h3 m& }7 a
8924.       (T (setq dir-idx 0))
      ; ~+ X% J% a" L% D6 O, ]6 e
8925.     )
      
8926.     (set_tile "MTextDirection" (itoa dir-idx))
      
8927.     (set_tile "MTextWidth" (ai_rtos (setq wid (cdr (assoc 41 elist)))))
      
8928.     (set_tile_hght)
      $ Z; `# _, I) \, @0 ?% p" b! x
8929.     (set_tile_rot)
      . L* f% H3 [3 i9 |  h) V: h
8930. 
      
8931.     ;; Set edit box, disable if too long
      ' i$ m" `3 m4 A% }2 f# ?1 H
8932.     (setq gc3 (cdr (assoc 3 elist))
      * i) @$ U, i. ], l
8933.           text (cdr (assoc 1 elist)))
      ' X$ U9 Y0 i/ ~3 V2 h
8934.     (if gc3
      , _* h. C7 v' r% x
8935.       (progn  ;; Text is over 250 chars, disable edit tile
      % \( u$ G, N" W1 X- H% v
8936.         (set_tile "t_string" (strcat (substr gc3 1 25) " ..."))
      
8937.         (mode_tile "t_string" 1)
      7 j6 I3 T% I2 y0 V5 C* l* B
8938.       )
      
8939.       (if (> (strlen text) 80)
      
8940.         (progn  ;; Still too big
      3 B  {" h9 j7 {/ B$ h
8941.           (set_tile "t_string" (strcat (substr text 1 25) " ..."))
      # w. k4 ^1 \& D! c( T! _
8942.           (mode_tile "t_string" 1)
      
8943.         )
      
8944.         (set_tile "t_string" text)
      5 ~* R8 Z: P/ t- B% A/ h- \: W
8945.       )
      ) y1 Q' y  G( H8 l4 |
8946.     )
      
8947. 
      
8948.     ;; Define action for tiles
      / ^" X5 n. w( n, B9 ^
8949.     (set_action_tiles)
      
8950.     (action_tile "style" "(MText_style $value)")
      
8951.     (action_tile "MTextWidth" "(ver_MtextWidth $value)")
      
8952.     (action_tile "MTextEdit" "(done_dialog 4)")
      ( x# }: T6 m# ~  m) j+ L+ w# J
8953.     (action_tile "MTextJustify" "(setq just-idx (1+ (atoi $value)))")
      
8954.     (action_tile "MTextDirection" "(setq dir-idx (atoi $value))")
      ) w6 K2 X% Z6 V9 z, e, j
8955. 
      5 h) T4 H2 c# w1 _. V
8956.     ;; Set initial focus to text edit box.
      2 R! o' O- @; \& Q7 p6 W" z: K
8957.     (mode_tile "t_string" 2)
      
8958. 
      * ^; B4 t4 D& E$ @; g3 b) N
8959.     ;; Run the dialog
      3 r% B6 n- J1 F! v. s
8960.     (setq dialog-state (start_dialog))
      
8961.     (cond
      5 b6 {) l2 y+ j: ~3 @, b$ V
8962.       ;; Cancelled - restore saved data
      3 b# n9 _, H! Y" B! w
8963.       ((= dialog-state 0) (reset))
      
8964.       ;; OK - save new data
      
8965.       ((= dialog-state 1) (modify_mtext))
      
8966.       ;; Pick new insertion point
      
8967.       ((= dialog-state 3)
      
8968.         (modify_mtext)
      % i- _1 L/ b, c/ N8 [3 k# o
8969.         (setq pt1 (getpoint (list x1 y1 z1)  "\nNew Insertion Point: "))
      0 H5 T3 v" y5 Y  k4 I8 I2 V1 m
8970.         (ver_pt1 0)
      : \( F( _7 K9 W& e, D0 i' m
8971.         (ddmtext)
      3 f8 [5 M- K% a
8972.       )
      
8973.       ;; Run full editor
      
8974.       ((= dialog-state 4)
      
8975.         (modify_mtext)
      & X+ l) W1 \' |8 j* S) a: ]8 g8 E' g
8976.         (safe_ddedit ename)
      4 l# h5 I8 G( R
8977.         (setq elist (entget ename))
      
8978.         (ddmtext)
      8 C# v  N% L( V3 [5 x& @7 Q
8979.       )
      
8980.       (T nil)
      
8981.     )
      & z3 ?7 v5 \( ]' C) f: B9 B- J% O; H
8982.   )
      
8983. 
      
8984.   ;;
      8 `- C& C8 y. w. N% s( B  P9 \
8985.   ;; Modify VIEWPORT
      9 V4 \* t; s5 _3 f( N! s
8986.   ;;
      
8987. 
      3 q0 N2 ?$ `5 k" u) R5 O
8988.   (defun ddvport ()
      " O! U1 B6 h: D. |4 m* v+ [
8989.     (if (not (new_dialog "ddvport" dcl_id)) (exit))
      & ]3 f, D: L7 `
8990.     (set_tile_props)
      
8991.     (set_tile_handle)
      9 L* \, O7 {, q+ u) H6 o
8992.     (setq vpt (cdr (assoc 10 elist)))
      1 c( H% {2 C7 A5 z) _
8993.     (set_tile "xtext" (rtos (setq x1 (car vpt))))
      
8994.     (set_tile "ytext" (rtos (setq y1 (cadr vpt))))
      ; b1 q/ z$ l2 x+ c* [( d
8995.     (set_tile "ztext" (rtos (setq z1 (caddr vpt))))
      
8996.     (setq wid (cdr (assoc 40 elist)))
      
8997.     (set_tile "wid" (rtos wid))
      1 {8 q+ J- N! E# m. G3 ~
8998.     (setq hght (cdr (assoc 41 elist)))
      : A' h1 n) G" `+ o
8999.     (set_tile "hght" (rtos hght))
      
9000.     (setq vpid (cdr (assoc 69 elist)))
      
9001.     (set_tile "vpid" (itoa vpid))
      & p2 V2 U4 P& K; k6 o
9002.     (setq on-off (cdr (assoc 68 elist)))
      
9003.     (cond
      8 g; d/ Z( S& D; H7 e
9004.       ((= on-off 0) (set_tile "on-off" "OFF"))
      ) T- s  b/ B+ Y$ D
9005.       ((> on-off 0) (set_tile "on-off" "ON and Active"))
      
9006.       (T (set_tile "on-off" "ON and Inactive"))
      ; [( P2 A- }& ~( ~! ^
9007.     )
      0 V, v9 }) e7 X# U" X9 \* s1 Q; t
9008. 
      2 a% r( `9 @, [/ r- e9 K% Y) |) C' o
9009.     ;; Define action for tiles
      
9010.     (set_action_tiles)
      ! t/ m1 b  ^/ k6 }/ l- ?4 \& M% d
9011. 
      
9012.     (setq dialog-state (start_dialog))
      
9013.     (if (= dialog-state 0)
      + Q. C% p- z: U+ g& s! h* |
9014.       (reset)
      9 ~8 `; W7 D" v$ y
9015.     )
      & N8 ~* t: F# x/ i! E) q. {
9016.     (if (= dialog-state 1)
      
9017.       (progn
      $ y, O7 k! ~; ?! q$ t& E  \
9018.         (if (= ecolor   0) (setq ecolor "BYBLOCK"))
      ' M* ~  F3 `8 M5 D( ?
9019.         (if (= ecolor 256) (setq ecolor "BYLAYER"))
      # J$ y0 q9 @# A9 }+ R0 Q. U
9020.         (command "_.chprop" ename ""
      
9021.                  "_la" elayer
      
9022.                  "_c" ecolor ""
      5 ~$ G5 {8 |0 ~) L7 ~. {
9023.         )
      
9024.       )
      
9025.     )
      
9026.   )
      
9027.   ;;
      : n1 m% {' X: O/ @8 S0 \
9028.   ;; Modify POLYLINE
      
9029.   ;;
      + F3 x! o8 N# N9 P8 v/ U. i
9030.   (defun modify_polyline ()
      
9031.     (modify_properties)
      
9032.     (if (= ltgen "1")
      
9033.         (if (/= (logand bit70 128) 128)
      . X8 ^+ e5 ?% x: a% ^# B% z
9034.             (setq bit70 (+ bit70 128))
      
9035.         )
      9 x" i: a: k/ J0 B0 \$ d% D
9036.     )
      / Z( ~: \, `3 W6 \$ N
9037.     (if (= ltgen "0")
      
9038.         (if (= (logand bit70 128) 128)
      1 q8 \5 F: z. \% x6 [' U4 j5 r
9039.             (setq bit70 (- bit70 128))
      
9040.         )
      7 q' Z4 L7 {: c
9041.     )
      
9042.     (setq elist (subst (cons 70 bit70) (assoc 70 elist) elist))
      
9043.     (entmod elist)
      9 i: q2 X' j) g7 C0 }
9044.     ;; Added to take care of updating Vertex information for color
      # ~4 g, g1 g+ H# {. R( a: c- s! H, i0 d
9045.     ;; and linetype.
      
9046.     (setq save-ename ename save-elist elist)
      
9047.     (if (= (cdr (assoc 0 elist)) "LWPOLYLINE")
      * k% y3 f8 O- i5 h& S, P
9048.         (progn
      / D- A4 C7 Y1 U
9049.             (emod ecolor 62)
      
9050.             (emod eltype 6)
      
9051.             (emod eltscale 48)
      
9052.             (entmod elist)
      , w- `9 i7 q' ^4 {
9053.         )
      + Z4 [9 b3 n5 p
9054.         (progn
      
9055.             (setq ename (entnext save-ename))
      
9056.             (setq elist (entget ename))
      % r; }6 x* b+ d
9057. 
      
9058.             (while (not (= (cdr (assoc 0 elist)) "SEQEND"))
      8 H. i  y  ~% m+ @6 ~
9059.                 (emod ecolor 62)
      * V9 K/ _  w# R. d6 Q6 A
9060.                 (emod eltype 6)
      . U  M9 V/ P+ M8 O$ P
9061.                 (emod eltscale 48)
      9 M- C% V9 h2 f! ?+ E
9062.                 (entmod elist)
      
9063.                 (setq ename (entnext ename))
      
9064.                 (setq elist (entget ename))
      ! J- \: d+ @- ^, x" l
9065.             )
      
9066.         )
      # h- k6 v# @. Y  K& ?7 A5 X
9067.     )
      
9068.     ;; Update the SEQEND
      
9069.     (if (= (cdr (assoc 0 elist)) "SEQEND")
      
9070.       (progn
      7 f. U- {& J( `. h
9071.         (emod ecolor 62)
      : ~* r- |- g* M9 W7 d! f
9072.         (emod eltype 6)
      0 K; F8 ?0 V/ w; @0 [
9073.         (emod eltscale 48)
      7 K1 K  Z9 k2 ^/ a# |3 B
9074.         (entmod elist)
      
9075.       )
      8 H/ m! R; A7 f9 U/ b! ]8 H
9076.     )
      ) _% Y' S5 `& i! l2 s, a0 ?) Y
9077.     ;; Go back to header.
      
9078.     (setq ename save-ename elist save-elist)
      5 e! n( R; [2 N( J
9079. 
      , G5 I7 ?8 G  @/ y! a5 e
9080.     (entupd ename)
      
9081.   )
      
9082. 
      + N7 Z5 H8 M4 q5 P
9083.   ;; Increment vertex.  Set tile values to next vertex
      0 ^" \1 m/ v8 s3 d
9084.   ;;
        E7 w& w; T8 [
9085.   (defun next_vertex ()
      # Z2 d$ [5 o) p( u5 i
9086.     (if (= (cdr (assoc 0 vlist)) "LWPOLYLINE")
      
9087.         (progn
      
9088.             ;; If the counter reaches the number of vertices,
      
9089.             ;; roll it over to zero again.
      
9090.             (if (= ctr (cdr (assoc 90 vlist)))
      
9091.                 (setq ctr 0)
      
9092.             )
      ' Q* h. k: K" y8 u) G2 T
9093.                 (set_tile "ctr" (itoa (setq ctr (+ 1 ctr))))
      : f, J9 K; B' {; l5 ]$ ]
9094.             (set_tile_vpt pointype)
      
9095.         )
      / {. G  P0 k7 k4 p3 L
9096.         (progn
      
9097.             (setq vname (entnext vname))
      
9098.             (setq vlist (entget vname))
      
9099.             (if (= (cdr (assoc 0 vlist)) "VERTEX")
      
9100.                 (progn
      
9101.                     (set_tile "ctr" (itoa (setq ctr (+ 1 ctr))))
      1 }: g1 S$ J. r- I) r  F3 a
9102.                     (set_tile_vpt pointype)
      
9103.                 )
      " }2 W$ z9 L2 h- |. |8 H
9104.                 (progn
      
9105.                     (setq vname (entnext ename))
      
9106.                     (setq vlist (entget vname))
      ! I- }2 _6 a) \1 [; b( N- S6 ~
9107.                     (set_tile_vpt pointype)
      
9108.                     (set_tile "ctr" (itoa (setq ctr 1)))
        x1 |- \7 R9 S4 g& R9 w
9109.                 )
      6 R5 u# d8 S, [: @
9110.             )
      9 H0 \# n0 t& o3 F* A. l
9111.         )
      ) Q0 B2 }( Q- E6 I6 J( n
9112.     )
      8 U5 w) }5 u' g8 o, Y$ `& m" z, e
9113.   )
      
9114. 
      
9115.   (defun ddpline (/ oldecho)
      3 a, q3 |" d6 v, S( B, \
9116.     (if (not (new_dialog "ddpline" dcl_id)) (exit))
      0 v: e- i9 v4 O$ K7 O5 Y
9117.     (set_tile_props)
      3 L3 g( u5 ~/ u* X, O' F
9118.     (set_tile_handle)
      
9119.     (setq bit70 (cdr (assoc 70 elist)))
      : b' ]$ H; q, x  g
9120.     (setq bit75 (cdr (assoc 75 elist)))
      
9121.     (cond
      , N- s' z* R- t/ ?# m' O1 G, t# M
9122.       ((= (logand bit70 8) 8)   ; 3DPOLY
      / N5 W. n; W: _
9123.         (set_tile "ptype" (setq pltype "3D polyline"))
      ' g, x1 |  l/ e$ c, ?! |- i
9124.         (setq pointype 0)       ; WCS or ECS point values
      
9125.         (mode_tile "fit" 1)
      
9126.         (mode_tile "mesh" 1)
      % H- E% S7 {2 `& W6 z
9127.         (mode_tile "bezier" 1)
      
9128.         (mode_tile "ltgen" 1)
      
9129.         (set_tile "none" "1")
      
9130.         (set_tile_closed)
      
9131.         (set_tile_fitsmooth)
      5 O6 T3 S4 J( `# \7 W
9132.       )
      
9133.       ((= (logand bit70 16) 16) ; 3DMESH
      
9134.         (set_tile "ptype" (setq pltype "3D mesh"))
      # B0 q7 }0 ~) H  v1 N
9135.         (setq pointype 0)
      " x8 ^7 h0 o' r
9136.         (mode_tile "pline" 1)
      6 L2 x* Q' A' K7 @
9137.         (mode_tile "fit" 1)
      
9138.         (mode_tile "ltgen" 1)
      
9139.         (setq m (1- (cdr (assoc 71 elist))))
      % F9 Q9 y% }- L( _5 F  t, V
9140.         (setq n (1-(cdr (assoc 72 elist))))
      
9141.         (setq u (1- (cdr (assoc 73 elist))))
      0 [+ K+ K$ N0 K
9142.         (if (< u 0) (setq u 0))
      , h, Y+ i7 O% Z% R
9143.         (setq v (1- (cdr (assoc 74 elist))))
      
9144.         (if (< v 0) (setq v 0))
      
9145.         (set_tile "m" (itoa m))
      
9146.         (set_tile "n" (itoa n))
      1 g. |3 d2 f) V$ y1 U* t' C
9147.         (set_tile "u" (itoa u))
      
9148.         (set_tile "v" (itoa v))
      7 x; g( o0 P0 w/ y* Z
9149.         (set_tile_closed)
      
9150.         (set_tile_fitsmooth)
      
9151.       )
      8 ]) z+ Y7 l$ x9 w- \
9152.       ((= (logand bit70 64) 64) ; POLYFACE MESH
      
9153.         (set_tile "ptype" (setq pltype "Polyface mesh"))
      $ b: V7 n( O8 J4 v' E, Z9 l
9154.         (setq pointype 0)
      + E, |7 b3 n' [+ J: W! s4 {/ Z. G& F
9155.         (mode_tile "f-s" 1)
      ' [. R% z. m. A+ ^
9156.         (mode_tile "mesh" 1)
      ' M: ?  f2 d4 H! ^/ s0 J# b. o: Z
9157.         (mode_tile "pline" 1)
      
9158.       )
      
9159.       (T                        ; 2D POLYLINE
      
9160.         (set_tile "ptype" (setq pltype "2D polyline"))
      * ~1 @; g5 @7 k! L: F
9161.         (setq pointype 1)
      # b* h/ U2 S& S6 v3 F2 w& l# F
9162.         (mode_tile "bezier" 1)
      
9163.         (mode_tile "mesh" 1)
      ) a2 N/ |9 G+ m. O& {6 T
9164.         (if (= (logand bit70 128) 128)
      & c9 s8 i- u4 o5 ]4 B+ N
9165.             (set_tile "ltgen" (setq ltgen "1"))
      $ l! w+ j  U! x2 S* ^$ Q
9166.         )
      
9167.         (set_tile_closed)
      + ^. }+ y3 h4 `
9168.         (set_tile_fitsmooth)
      
9169.       )
      * O9 V/ w6 `3 p+ m& |/ J
9170.     )
      
9171. 
      
9172.     (if (= (cdr (assoc 0 elist)) "LWPOLYLINE")
      * T6 U' i% g& G3 T, i
9173.         (progn
      ' m5 ]( j  d8 K  }! N
9174.             (if (not next) (setq vname ename))
      : T" b0 A% {7 s
9175.             (setq next T)
      
9176.             (set_tile "ctr" (itoa (setq ctr 1)))
      6 t0 f/ h+ U  n# b0 Q
9177.             (setq vlist (entget ename))
      1 t& e! u. @% i$ X2 D; V
9178.         )
      
9179.         (progn
      
9180.             (if (not next) (setq vname (entnext ename)))
      
9181.             (setq next T)
      / D2 E% u3 h7 j' I  r4 w5 }
9182.             (set_tile "ctr" (itoa (setq ctr 1)))
      0 c( o3 P6 a! W3 D
9183.             (setq vlist (entget vname))
      2 p# z9 Y  p; R$ W
9184.         )
      
9185.     )
      
9186.     (set_tile_vpt pointype)
      
9187.     ;; Define action for tiles
      
9188.     (set_action_tiles)
      
9189.     (setq dialog-state (start_dialog))
      , }( p: l1 f: f9 L
9190. 
      / `, F4 h9 d$ l. E. i/ Q1 c
9191.     (if (= dialog-state 0)
      
9192.       (reset)
      
9193.     )
      + F  Q' e. J- q. I, y4 g
9194.     (if (= dialog-state 1)
      
9195.       (progn
      
9196.         (modify_polyline)
      
9197.         (if (or (= pltype "2D polyline")
      ; f$ @. G# z' s' {3 c) u- K
9198.                 (= pltype "3D polyline")
      7 Q5 o9 v& b5 Q* A: e/ e6 U) _& r
9199.             )
      
9200.           (progn
      , K$ k  _# P8 N. O
9201.             (command "_.pedit" ename)
      $ S4 C- S+ _3 \: v4 G3 P9 c% I6 q7 v% W
9202.             (if (= spltype 0) (command "_d"))
      
9203.             (if (= spltype 1) (command "_f"))
      7 e1 \6 D" H; V0 I
9204.             (if (or (= spltype 5)
      
9205.                     (= spltype 6)
      
9206.                 )
      
9207.               (progn
      
9208.                 (setvar "splinetype" spltype)
      ! x% s3 Y: k4 z8 ^
9209.                 (command "_s")
      
9210.               )
      
9211.             )
      
9212.             (if (= closed "0")
      8 u( X  S8 r3 \+ b
9213.               (command "_o")
        g3 G+ I1 I- B, f
9214.               (command "_c")
      $ V6 L5 C5 F: h/ ^, l
9215.             )
      
9216.             (command "")
      % ]: A: n  s% D0 ]  Z
9217. 
      
9218.             (if (= spltype 0)
      
9219.                 (progn
      ) r- ]/ r  }  z. f4 ]( E% T: c% n
9220.                     (setq oldecho (getvar "cmdecho"))
      
9221.                     (command "_cmdecho" 0)
      
9222.                     (command "_convertpoly" "_light" ename "")
      : T7 g7 K) r6 B4 `$ R  K3 d
9223.                     (command "_cmdecho" oldecho)
      
9224.                 )
      
9225.             )
      
9226.           )
      
9227.         )
      
9228.         (if (= pltype "3D mesh")
      8 z6 ]4 Z3 V, ?  s, c! w4 G
9229.           (progn
      # o& Q1 `: y& }& t
9230.             (command "_.pedit" ename)
      
9231.             (if (= spltype 0) (command "_d"))
      
9232.             (if (or (= spltype 5)
      
9233.                     (= spltype 6)
      8 W1 x8 K+ ~. f- i7 @1 `
9234.                     (= spltype 8)
      $ u7 ?5 G: I8 R3 W/ I' a
9235.                 )
      
9236.               (progn
      - t, f8 C! V! t3 Z# }& \
9237.                 (setvar "surftype" spltype)
      - O" T+ \0 b3 n* w6 d8 w
9238.                 (setvar "surfu" u)
      , E# d' W( X0 H; j9 {2 g7 r
9239.                 (setvar "surfv" v)
      $ t% L0 a- s& [( N
9240.                 (command "_s")
      
9241.               )
      ! L, d7 Z& m' K1 E4 X
9242.             )
      / l. @. p/ [$ X5 }2 J# Z1 d/ r
9243.             (if (/= closedm old-closedm)
      9 u8 s# i7 O1 ?! `
9244.               (command "_m")
      + Z1 O+ h4 o2 ^. {5 |
9245.             )
        D7 V7 q' s" L, W% ^5 {) @9 b
9246.             (if (/= closedn old-closedn)
      4 i% ?# l) z; F/ |* N7 _* J
9247.               (command "_n")
      
9248.             )
      
9249.             (command "")
      ' ~" _0 j! Y# M5 P) n
9250.           )
      
9251.         )
      8 c2 l! a6 s1 U$ f/ l
9252.       )
      % ~7 r' n: w" p) ?7 a) i' E
9253.     )
      
9254.   )
      5 D, ]5 n* m) b/ Y6 b+ F% ?$ Y
9255.   ;;
      - h; |; W) _/ P
9256.   ;; All the spline data is contained in a single elist. We must do some
      
9257.   ;; tricky list processing to loop through the elist in order to display
      
9258.   ;; all of the control points.
      
9259.   ;;
      
9260.   ;; The structure of the elist is different for rational and non-rational
      
9261.   ;; splines. Therefore, we check the rational spline flag.
      
9262.   ;;
      
9263.   (defun next_cntl_pt ()
      & ~$ W+ o3 i3 j3 `) S+ C: h$ B
9264.     (setq elem-no 0)               ;; elem-no = element counter
      
9265.     (if (= first-10-time 1)        ;; If first time, find location of first
      3 W& |# {; [; O. J* W) G5 h
9266.         (foreach list_item elist   ;; cntl point element in elist
      " b. H; n, w' [: G
9267.            (progn
      6 ~0 c, W$ n$ E! ]1 u9 U
9268.                (setq elem-no (+ 1 elem-no))
      $ U8 _3 F3 l; p) E( T( d
9269.                (if (= (car list_item) 10)
      
9270.                    (progn
      " b# G( l8 H" A/ U3 N7 y: P' b
9271.                        (if (= first-10-time 1)
        y. m+ U% ^. R3 s) p) w
9272.                            (progn
      5 ~  o& k, v; Q5 R' y9 e
9273.                               (setq first-10-rec (- elem-no 1))
      
9274.                               (setq first-10-time 0)
      $ G4 ^* R6 k1 ?% K
9275.                               (if (= rational_spl_flag 1) ;; if rational
      : S* g7 G$ ]* R. E; `$ @
9276.                                   (setq cur-10-rec (+ elem-no 1))
      ! G  G+ X8 k0 [1 A2 R
9277.                                   (setq cur-10-rec elem-no)
      
9278.                               )
      
9279.                            )
      4 U# w2 R* f4 D1 M* w4 z
9280.                        )
      
9281.                    )
      7 V9 g# e  {8 q5 R5 y( f. L
9282.                )
      ; T! J3 o' ~) ^) l
9283.            )
      % |6 x, v7 F# w, J  j3 O1 |
9284.         )
      
9285.     )
      0 W# @0 W4 Z$ o: x" C9 s: F
9286.     ;; Now we know the location of the first "10" record; it's stored
      
9287.     ;; in first-10-rec. The first 10 record was already displayed when
      
9288.     ;; the dialog first came up so let's display the second one when
      
9289.     ;; the user presses the "next" button (the first time through).
      2 H5 o' Q4 {6 M: a; f& S' }. p
9290.     ;;
      
9291.     (setq temprec (nth cur-10-rec elist))
      . x+ |6 N6 g! k2 Q: m4 P  v
9292.     ;;
      
9293.     (if (= (car temprec) 10)   ;; if 10 record
      
9294.       (progn
      9 `% k0 [% x3 R" ]
9295.         (if (= rational_spl_flag 1)    ;; if rational spline
      % F& T2 s7 K+ A( K" s; z
9296.           (progn
      8 N+ y. A4 W7 U! [" b, \
9297.             (setq tempweight (nth (+ cur-10-rec 1) elist))
      " K% |6 F/ L0 O3 ?: {0 D, _# @
9298.             (setq cur-10-rec (+ 2 cur-10-rec))
      ) s, j& F3 H& Z# Q- e
9299.           )
      
9300.           (progn                       ;; else
      
9301.             (setq cur-10-rec (+ 1 cur-10-rec))
      
9302.           )
      : m2 i; ^1 r' G$ C) ?( |5 b$ B
9303.         )
      
9304.       )                                ;; end if rational spline
      3 j2 }4 [/ z% n0 G% D' S* }$ W' |
9305.       (progn                   ;; else reset counters
      6 ^: V+ h* {6 n! h9 ~8 ?3 q
9306.         (setq temprec (nth first-10-rec elist))  ;; get 1st 10 rec
      
9307.         (setq tempweight (nth (+ first-10-rec 1) elist))
      ! Q/ a% U, r& E# Q8 H" A/ U$ Y" W
9308.         (setq cntl-pt-indicator 0)
      
9309.         (if (= rational_spl_flag 1)             ;; if rational
      $ t* Q7 C- J- ~% A7 u+ |1 ^
9310.             (setq cur-10-rec (+ first-10-rec 2)) ;; point to 2nd 10 rec
      
9311.             (setq cur-10-rec (+ first-10-rec 1)) ;; point to 2nd 10 rec
      
9312.         )
      # [6 _" |1 @; C7 f/ v* i# S/ B$ r5 D! K
9313.       )
      
9314.     )                          ;; end if 10 record
      3 D/ ]- Y; s  b! u1 ~1 G
9315. 
      ' \! \+ h$ _/ y% R  R# ?
9316.     ;; Display cntl point, weight and ctr. Increment ctr.
      
9317.     (setq cntl-pt (cdr temprec))
      , J, e7 {/ x( l! @2 L/ D/ M1 ~
9318.     (set_tile "xtext" (rtos (setq x1 (car cntl-pt))))
      1 l/ T  j# T( }3 ]. @+ S! n
9319.     (set_tile "ytext" (rtos (setq y1 (cadr cntl-pt))))
      / K8 i" ?$ I" A# ?1 ?! \( n' l. L
9320.     (set_tile "ztext" (rtos (setq z1 (caddr cntl-pt))))
      
9321.     (setq cntl-pt-indicator (+ 1 cntl-pt-indicator))
      * Y7 Y2 i$ s; A3 W
9322.     (set_tile "cntl_ctr" (itoa cntl-pt-indicator))
      
9323.     (if (= rational_spl_flag 1)                     ;; if rational
      0 c" [  P1 e6 \- C  `
9324.         (set_tile "weight" (rtos (cdr tempweight))) ;; disp wght
      / l4 f! V/ d6 I0 u( j" m2 [
9325.         (mode_tile "weight_text" 1)                 ;; disable wght
      
9326.     )
      
9327.   )
      
9328.   ;;
      
9329.   ;; All the spline info is contained in a single elist. We must do some
      
9330.   ;; tricky list processing to loop through the elist in order to display
      
9331.   ;; all of the user data points.
      
9332.   ;;
      
9333.   (defun next_data_pt ()
      6 R8 U" K) ^( {' V
9334.     (setq elem-no 0)               ;; elem-no = element counter
      . A& L% v- ]# S+ G5 O0 ?
9335.     (if (= first-11-time 1)        ;; If first time, find location of first
        f( t# a9 |4 v& r" C" S
9336.         (foreach list_item elist   ;; data point element in elist
      
9337.            (progn
      
9338.                (setq elem-no (+ 1 elem-no))
      2 N" H7 N, `; g2 t7 H: \- V
9339.                (if (= (car list_item) 11)
        U) m2 x" Q6 K2 O# j( f+ B, @( Y
9340.                    (progn
      
9341.                        (if (= first-11-time 1)
      
9342.                            (progn
      
9343.                               (setq first-11-rec (- elem-no 1))
      
9344.                               (setq cur-11-rec elem-no)
      
9345.                               (setq first-11-time 0)
      
9346.                            )
      
9347.                        )
      
9348.                    )
      ; B8 z& T, Z1 y6 [) |% ^# Z
9349.                )
      
9350.            )
      - e# s( s/ U* C, f2 S; B5 a
9351.         )
      
9352.     )
      
9353.     (setq temprec (nth cur-11-rec elist))
      
9354.     ;; If it's not a DXF "11" element then we've gone past the last
      
9355.     ;; "11" element. Go back to first "11" element. Reset counters.
      
9356.     (if (= (car temprec) 11)
      
9357.         (setq data-pt (cdr temprec))
      
9358.         (progn                           ;; else
      # q6 v4 d3 [1 z& Y# S: P# a
9359.            (setq data-pt (cdr (nth first-11-rec elist)))
      
9360.            (setq cur-11-rec first-11-rec)
      
9361.            (setq data-pt-indicator 0)
      / g) u# y# y: W. t
9362.         )
      
9363.     )
      
9364.     ;; Display data point and ctr. Increment counters.
      
9365.     (set_tile "dxtext" (rtos (setq x1 (car data-pt))))
      
9366.     (set_tile "dytext" (rtos (setq y1 (cadr data-pt))))
      * D. p4 c+ S% o, {* Q
9367.     (set_tile "dztext" (rtos (setq z1 (caddr data-pt))))
      
9368.     (setq data-pt-indicator (+ 1 data-pt-indicator))
      0 y' n' t/ z( C' l
9369.     (set_tile "data_ctr" (itoa data-pt-indicator))
      
9370.     (setq cur-11-rec (+ 1 cur-11-rec))
      
9371.   )
      . H) M( S; H8 H/ T
9372.   ;;
      
9373.   ;; Modify SPLINE
      0 }$ j, o* K/ t" ?" K. O5 B7 a) U9 p
9374.   ;;
      + x; k6 _* n3 k; x) q. a: E% s: H
9375.   (defun modify_spline ()
      
9376.     (modify_prop_geom)
      / f6 _% Q  U) @9 |% X) r
9377.     (entmod elist)
      1 E' w- Y! P0 O" Z- q9 X
9378.   )
      ! w* f; a  F- Y0 c  g4 i- V3 b
9379. 
      
9380.   (defun ddspline ()
      
9381.     (if (not (new_dialog "ddspline" dcl_id)) (exit))
      , y  l& o" D! s$ o7 G9 x
9382.     (set_tile_props)
      
9383.     (set_tile_handle)
      - O5 ^7 g7 i9 [4 F1 E
9384.     (set_tile_spline_props)
      1 F4 a& L" C! J
9385.     ;; Display first control point
      
9386.     (set_tile_cntl_pt)
      
9387.     ;; Display first data point
      . W4 E- c* V4 m* R9 U: _
9388.     (set_tile_data_pt)
      ; j/ Y* n: D4 z' |5 z
9389. 
      
9390.     ;; Initialize flags to indicate first time through the dialog.
      
9391.     ;; For control points and user data points the "next" buttons
      
9392.     ;; in the dialog call the appropriate functions.
      % i$ D' v+ D% N; y
9393.     (setq first-10-time 1)
      $ h  R  F1 S1 @8 x% I, T5 t
9394.     (setq first-11-time 1)
      
9395.     ;; initialize control point number counter
      + F1 n5 i9 Y2 y' P
9396.     (setq cntl-pt-indicator 1)
      4 z! w: O6 x$ [' E
9397.     (setq data-pt-indicator 1)
      ! ^1 E! O, f. C6 ^7 R
9398.     (set_tile "cntl_ctr" (itoa cntl-pt-indicator))
      * F  \1 W+ a: ~9 `8 v  q
9399.     (set_tile "data_ctr" (itoa data-pt-indicator))
      
9400.     (set_action_tiles)
      6 t( Z, c# l$ n: B3 S
9401.     (setq dialog-state (start_dialog))
      ) \$ h/ v: v8 Z, ?6 w  b* [  \
9402. 
      
9403.     (if (= dialog-state 0)
      4 s* K( U  n* j3 W6 M
9404.       (reset)
      5 F( t) o& o$ S* z
9405.     )
      
9406.     (if (= dialog-state 1)
      % B* x0 U9 Z# ^
9407.       (modify_spline)
      + i( w1 m5 Y4 x: V  x# X6 A5 C
9408.     )
      9 J; _0 e& H/ M
9409.   )
      " W9 X) m2 K) Y/ L. d7 p) Q" g
9410. 
      
9411.   ;;
      4 W+ Q/ W/ g5 }5 Z. ^+ Z. w
9412.   ;; Modify DIMENSION
      
9413.   ;;
      ( `# N4 g9 O2 y& p
9414.   (defun ddimen (/ dtypebit blkname bename sublist a stname n dimtbl
      
9415.                    dimsty dimlist dimtext svtext dimovr sv_dvlist stlist
      # C! q, s! C; P; x0 _5 F& I) n
9416.                    dimtype dimsvcurset)
      
9417.    (setq dimtype "DDIMEN"
      3 T+ |9 q: `/ Q
9418.           dimsvcurset (ddimen_dimsty_restore)
      
9419.     )
      1 d( O0 a7 ]$ O. q, A% b
9420.     (if (not (new_dialog "ddimen" dcl_id)) (exit))
      
9421.     (set_tile_props)
      
9422.     (set_dimen_props)
      
9423.     (setq dimtext (cdr (assoc 1 elist)))
      
9424.     (set_tile "t_string" (if (= "" dimtext) "<>" dimtext))
      4 N6 F+ X! R# j- u
9425.     (set_tile_handle)
      ; w7 I8 w" f7 _$ Z- E" Y( v0 z! ?- ?
9426.     ;; Define action for tiles
      
9427.     (set_action_tiles)
      
9428. 
      9 N. t/ j: ?) a* p* e
9429.     ;; Set initial focus to text edit box.
      
9430.     (mode_tile "t_string" 2)
      
9431. 
      . R( n& \6 H8 U
9432.     (setq dialog-state (start_dialog))
      0 \" }3 L5 K# ~& F; Q
9433.     (if (= dialog-state 0)
      % a0 C2 y  ?6 p
9434.       (if (= ddimmt 1)
      & o( h8 s& h' r5 w7 a% _
9435.         (reset)
      4 c8 X8 v0 D9 U# Q6 d3 D- }
9436.       )
      ; Q, x2 b+ d( q8 J$ w* v6 y
9437.     )
      9 d7 M+ A# `9 e8 t
9438.     (if (= dialog-state 1)
      
9439.       (progn
      
9440.         (if (/= dimsty stname)
      , |+ n# ?! l/ [4 c4 k
9441.           (progn
      4 ?. v; \/ _) A4 R
9442.             ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
      
9443.             ; doesn't have it.
      & r1 ]2 `! s0 j& o+ `
9444.             (if (null (assoc 3 elist))
      
9445.               (setq elist (append elist (list (cons 3 dimsty))))
      
9446.               ; else just replace it.
      4 W9 M1 e: w8 P7 j" Z* g1 Z  ^
9447.               (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
      + N6 j8 x' C) @
9448.             )
      8 C' n* H& H" n9 b5 z
9449.             ; refresh sv_dvlist with new dimstyle.
      / i5 N0 U0 Q+ Y+ d" V. K/ M0 c7 q
9450.             (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      
9451.           )
      8 }. n  O' U; q8 A' P1 x
9452.         )
      0 T+ u5 N  l. C* K8 l
9453.         (if (not (null dimlist))   ; attempted to change dimvars
      
9454.           (ddimen_complist sv_dvlist dimlist dimtbl)
      ) p3 m$ Q, L& ^
9455.         )
      
9456.         ; Modify dimension text
      9 H+ A2 |. _, F& X9 ^
9457.         (if (/= dimtext text)
      % {* K4 A# F% _7 B& M1 p8 b
9458.           (progn
      
9459.             (setq dimtext (if (= text "<>") "" text))
      & l9 S# d& D& a! W6 U5 ?# d9 z
9460.             (setq elist (subst (cons 1 dimtext) (assoc 1 elist) elist))
      
9461.           )
      
9462.         )
      # F( N0 L" z& P' a
9463.         (modify_properties)
      2 _8 \0 ]1 N3 ]1 u, y- a% }( _) ?
9464.         (entmod elist)
      # Q3 I2 W9 \, f
9465.       )
      % l" O; ^, I& F& x
9466.     )
      : X! o  f" X9 s: M0 P2 E5 G/ j7 f$ p
9467.     (if (= dialog-state 4)
      0 ]' K' m0 m) R7 T0 Y
9468.       (progn
      6 |, _* y# s6 ~4 L  |# o! U; ]; V
9469.         (setq ddimmt 1)
      
9470.         (if (/= dimsty stname)
      
9471.           (progn
      
9472.             ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
      
9473.             ; doesn't have it.
        M" E$ l9 z% {( o- f' r, G! H
9474.             (if (null (assoc 3 elist))
      
9475.               (setq elist (append elist (list (cons 3 dimsty))))
      
9476.               ; else just replace it.
      7 D6 x9 V" l" Q3 M7 z4 ]; h7 h
9477.               (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
      - e7 m5 j" h% W, D
9478.             )
      $ _0 N9 v/ ^; V5 C
9479.             ; refresh sv_dvlist with new dimstyle.
      
9480.             (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      + e8 Z- [" U: h/ ~! \  M
9481.           )
      ( ^8 d# F8 Q/ Y5 T# m. g
9482.         )
      
9483.         (if (not (null dimlist))   ; attempted to change dimvars
      ! Z0 h4 j0 E! ~& v* t: n# ]2 B% D
9484.           (ddimen_complist sv_dvlist dimlist dimtbl)
      7 E8 x3 u5 A& U+ J: T! Q
9485.         )
      0 O0 E. f' j' A
9486.         ; Modify dimension text
      / k3 [% L7 o1 S& |& V: X
9487.         (if (/= dimtext text)
      ' ~) D  i/ A; h. s& O8 o
9488.           (progn
      % y/ ]1 ?8 z8 m  p9 O
9489.             (setq dimtext (if (= text "<>") "" text))
      
9490.             (setq elist (subst (cons 1 dimtext) (assoc 1 elist) elist))
      
9491.           )
      , Y: ~" C  U3 \% X0 B* n% x+ `
9492.         )
      $ F/ a; T# U. \' N, L
9493.         (modify_properties)
      
9494.         (entmod elist)
      
9495.         (safe_ddedit ename)
      
9496.         (setq elist (entget ename))
      
9497.         (ddimen)
      
9498.       )
      
9499.     )
      
9500.     (ddimen_setvars dimsvcurset)      ; Prepare to exit
      ' r' M: v! n9 |* S' J7 R& Y# r
9501.   )
      
9502. 
      / ~  U1 v: q: r/ X9 s
9503.   ;;
      
9504.   ;; Modify TOLERANCE
      ( |) \# _1 w; n9 {
9505.   ;;
      ; v1 @' S. }2 J9 U) i: Z
9506.   (defun ddtolerance (/ a stname n dimtbl
      
9507.                    dimsty dimlist dimovr sv_dvlist stlist dimtype
      
9508.                    dimsvcurset)
      
9509.     (setq dimtype "DDTOLERANCE"
      - D# }4 E" \. f4 K3 L/ S% W
9510.           dimsvcurset (ddimen_dimsty_restore)
      
9511.     )
      
9512.     (if (not (new_dialog "ddtolerance" dcl_id)) (exit))
      ' B  l# ?; [4 m* K# Q
9513.     (set_tile_props)
      % h* u( j6 h. |) X( ^
9514.     (set_dimen_props)
      8 B* c+ m- h* a6 z3 Q
9515.     (set_tile_handle)
      % b3 Q7 o9 v5 t# p) S3 @
9516.     (set_action_tiles)
      
9517.     (setq dialog-state (start_dialog))
      / J. D. Z$ G1 m  @1 U9 F
9518.     (if (= dialog-state 0)
      * e  e" }- V) P# Q$ H6 s+ B# j5 H
9519.       (if (= ddimmt 1)
      
9520.         (reset)
      : N8 Q2 L6 o; d' I; t0 J- @: M
9521.       )
      / k7 h- ~" D; S  ~3 N  X0 A
9522.     )
      / y4 }# O1 ~* o/ M! s9 s1 c
9523.     (if (= dialog-state 1)
      
9524.       (progn
      + h3 ?% n) M) ]& N/ @5 {% u
9525.         (if (/= dimsty stname)
      1 S, G& a1 b3 `& V& Z6 C5 L
9526.           (progn
      
9527.             ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
      : ~' j* ^0 F7 j/ |1 N5 ?/ L. ?
9528.             ; doesn't have it.
      
9529.             (if (null (assoc 3 elist))
      $ a: [$ ]4 v  u" R4 I) u  n
9530.               (setq elist (append elist (list (cons 3 dimsty))))
      
9531.               ; else just replace it.
      
9532.               (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
      * ]* ^5 A9 J. \1 l
9533.             )
      
9534.             ; refresh sv_dvlist with new dimstyle.
      " E6 Z! a1 ?) I7 B
9535.             (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      
9536.           )
      
9537.         )
      . i% y& {7 g/ @- U
9538.         (if (not (null dimlist))   ; attempted to change dimvars
      
9539.           (ddimen_complist sv_dvlist dimlist dimtbl)
      
9540.         )
      
9541.         (modify_prop_geom)
      / w" X' T" j& q8 O
9542.         (entmod elist)
      9 k+ }" ~" [+ E8 c9 \6 v; E
9543.       )
      % `' A. m9 Y4 F, E* L$ {
9544.     )
      
9545.     (if (= dialog-state 4)
      7 L& L2 T' s4 i$ Z4 }
9546.       (progn
      + w, m" E0 ^& _" k
9547.         (setq ddimmt 1)
      
9548.         (if (/= dimsty stname)
      
9549.           (progn
      
9550.             ; Be sure to add (3 . dimstylename) element. R12 *UNNAMED case
      
9551.             ; doesn't have it.
      
9552.             (if (null (assoc 3 elist))
      + M9 A7 P/ J! n# W' h. o
9553.               (setq elist (append elist (list (cons 3 dimsty))))
      
9554.               ; else just replace it.
      , p% t" O5 p$ J2 z  P: o
9555.               (setq elist (subst (cons 3 dimsty) (assoc 3 elist) elist))
      
9556.             )
      
9557.             ; refresh sv_dvlist with new dimstyle.
      
9558.             (setq sv_dvlist (tblsearch "dimstyle" dimsty))
      
9559.           )
      
9560.         )
      7 u" V  @2 |" q: u3 W2 x/ n
9561.         (if (not (null dimlist))   ; attempted to change dimvars
      ' m9 h; f3 R. C. C' O
9562.           (ddimen_complist sv_dvlist dimlist dimtbl)
      9 R$ f; [8 @, k
9563.         )
      / H! u0 q9 W+ ^/ R. d9 \
9564.         (modify_properties)
      
9565.         (entmod elist)
      
9566.         (safe_ddedit ename)
      
9567.         (setq elist (entget ename))
      ' ?, ~6 M* i5 R
9568.         (ddtolerance)
      
9569.       )
      
9570.     )
      * W* O+ s4 w4 Z5 G9 @- u7 O
9571.     (ddimen_setvars dimsvcurset)      ; Prepare to exit
      " p8 \4 N# r1 I8 P( C$ F
9572. )
      
9573. 
      2 Q8 r1 D0 T; A+ a, E, z' C2 V  F
9574.   ;;
      
9575.   ;; ddimen_dlg - jump to ADS ddim module
      
9576.   ;;
      4 S6 g0 O) x3 g% m& L
9577. 
      
9578.   (defun ddimen_dlg (dimtype tile dimsty dvlist / dimlist)
      $ u  z0 U. [8 ~. l" B* o
9579. 
      4 U1 D6 x; t! `- K* d/ e
9580.     ; Jump to DDIM with overrides if any.
      # T: u3 n& _% k
9581.     (cond ((= tile 11) (setq dimlist (c:ddim "DDMODIFY" dimtype tile dimsty dvlist))) ; Geometry
      % ]! F* e% E* O' |
9582.           ((= tile 12) (setq dimlist (c:ddim "DDMODIFY" dimtype tile dimsty dvlist))) ; Format
      
9583.           ((= tile 13) (setq dimlist (c:ddim "DDMODIFY" dimtype tile dimsty dvlist))) ; Annotation
      
9584.     )
      
9585.   )
      
9586. 
      + W( }' d6 R2 x1 a$ o& Y1 f$ I8 e
9587.   ;;
      
9588.   ;; Dimension variables updated are stored as overrides.
      
9589.   ;;
      % s1 ]2 B- d; ~6 m8 M* H/ d
9590. 
      
9591.   (defun ddimen_complist (dimolist dimnlist dimtbl / i odvar ndvar
      2 c( H  [- t8 `8 ]0 `0 R: g, B/ x8 {
9592.                           dv dime commandIssued)
      
9593. 
      
9594.     ; Here we skip the following first three items:
      
9595.     ;   (0 . "DIMSTYLE") (2 . sylename) (70 . 0)
      5 Z! f, |2 ^* c: T6 A
9596.     ;
      
9597.     ; The list comparison immediately begins with dimvar.
      
9598.     ;
      
9599.     ;  dimolist - original states of dimvars
      # ~; p5 l% e' E; p0 Q3 _1 _
9600.     ;  dimnlist - new dimvar list which is of the resbuf's
      
9601.     ;  dime - entity name for the dimension
      % U  j# C( G# @' b  n& m
9602.     ;  odvar - value of dimvar for the dimolist
      ; W# r* _' w5 c' O1 R9 M: v7 r
9603.     ;  ndvar - value of dimvar for the dimnlist
      
9604. 
      , t& K* J. m1 i: P5 U
9605.     (setq i 3
      
9606.           dime (cdr (assoc -1 elist))
      7 i9 Z  i* `0 ?4 j  d% i* n
9607.     )
      
9608.     (while (setq odvar (cdr (nth i dimolist)))
      6 o) s; N2 G# o( p/ ]' c
9609.       (progn
      
9610.         (setq ndvar (cdr (nth i dimnlist)))
      + A8 V6 ]0 {' p' S! h" X+ `
9611.         (setq dv (nth i dimtbl))
      
9612.         (if (eq dv "dimtxsty")
      6 E2 [  Q1 Y9 `& `  G9 I
9613.             (setq odvar (cdr (assoc 2 (entget odvar)))
      
9614.                   ndvar (cdr (assoc 2 (entget ndvar)))
      
9615.             )
      
9616.         )
      
9617. 
      
9618.                 ;
      ' d( p+ l1 E8 Z& K
9619.                 ; In order for DIMOVERRRIDE to operate correctly with string
      & J: O9 o) _) q% h# K- T
9620.                 ; based dimvars, we must pass "." versus NULL strings.
      1 ~" x8 f0 Q4 S/ `3 K/ O
9621.                 ; In this case ndvar is the new dimvar value the user wishes
      2 `1 |! O, ?" H" Y2 w: l2 U& \
9622.                 ; to update on selected dimensions.
      " X/ {, D. F  S6 R2 j
9623.                 ;
        i# R- L# x7 y& [
9624.             (if (/= ndvar odvar)
      % m0 N: S, g  p; B; D1 M
9625.               (if (= 'STR (type ndvar))
      
9626.                 (if (= ndvar "")
      
9627.                       (setq ndvar "."))))
      
9628. 
      
9629.         (if (/= ndvar odvar)
      ; t) P+ q7 K$ k8 K9 I+ L1 R- w
9630.           (progn
      ! \" @; ^8 Z- T3 `: Z
9631.             (setq dv (strcat "_" dv))
      1 w$ L3 ~6 z0 s& A; S3 p
9632.             ;
      
9633.             ; Start the dimoverride command
      ; C8 m( y% _3 P, x$ w# E
9634.             ;
      - c) w6 u* h0 ?" {" D
9635.             (if (not commandIssued)
      
9636.                (progn
      
9637.                  (command "_.dimoverride")
      
9638.                  (setq commandIssued "T")
      5 p& F$ v% ]9 d" e6 s# V
9639.                )
      
9640.             )
      
9641.             ;
      
9642.             ; Issue dim overrides
      " h) w" r1 s% B& X6 c6 ], R9 |6 U
9643.             ;
      
9644.             (if (and (or (= dv "_dimclrd") (= dv "_dimclrt") (= dv "_dimclre"))
      ; l. ^" ^2 S3 E
9645.                      (or (= ndvar 0) (= ndvar 256))
      
9646.                 )
      ; @$ d! \1 L$ h9 P1 ]$ X2 ]
9647.               (progn
      
9648.                 (if (= 0 ndvar) (command dv "BYBLOCK"))
      5 |9 [2 f0 r% M# Q5 b& [
9649.                 (if (= 256 ndvar) (command dv "BYLAYER"))
      
9650.               )
      
9651.               (command dv ndvar)
      2 M9 n, X! ~( L! x8 f1 a2 I
9652.             )
      
9653.           )
      
9654.         )
      
9655.         (setq i (1+ i))
      
9656.       )
      ! X( C( I4 i* V7 @
9657.     )
      ) ?* t1 S# {& ^" S5 f& y4 k+ B
9658.     ;
      
9659.     ; Select Entity and terminate command
      
9660.     ;
      
9661.     (if commandIssued
      
9662.         (command "" dime "")
      & z; U/ T+ t% J) Y+ o* H5 }1 H+ x! B
9663.     )
      
9664.   )
      
9665. 
      
9666.   ;;
      ! S  W) t: a. p/ q, h5 P3 e
9667.   ;; Get style name currently selected style name.
      . }4 }8 _5 W. `  s+ J/ p
9668.   ;;
      ) p8 R, n; {) l& |/ B
9669. 
      
9670.   (defun ddimen_style (/ dimsty)
        I/ C" C  [$ i& N) B; O# j
9671.     (setq dimsty (nth (atoi (get_tile "mod_style")) stlist)
      : m5 @0 Y* Q5 X9 l1 w, l
9672.           dimlist (ddimen_getdimvars dimsty)
      $ ?. D( m0 _& F4 f: k$ ^9 f' m
9673.     )
      
9674.     dimsty
      
9675.   )
      $ M* V2 P% |4 e: R/ [; O& W
9676. 
      ! A" L( P  F5 C# k! h
9677.   ;;
      6 E7 |. b( k6 @
9678.   ;; Set dimvars
      
9679.   ;;
      
9680.   (defun ddimen_setvars (dimsvcurset / dv i)
      
9681.     (setq dv (cdr (nth 1 dimsvcurset)))
      
9682.     (command "_.dimstyle" "" dv)
      7 r, F6 i2 C" q; Z* y1 {. Z
9683.     (setq i 3)
      * `2 r1 J" \& g0 v* z) m
9684.     (while (setq dv (nth i dimsvcurset))
      
9685.       (progn
      $ F' p5 I) c* ~
9686.         (setvar (car dv) (cdr dv))
      " Z9 \/ U8 h8 A- J5 V: k
9687.         (setq i (1+ i))
      0 q# J. V6 D: d# D6 E* m6 h8 E
9688.       )
      * k3 E1 N2 \4 y( J2 o0 V
9689.     )
      
9690.   )
      
9691.   ;;
      3 J+ g% \3 u( T: F$ U' ^5 k
9692.   ;;  End-of-dimension
      
9693.   ;; ==================
      3 z+ E( N! A! F7 \* v5 |+ |9 z
9694. 
      3 `! T" r6 N+ i" h) j8 T. }( s, ^
9695.   ;;
      8 t0 m: g7 M! S+ X: O$ k
9696.   ;; Sub-dialogues for properties.  Common to all object dialogues
        U6 l' T& x" y% H$ [! H8 K6 |
9697.   ;;
      8 d; u! K' r( g/ ~1 E% Y! ^
9698.   ;; This function pops a dialogue box consisting of a list box,image tile, and
      ( X9 I  ]$ z( P5 p4 K/ d
9699.   ;; edit box to allow the user to select or type a color number.  It returns
      ) b% T: t8 ^, a$ L
9700.   ;; the color number selected.
      " m4 X. C: t1 V
9701.   (defun getcolor (/ old-idx colorno cname lay_clr)
      & O6 s8 P* h. w+ W' M" M8 q1 w
9702.     (if (= (get_tile "error") "")
      
9703.       (progn
      
9704.         ;; Get the color associated with this object's layer, for use
      
9705.         ;; in the color swatch if the user selects color BYLAYER.
      3 f, Y/ G. C' B
9706.         (setq lay_clr (cdr (assoc 62 (tblsearch "layer" elayer))))
      
9707.         (if (numberp (setq temp_color (acad_colordlg ecolor T lay_clr)))
      + A% f& O3 b5 t4 N' B
9708.           (progn
      
9709.             (setq ecolor temp_color)
      
9710.             (setcolor)
      
9711.           )
      
9712.           (setq testcolor temp_color)
      
9713.         )
      
9714.       )
      : H7 U% ?# m# G( t, _1 T
9715.     )
      4 T) ?3 ^% z; f0 q' |- l0 Y
9716.     ecolor
      
9717.   )
      
9718.   ;;
      7 N4 F) i( U1 M- x
9719.   ;; Function to set the color tiles.
      
9720.   (defun setcolor()
      5 Q  ~3 p4 n9 q
9721.     (cond
      ! G6 x+ f/ [% Y- L# r
9722.       ((= 0 ecolor)
      : v; q1 g# K/ ~; E6 q/ e4 m
9723.         (set_tile "t_color" "BYBLOCK")
      . M2 n7 z3 G' h  s
9724.         (col_tile "show_image" 7 nil)    ; show BYBLOCK as white
      - C6 S( B. {$ {' v! u5 g+ o, y
9725.       )
      + j0 w! N) ~; }/ N  o! U
9726.       ((= 1 ecolor)
      ; c- T& B- z5 X2 a- r
9727.         (set_tile "t_color" "1 red")
      8 j# d4 g! f9 Q/ J, Q) E. B1 N
9728.         (col_tile "show_image" 1 nil)
      
9729.       )
      : f7 U. }: ]7 t( t- f( `" j
9730.       ((= 2 ecolor)
      
9731.         (set_tile "t_color" "2 yellow")
      1 N7 k, R) k, s3 j
9732.         (col_tile "show_image" 2 nil)
      
9733.       )
        T, V9 I) E* {  U- z1 f4 {8 Q
9734.       ((= 3 ecolor)
      
9735.         (set_tile "t_color" "3 green")
      : h% h& N6 T6 W. h+ ~
9736.         (col_tile "show_image" 3 nil)
      
9737.       )
      
9738.       ((= 4 ecolor)
      / E" n  z7 G9 u; ~8 I6 h* E( c
9739.         (set_tile "t_color" "4 cyan")
      
9740.         (col_tile "show_image" 4 nil)
      - f2 ^9 ~! `, s( U; x
9741.       )
      
9742.       ((= 5 ecolor)
      7 u0 F& a& v6 f# k5 |& |2 ^
9743.         (set_tile "t_color" "5 blue")
      % L" F8 s. m+ E, t8 g) D0 q
9744.         (col_tile "show_image" 5 nil)
      
9745.       )
      % |/ y+ ~. x+ h. {% N! L9 G
9746.       ((= 6 ecolor)
      
9747.         (set_tile "t_color" "6 magenta")
      
9748.         (col_tile "show_image" 6 nil)
      - r/ S; L5 @7 u" N) ~5 S/ l. v) O& c
9749.       )
      2 {; g1 ~1 R% [$ X
9750.       ((= 7 ecolor)
      0 O! C% @) d& \( _9 s; a8 X3 c. ?/ q
9751.         (set_tile "t_color" "7 white")
      
9752.         (col_tile "show_image" 7 nil)
      
9753.       )
      
9754.       ((= 256 ecolor)
      
9755.         (set_tile "t_color" "BYLAYER")
      3 L' J- z& {- B1 g; c% Y+ j
9756.         (col_tile "show_image" (bylayer_col) nil)
      
9757.       )
      ( H3 K& V1 z; E# ~* P! H
9758.       (T
      
9759.         (set_tile "t_color" (itoa ecolor))
      
9760.         (col_tile "show_image" ecolor nil)
      9 X/ D" [$ O: S
9761.       )
      2 Z- R4 X! G! E
9762.     )
      
9763.   )
      
9764.   ;;
      
9765.   ;; This function pops a dialogue box consisting of a list box, image tile, and
      , u2 h. n- f: V7 f% F6 }
9766.   ;; edit box to allow the user to select or  type a linetype.  It returns the
      7 t* ~1 w- ~  |( K! N
9767.   ;; linetype selected.
      & P) y5 n7 K5 O7 b, W9 L/ _6 t0 X
9768.   ;;
      ) _* e7 `! e# }0 y5 ]& e  z( q
9769.   (defun getltype (/ old-idx ltname)
      
9770.     (if (not lt-idx)
      
9771.       (progn
      1 d" u7 o0 m. @! O$ V& o5 `3 {
9772.         (make_lt_lists)             ; linetype lists - ltnmlst, mdashlist
      
9773.         (cond
      ' S8 t; V# r  ]6 h- K$ }' a  `
9774.           ((= eltype "BYLAYER")
      
9775.              (setq lt-idx (getindex "BYLAYER" ltnmlst)))
      % z3 W2 K8 ?, f" `, z7 F
9776.           ((= eltype "BYBLOCK")
      ! U& S+ W9 d0 m' s  Z
9777.              (setq lt-idx (getindex "BYBLOCK" ltnmlst)))
      
9778.           (T (setq lt-idx (getindex eltype ltnmlst)))
      
9779.         )
      , r, Z/ `+ S9 @2 v
9780.       )
      
9781.     )
      
9782. 
      
9783.     (if (= (get_tile "error") "")
      
9784.      (progn
      4 V0 y) c4 {! O- e$ k
9785.       (if (not (new_dialog "setltype" dcl_id)) (exit))
      
9786.       (start_list "list_lt")
      ' j2 o+ k( O! x6 A$ d, U2 t5 Q) F
9787.       (mapcar 'add_list ltnmlst)  ; initialize list box
      * T7 B6 O9 Z3 Y3 n" O1 D
9788.       (end_list)
      ( W- J8 y6 C4 r
9789.       (setq old-idx lt-idx)
      * N: u( e+ G" b, v
9790.       (ltlist_act (itoa lt-idx))
      
9791. 
      
9792.       (action_tile "list_lt" "(ltlist_act $value)")
      
9793.       (action_tile "edit_lt" "(ltedit_act $value)")
      $ M/ p0 o4 f8 }. A
9794.       (action_tile "accept" "(test_ok)")
      
9795.       (action_tile "cancel" "(reset_lt)")
      
9796. 
      
9797.       (if (= (start_dialog) 1) ; User pressed OK
      , Q9 `+ a& t6 B; b2 d5 s' o' O
9798.         (cond
      
9799.           ((= lt-idx 0)
      * @2 ?$ H! x3 |6 D
9800.             (set_tile "t_ltype" (bylayer_lt))
      + D) g* v/ E6 J) ^2 x% p5 }
9801.             "BYLAYER"
      
9802.           )
      7 L+ y. e) G+ Q9 n1 I
9803.           ((= lt-idx 1)
      
9804.             (set_tile "t_ltype" "BYBLOCK")
      ! C* w, @% G7 n/ f1 ?, [3 V
9805.             "BYBLOCK"
      & o& v# l1 a" j1 x3 p
9806.           )
      $ h' P& z6 P7 D  ]$ H
9807.           (T  (set_tile "t_ltype" ltname) ltname)
      
9808.         )
      
9809.         eltype
      
9810.       )
      
9811.      )
      ) Q$ y3 H- w# A  [/ j, F0 `$ _) m
9812.      eltype
      
9813.     )
      4 W  \8 s) l: M+ B# R
9814.   )
      
9815.   ;;
      
9816.   ;; Edit box entries end up here
      
9817.   (defun ltedit_act (ltvalue)
      
9818.     (setq ltvalue (xstrcase ltvalue))
      
9819.     (if (or (= ltvalue "BYLAYER")
      7 V) ~' ~6 `$ s5 O& \
9820.             (= ltvalue "BY LAYER"))
      
9821.       (setq ltvalue "BYLAYER")
      
9822.     )
      , _# ?  ~* q  H( h7 r
9823.     (if (or (= ltvalue "BYBLOCK")
      
9824.             (= ltvalue "BY BLOCK"))
      2 o: s) V% W$ {
9825.       (setq ltvalue "BYBLOCK")
      ; X$ j& M  \' j* S* T: N) z  c
9826.     )
      
9827.     (if (setq lt-idx (getindex ltvalue ltnmlst))
      ; Q/ W0 U3 a* P
9828.       (progn
      
9829.         (set_tile "error" "")
      
9830.         (ltlist_act (itoa lt-idx))
      
9831.       )
      
9832.       (progn
      ) f( O0 H' f8 p! t/ K" w! c% F
9833.         (set_tile "error" "Invalid linetype.")
      
9834.         (setq lt-idx old-idx)
      % T# T% E( }% d2 R4 X. C
9835. ;;        (mode_tile "edit_lt" 2)
      % e6 ^3 Z% @% s; W( F! p) L( z" i
9836. ;;        (mode_tile "edit_lt" 3)
      
9837.       )
      ) X5 u$ ?( h& f
9838.     )
      
9839.   )
      
9840.   ;;
      1 Z6 H1 d3 u4 ^4 _# O4 S
9841.   ;; List selections end up here.  Update the list box, edit box, and color
      9 D' ^( A$ i8 e! d( g
9842.   ;; tile.
      
9843.   ;;
      
9844.   (defun ltlist_act (index / dashdata)
      7 \) z. n( \+ v# P( X
9845.     (set_tile "error" "")
      6 K: v) i% D* E
9846.     (setq lt-idx (atoi index))
      
9847.     (setq ltname (nth lt-idx ltnmlst))
      2 h  w4 _- u" o
9848.     (setq dashdata (nth lt-idx mdashlist))
      4 e! q/ x  i0 [* d
9849.     (col_tile "show_image" 0 dashdata)
      
9850.     (set_tile "list_lt" (itoa lt-idx))
      
9851.     (set_tile "edit_lt" ltname)
      
9852.   )
      7 Q, s4 f; t) o% }: t8 {" _
9853.   ;;
      ' \  ~. o/ }8 k% }6 Z+ R$ i% O1 w# I
9854.   ;; Reset to original linetype when cancel it selected
      , W9 L, |- Z8 x2 I& d
9855.   ;;
      
9856.   (defun reset_lt ()
      # G- X/ w+ [; P$ a( c: N' y; _  C
9857.     (setq lt-idx old-idx)
        b6 z& m7 s0 T1 T* \5 W# E
9858.     (done_dialog 0)
      8 E+ M) d( O7 h: H' R0 E8 j
9859.   )
      
9860.   ;;
      / l; D  r0 j/ ~# X+ x. d% }! d! w
9861.   ;; This function pops a dialogue box consisting of a list box,image tile, and
      # q  X( K* `9 l( H
9862.   ;; edit box to allow the user to select or type a layer name.  It returns the
      - P2 E) W7 ~: `& G* T
9863.   ;; layer name selected.  It also has a button to find the status (On, Off,
      ' ^) k3 g" B) J$ F# i
9864.   ;; Frozen, etc.) of any layer selected.
      ) e8 G& G& w* ^' V, H
9865.   ;;
      
9866.   (defun getlayer (/ old-idx layname on off frozth linetype)
      4 g& o1 p. w$ W
9867.     ;; Create layer list the first time the layer
      
9868.     ;; dialogue is called.
      7 Q- i" ]+ c) {$ n9 ]/ x# f: T8 r
9869.     (if (not lay-idx)
      
9870.       (progn
      
9871.         (make_lay_lists)
      
9872.         (setq lay-idx (getindex elayer laynmlst))
      
9873.       )
      
9874.     )
      0 l% X1 w7 ~2 L
9875. 
      
9876.     (if (= (get_tile "error") "")
      
9877.      (progn
      
9878.       (if (not (new_dialog "setlayer" dcl_id)) (exit))
      
9879.       (set_tile "cur_layer" (getvar "clayer"))
      ; L' S  Q. F. ^5 i/ I. [0 z5 r
9880.       (start_list "list_lay")
      8 u5 p! Z4 O( g' z: T% ]4 z
9881.       (mapcar 'add_list laynmlst)  ; initialize list box
      
9882.       (end_list)
      
9883.       (setq old-idx lay-idx)
      
9884.       (laylist_act (itoa lay-idx))
      
9885.       (action_tile "list_lay" "(laylist_act $value)")
      
9886.       (action_tile "edit_lay" "(layedit_act $value)")
      4 U) H9 M% x% F4 ]3 q9 b
9887.       (action_tile "accept" "(test_ok)")
      
9888.       (action_tile "cancel" "(reset_lay)")
      4 |# o/ ~: p' t0 e6 B0 ], G
9889.       (if (= (start_dialog) 1) ; User pressed OK
      
9890.         (progn
      - T  e+ @: L/ T1 H% X
9891.           (set_tile "t_layer" layname)
      
9892.           (setq elayer layname)
      
9893.           ;; If layer equals bylayer reset color tile
      
9894.           (if (= ecolor 256)
      7 t; U; J, C" j2 Q' p
9895.             (col_tile "show_image" (bylayer_col) nil)
      7 c/ g7 |, n6 E* V3 R0 x$ L
9896.           )
      
9897.           layname
      
9898.         )
      , n  ~: o# i, Y* v$ i9 H0 u
9899.         elayer
      ! d7 X* ^6 _$ |4 P" }* I
9900.       )
      0 Y, V) |2 Y: E1 R/ y: I1 ?
9901.      )
      ' G! q1 p' J, @
9902.      elayer
      
9903.     )
      
9904.   )
      + o7 `& o$ |6 Y+ ^6 h' ?! W
9905.   ;;
      
9906.   ;; Edit box selections end up here.  Convert layer entry to upper case.  If
      
9907.   ;; layer name is valid, clear error string, call (laylist_act) function.
      6 I4 x8 m+ S/ g- P3 S/ o1 }2 Y9 Y
9908.   ;; Else print error message.
      + b: y' q1 k$ Z1 W5 a) g
9909.   ;;
      
9910.   (defun layedit_act (layvalue)
      
9911.     (setq layvalue (xstrcase layvalue))
      
9912.     (if (setq lay-idx (getindex layvalue laynmlst))
      
9913.       (progn
      
9914.         (set_tile "error" "")
      3 T! |2 |: A' O) ~3 C; s5 d; R
9915.         (laylist_act (itoa lay-idx))
      ' p0 d* E9 p/ h" V* a/ J$ Z+ @6 ~
9916.       )
      - x) N2 d* f  N8 j% n( h
9917.       (progn
      
9918.         (set_tile "error" "Invalid layer name.")
      
9919. ;;        (mode_tile "edit_lay" 2)
      
9920. ;;        (mode_tile "edit_lay" 3)
      
9921.         (setq lay-idx old-idx)
      
9922.       )
      
9923.     )
      2 H. T' \1 F4 b! S- |1 W
9924.   )
      6 h4 g$ m3 a2 g8 u: V* I( E0 ~
9925.   ;;
      
9926.   ;; List entry selections end up here.
      ; I  f/ d0 t/ v! f
9927.   ;;
      * h2 C8 M2 I+ Y' A
9928.   (defun laylist_act (index / layinfo color dashdata)
      
9929.     ;; Update the list box, edit box, and color tile.
      
9930.     (set_tile "error" "")
      
9931.     (setq lay-idx (atoi index))
      
9932.     (setq layname (nth lay-idx laynmlst))
      4 j% f9 T3 |# e/ t
9933.     (setq layinfo (tblsearch "layer" layname))
      
9934.     (setq color (cdr (assoc 62 layinfo)))
      5 w/ Y% C; @" D1 R5 g+ L+ ~' o1 f/ P7 `
9935.     (setq color (abs color))
      4 e3 @$ _$ G- K! u' f
9936.     (setq colname (colorname color))
      " F; M. N- y$ u8 ^
9937.     (set_tile "list_lay" (itoa lay-idx))
      
9938.     (set_tile "edit_lay" layname)
      : _! `5 D  \  p6 h9 n& `. G" ^
9939.   )
      ' T) B' I+ {! ^: I4 B
9940.   ;;
      
9941.   ;; Reset to original layer when cancel is selected.
      % I& u* ?4 c( Z" {+ H
9942.   ;;
      
9943.   (defun reset_lay ()
        P# l- i$ M+ E9 E
9944.     (setq lay-idx old-idx)
      8 f3 l9 R$ c. h. l
9945.     (done_dialog 0)
      ; ^3 {! B. P, O1 g0 H
9946.   )
      
9947.   ;;
      
9948.   ;; Checks validity of thickness from edit box.
      
9949.   (defun getthickness (value)
      # c" _  p6 p6 Q. u
9950.     (setq ethickness (verify_d "eb_thickness" value ethickness))
      
9951.   )
      ' R- B6 l8 A1 Y0 R
9952.   ;;
      ' t$ s* h- z8 K9 J  Y* |
9953.   ;; Copy of (getthickness) for ltscale.  If more, make this function
        g+ U5 _" a9 Q: ^: q. C9 \8 p4 p
9954.   ;; generic.
      
9955.   (defun getltscale (value)
      
9956.     (setq eltscale (verify_d "eb_ltscale" value eltscale))
      * E3 N' U, r5 k& E& i
9957.   )
      
9958.   ;;
      
9959.   ;; This function makes a list called laynmlst which consists of all the layer
      
9960.   ;; names in the drawing.  It also creates a list called longlist which
      8 |; A. c5 R! @1 B
9961.   ;; consists of strings which contain the layer name, color, linetype, etc.
      
9962.   ;; Longlist is later mapped into the layer listbox.  Both are ordered the
      4 m; H' `, W1 K8 Z1 A
9963.   ;; same.
      ) l% }. Z; w  }# p0 L  D
9964.   ;;
      2 k6 e! n$ ?* x
9965.   (defun make_lay_lists (/ layname sortlist name templist layer_number)
      2 W2 z) O+ N) n9 M' N- w+ Y
9966.     (setq sortlist nil)
      . T: r$ u) G5 r% B
9967.     (setq templist (tblnext "LAYER" T))
      
9968.     (setq layer_number 1)
      " `& D5 y# i$ M2 c1 I+ p
9969.     (while templist
      
9970.       ;; No xref dependent layers, please.
      
9971.           (if (/= (logand 16 (cdr (assoc 70 templist))) 16)
      4 o  s' ]2 i* O; N1 T, X4 B
9972.             (progn
      , g* p4 L0 {* C
9973.               (setq name (cdr (assoc 2 templist)))
      
9974.           (setq sortlist (cons name sortlist))
      . ]' ]- ?" d) D: G# R
9975.         )
      / [, Y' V/ G9 r5 H
9976.           )
      ( A$ [& p, m% O. v* C
9977.           ; Get the next layer.
      
9978.       (setq templist (tblnext "LAYER"))
      ' g* ?, m1 {1 r( {  L6 T& i7 H2 s
9979.       ;; Not dead message...
      . x9 b* `  ^+ l5 }; @' W: b1 N
9980.       (if (= (/ layer_number 50.0) (fix (/ layer_number 50.0)))
      ) z# V0 v, _# L5 u$ v
9981.         (set_tile "error" (strcat "Collecting..." (itoa layer_number)))
      9 b: I& R& }; \( B/ c
9982.       )
      
9983.       (setq layer_number (1+ layer_number))
      
9984.     )
      + j: Z" ~6 ^" O8 Q( o) g. z
9985.     (set_tile "error" "")
      
9986.     (if (>= (getvar "maxsort") (length sortlist))
      * K, s" n& n8 z( V9 k. C3 H2 [9 Q
9987.       (progn
      
9988.         (if (> layer_number 50)
      5 w, e5 D4 m$ j* g- d' j
9989.           (set_tile "error" "Sorting...")
      8 u: Z& ^$ m( ?3 V
9990.         )
      
9991.         (setq sortlist (acad_strlsort sortlist))
      7 ~# ^$ a  m9 O# Q/ L
9992.       )
      2 O, z( ^5 P+ ~/ l% D& c& n; H
9993.       (setq sortlist (reverse sortlist))
      
9994.     )
      
9995.     (set_tile "error" "")
      
9996.     (setq laynmlst sortlist)
      & A$ D/ \7 i8 f& f1 E; C% M+ X
9997.   )
      4 j6 z* _3 T" u- F* g* L1 l
9998.   ;;
      % t+ q* r5 ?- M& ]6 T
9999.   ;; This function makes 2 list - ltnmlst & mdashlist.
      
10000.   ;; Ltnmlst is a list of linetype names read from the symbol table.  Mdashlist
       
10001.   ;; is list consisting of lists which define the linetype pattern - numbers
       
10002.   ;; that indicate dots, dashes, and spaces taken from group code 49.  The list
       
10003.   ;; corresponds to the order of names in ltnmlst.
       5 l' |. x: i  N
10004.   ;;
       
10005.   (defun make_lt_lists (/ ltlist ltname)
       
10006.     (setq mdashlist nil)
       * X) n- J8 }! y; C# @2 J
10007.         (setq sortlist nil)
       
10008.         (setq ltype_number 1)
       ; e# Q7 x, F, ]' V& j8 I+ R6 E2 u
10009.     (setq ltlist (tblnext "LTYPE" T))
       
10010.     ;;(setq ltname (cdr (assoc 2 ltlist)))
       
10011.     ;;(setq ltnmlst (list ltname))
       
10012.     (while ltlist
       % j, @/ W" i$ P% k& P
10013.           ;; No xref dependent linetypes, please.
       
10014.           (if (/= (logand 16 (cdr (assoc 70 ltlist))) 16)
       
10015.             (progn
       
10016.           (setq ltname (cdr (assoc 2 ltlist)))
       
10017.           (setq sortlist (cons ltname sortlist))
       - d5 {. Z: `) X8 [( F' h
10018.             )
       1 Y8 ~- Q5 K1 e8 Z# e. V/ y8 f
10019.           )
       
10020.           ;; Get the next linetype.
       
10021.           (setq ltlist (tblnext "LTYPE"))
       ( D1 b- V! A- z
10022. 
       ) q' }7 {# M, @; C3 _
10023.           ;; Not dead message...
       
10024.       (if (= (/ ltype_number 50.0) (fix (/ ltype_number 50.0)))
       
10025.         (set_tile "error" (strcat "Collecting..." (itoa ltype_number)))
       / [$ Z: d  C8 B! Z* T
10026.       )
       
10027.       (setq ltype_number (1+ ltype_number))
       
10028. 
       
10029.     )
       9 A& B2 J' |3 C* G  G+ c! B
10030. 
       ) g4 R+ ?% A. k4 @6 S
10031.         ;; Remove Collecting message.
       
10032.         (set_tile "error" "")
       2 a2 |. O/ L, [! S( p" E( Y' h
10033. 
       
10034.     ;; Sort based on maxsort.
       - p' r% i. j# O0 n/ J8 L2 J. S
10035.         (if (>= (getvar "maxsort") (length sortlist))
       
10036.       (progn
       8 h; R: r/ K( z0 O5 v
10037.         (if (> ltype_number 50)
         w7 D2 T6 W& l1 y) ~" e
10038.           (set_tile "error" "Sorting...")
       
10039.         )
       
10040.         (setq sortlist (acad_strlsort sortlist))
         w3 z3 X/ \  q
10041.       )
       0 {% k! b% W& m6 d3 Q
10042.       (setq sortlist (reverse sortlist))
       + Q( v: j7 ^; e2 L+ k4 k
10043.     )
       
10044.     (set_tile "error" "")
         E# ?/ `, M- k
10045.     (setq ltnmlst sortlist)
       
10046. 
       " \2 [5 o' U( }9 I2 O" \; h  L2 t
10047.     (foreach ltname ltnmlst
       & b0 [* f: s: v, ~; @
10048.       (setq ltlist (tblsearch "LTYPE" ltname))
       
10049.       (if (= ltname "CONTINUOUS")
       
10050.         (setq mdashlist (append mdashlist (list "CONT")))
       , B: w1 y2 |& {! i( Q9 D# i' L
10051.         (setq mdashlist
       
10052.             (append mdashlist (list (add_mdash ltlist)))
       # W8 D) ~$ v& i5 D  n: J; M
10053.         )
       ! N3 Z- E5 A3 P8 y5 J
10054.       )
       
10055.     )
       ; p. H& t6 Y) w( W
10056.     (setq ltnmlst (cons "BYBLOCK" ltnmlst))
       
10057.     (setq mdashlist  (cons nil mdashlist))
       6 T: G0 \0 B; u8 e  b, z
10058.     (setq ltnmlst (cons "BYLAYER" ltnmlst))
       
10059.     (setq mdashlist  (cons nil mdashlist))
       
10060.   )
       / y) v, D+ W0 \7 }8 h" ~1 z
10061.   ;;
       
10062.   ;; Get all the group code 49 values for a linetype and put them in a list
       2 N  u* y5 C9 ?
10063.   ;; (pen-up, pen-down info).
       , i5 u9 J1 \# {, ^$ G* `6 f
10064.   ;;
       " \; k, u, B% J/ P
10065.   (defun add_mdash (ltlist1 / dashlist assoclist dashsize)
       
10066.     (setq dashlist nil)
       
10067.     (while (setq assoclist (car ltlist1))
       
10068.       (if (= (car assoclist) 49)
       * d6 k+ t( m0 H5 E  o
10069.         (progn
       
10070.           (setq dashsize (cdr assoclist))
       
10071.           (setq dashlist (cons dashsize dashlist))
       
10072.         )
       8 W1 {, V! R" ~0 m# G- g) ^, \' e
10073.       )
       & }1 W2 i! v8 w7 Y$ u+ w
10074.       (setq ltlist1 (cdr ltlist1))
       ' u/ ~0 j% G4 S% [( O6 \+ f
10075.     )
       " _/ v3 }& p# {$ O9 F# V$ C
10076.     (setq dashlist (reverse dashlist))
       
10077.   )
       " Y7 x# D7 d4 S* h2 W3 v
10078.   ;;
       0 c6 t7 G" y. l0 {2 c
10079.   ;; Color a tile, draw linetype, and draw a border around it
       
10080.   ;;
       0 C2 r; E. h3 X$ r  h, j7 Q
10081.   (defun col_tile (tile color patlist / x y)
       , U- D* f# `4 _3 [
10082.     (setq x (dimx_tile tile))
       ( }( \( n7 W9 ^+ R4 p
10083.     (setq y (dimy_tile tile))
       # D9 y0 H. m, M7 @* j
10084.     (start_image tile)
       
10085.     (fill_image 0 0 x y color)
       
10086.     (if (= color 7)
       
10087.       (progn
       
10088.         (if patlist (drawpattern x (/ y 2) patlist 0))
       9 l2 Q( o; i# t! Q* i
10089.         (tile_rect 0 0 x y 0)
       ! F: k+ `- x5 m5 \: B( p
10090.       )
       
10091.       (progn
       
10092.         (if patlist (drawpattern x (/ y 2) patlist 7))
       2 {, n3 j8 z# T8 i0 [$ ~- ~
10093.         (tile_rect 0 0 x y 7)
       / ^5 y  Z. Y3 \" L4 I; B; u
10094.       )
       
10095.     )
       
10096.     (end_image)
       
10097.   )
       
10098.   ;;
       
10099.   ;; Draw a border around a tile
       
10100.   ;;
       . a% B% E9 w, @) c( i
10101.   (defun tile_rect (x1 y1 x2 y2 color)
       
10102.     (setq x2 (- x2 1))
       8 t% F# }( y% F$ H4 ~" E/ j
10103.     (setq y2 (- y2 1))
       
10104.     (vector_image x1 y1 x2 y1 color)
       - y  w- h: u; x( h( u. x
10105.     (vector_image x2 y1 x2 y2 color)
       
10106.     (vector_image x2 y2 x1 y2 color)
       + @/ O8 C$ Q/ G9 e
10107.     (vector_image x1 y2 x1 y1 color)
       
10108.   )
       
10109.   ;;
       
10110.   ;; Draw the linetype pattern in a tile.  Boxlength is the length of the image
       + r) h/ B( `) X3 c" L2 l: i. W
10111.   ;; tile, y2 is the midpoint of the height of the image tile, pattern is a
       : Z+ \8 Y4 W. i6 l  c/ W4 Y8 f
10112.   ;; list of numbers that define the linetype, and color is the color of the
       
10113.   ;; tile.
       / p0 }7 r& a6 @% g
10114.   ;;
       
10115.   (defun drawpattern (boxlength y2 pattern color / x1 x2
       
10116.                       patlist dash)
       2 u4 J. l* o* G1 l0 C! y
10117.     (setq x1 0 x2 0)
       - u* T' _- r- O4 C! G0 s
10118.     (setq patlist pattern)
       
10119.     (setq fx 30)
       
10120.     (if (= patlist "CONT")
       
10121.       (progn (setq dash boxlength)
       
10122.         (vi)
       4 N" x# Y  M6 h1 q. q- _) h
10123.         (setq x1 boxlength)
       
10124.       )
       
10125.       (foreach dash patlist
         T- [. ~' v7 t
10126.         (if (> (abs dash) 2.5)
       : U) R4 i$ r* s: a
10127.           (setq fx 2)
       
10128.         )
       
10129.       )
       ) e: Y/ ^8 ~" b6 B6 z
10130.     )
       
10131.     (while (< x1 boxlength)
       
10132.       (if (setq dash (car patlist))
       4 O- l6 }) b: f0 w
10133.         (progn
       $ A- `( Y9 t% w' X% F4 o
10134.           (setq dash (fix (* fx dash)))
       
10135.           (cond
       # b4 L: T6 \& H! M; d9 o0 `
10136.             ((= dash 0) (setq dash 1) (vi))
       
10137.             ((> dash 0) (vi))
       : d' X* g# g$ e2 O, U# d
10138.             (T
       9 W& p* L: `4 y$ i. ?1 h
10139.               (if (< (abs dash) 2)
       
10140.                (setq dash 2)
       
10141.               )
       
10142.               (setq x2 (+ x2 (abs dash)))
       
10143.             )
       
10144.           )
       4 l( R0 _0 v$ @. y
10145.           (setq patlist (cdr patlist))
       
10146.           (setq x1 x2)
       1 X6 J9 V9 n' L- j. n
10147.         )
       
10148.         (setq patlist pattern)
       
10149.       )
       
10150.     )
       
10151.   )
       ; _8 W9 k  |" O0 y8 j/ C& e
10152.   ;;
       $ j. v7 n; A4 `* E+ I
10153.   ;; Determain state of xclip
       
10154.   ;; Returns the group 71 value of the spacial filter dictionary.
       4 x) |% d4 l* \% R9 e/ d
10155.   ;; If the entity doesn't have a spacial filter dictionary, this
       $ f* P- T/ e6 b- ?9 r! n& b: Z
10156.   ;; returns 0. If it does it will return 0 or 1 depending on the
       
10157.   ;; current setting of the state of the clipping visibility.
       9 b; C0 a! X' h1 A* v- Y
10158.   ;;
       - f/ b1 X9 K. V' H  q5 `
10159.   (defun xclipon(elist)
       
10160.     (setq hasclip T)
       5 f. G1 a$ [7 [1 ?* s( h) g* r
10161.     (if (/= (assoc 360 elist) nil)
       5 D$ b1 s5 J0 Y' N' T+ o/ |
10162.       (progn
       6 \* r" H# q: M% _2 \
10163.         (setq tmp (entget(cdr(assoc 360 elist))))
       
10164.         (if (/= nil (assoc 360 tmp))
       $ C' ]3 a+ l1 ?7 v8 D
10165.           (progn
       7 \' l4 Z+ b; @5 f) l& [' `; @
10166.             (setq tmp (entget(cdr(assoc 360 tmp))))
       , _$ G! i3 p; ^8 F6 s% ~# n/ M( r
10167.             (if (/= nil (assoc 360 tmp))
       
10168.               (progn
       3 [& K0 c) x* K" g, V) c
10169.                 (setq tmp (entget(cdr(assoc 360 tmp))))
       
10170.                 (if (/= nil (assoc 71 tmp))
       
10171.                   (cdr(assoc 71 tmp))
       
10172.                                   (progn
       $ H( u# T6 K7 C1 E5 }3 L* {5 @
10173.                                         (setq hasclip nil)
       1 e3 Q$ `; L& A: o% o
10174.                                         (eval 0)
       
10175.                                   )
       6 R. p4 }; s5 I/ J
10176.                 )
       " B0 m  y" R) K8 w4 o
10177.               )
       , v3 U* w" ^7 t7 K0 l
10178.                           (progn
       
10179.                                 (setq hasclip nil)
       9 i! d. d! ^+ g& u
10180.                                 (eval 0)
       ! o7 J7 d6 y: r6 v. d; Z! X
10181.                           )
       6 S8 X; S0 `  ^7 S
10182.             )
       # y- b. K$ V# m8 B$ Z& @; t
10183.           )
       1 z0 \6 Y. C# B& `' l5 v
10184.                   (progn
       
10185.                         (setq hasclip nil)
       
10186.                         (eval 0)
       7 B8 F% L# ?) Q; V, M1 N4 Z
10187.                   )
       
10188.         )
       1 T3 A$ n! W/ w0 o0 R5 K  I! K2 x8 l% l
10189.       )
       
10190.           (progn
       
10191.                 (setq hasclip nil)
       
10192.                 (eval 0)
       
10193.           )
       
10194.     )
       # u0 I( @" y" p9 h. {
10195.   )
       
10196.   ;;
       
10197.   ;; Draw a dash or dot in image tile
       
10198.   ;;
       1 d2 }7 T8 P& {7 ^# J9 j9 K. }
10199.   (defun vi ()
       1 T1 @6 r1 a/ h/ V* K" o
10200.     (setq x2 (+ x2 dash))
       ( p* |0 y/ U) {$ M
10201.     (vector_image x1 y2 x2 y2 color)
       6 L7 L$ W, }& Q5 T" F# ]
10202.   )
       8 w5 {- i: p9 [- Z0 J/ l
10203.   ;;
       5 m, M: H8 f0 h! t1 _: S
10204.   ;; If an item is a member of the list, then return its index number, else
       ! D. Z9 N: Z$ M& G9 o( @
10205.   ;; return nil.
       % F- B. @  n; ]
10206.   ;;
       " Z: w0 G+ e( }  z5 _$ {
10207.   (defun getindex (item itemlist / m n)
       
10208.     (setq n (length itemlist))
       / `$ y. N! R2 Z: z: V+ }# P, A9 I
10209.     (if (> (setq m (length (member item itemlist))) 0)
       $ r. B2 `8 u/ a2 [/ N% e* @
10210.       (- n m)
       : |! e% u' J* K  w( r" C
10211.       nil
       - j( \% s1 S# v/ Q% g9 i) d* Z
10212.     )
       * d% B4 ?+ u: D3 ^+ s
10213.   )
       
10214.   ;;
         d7 R7 N) ]  \
10215.   ;; This function is called if the linetype is set "BYLAYER". It finds the
       # p. X3 L/ [" m0 }  v# Y  y: f9 R
10216.   ;; ltype of the layer so it can be displayed  beside the linetype button.
       8 q/ u* |; X" N* t) u% a$ A
10217.   ;;
       " J; g1 F: _5 }+ `+ |, o6 M0 q: Q
10218.   (defun bylayer_lt (/ layname layinfo ltype)
       
10219.     (if lay-idx
       7 e% W6 m5 |/ A, K, V
10220.       (progn
       4 r3 L$ `* Z( p
10221.         (setq layname (nth lay-idx laynmlst))
       
10222.         (setq layinfo (tblsearch "layer" layname))
       
10223.         (setq ltype (cdr (assoc 6 layinfo)))
       
10224.         "BYLAYER"
       
10225.       )
       
10226.       "BYLAYER"
       
10227.     )
       
10228.   )
       
10229.   ;;
       , |7 Y  n9 I6 S7 _, I) R- W
10230.   ;; This function is called if the color is set "BYLAYER".  It finds the color
       
10231.   ;; of the layer so it can be displayed beside the color button.
       
10232.   ;;
       
10233.   (defun bylayer_col (/ layname layinfo color)
       1 n' T9 U# G' Q
10234.     (setq layinfo (tblsearch "layer" elayer))
       
10235.     (setq color (abs (cdr (assoc 62 layinfo))))
       
10236.   )
       5 O1 M) R! o* V
10237.   ;;
       
10238.   ;; Used to set the color name in layer subdialogue.
       
10239.   ;;
       
10240.   (defun colorname (colnum / cn)
       1 v: k' b, c2 }1 j# \6 s
10241.     (setq cn (abs colnum))
       ( y# _! A& G) z- x1 v
10242.     (cond ((= cn 1) "red")
       " X8 ]  N+ w: U; w: ]* `
10243.           ((= cn 2) "yellow")
       
10244.           ((= cn 3) "green")
       6 V, h* n" x6 x; E/ N
10245.           ((= cn 4) "cyan")
       
10246.           ((= cn 5) "blue")
       
10247.           ((= cn 6) "magenta")
       0 A' `2 c* x+ e1 }+ K6 j
10248.           ((= cn 7) "white")
       
10249.           (T (itoa cn))
       
10250.     )
       
10251.   )
       1 j9 A- \3 v# I$ i1 j- V4 M& r! o
10252.   ;;
       9 }7 _$ o9 T2 F  D2 Q
10253.   ;; If their is no error message, then close the dialogue.
       8 a5 e, O& ^, t9 D
10254.   ;;
       
10255.   (defun dismiss_dialog (action)
       * O; K: B7 E% B, u
10256.     (if (= action 0)
       9 F/ k1 l3 B# b
10257.       (done_dialog 0)
       
10258.       (if (= (get_tile "error") "")
       " f% I# d% X3 w4 q
10259.         (done_dialog action)
       
10260.       )
       ! H4 o" Q! V/ w, b: T
10261.     )
       ( P' v! O; Q/ A2 I4 X9 n, c) H
10262.   )
       $ T1 c( X' u2 P- j# [9 g4 o" n
10263. 
       
10264.   (defun test_ok ()
       
10265.     (if (= (get_tile "error") "")
       
10266.       (done_dialog 1)
       6 y5 c+ q' O9 g
10267.     )
       9 t0 K- b' g! e! Z- M0 x3 Q
10268.   )
       
10269. 
       2 h# U3 v2 |2 d
10270.   (defun cancel ()
       
10271.     (done_dialog 0)
       
10272.   )
         N2 p3 t% Y  N; b/ u
10273. 
       
10274. ;;; =======================================================================
       ( D- i6 C0 z3 `9 }" J$ s
10275. ;;; SETUP layer and linetype lists for application, and initialize all
       # n& O2 Y8 R- v' d* Z4 {# i
10276. ;;; program variables.
       ' y# R4 P% j( k+ g5 w
10277. 
       % [5 A% e$ D* [2 R- f
10278.   (setq elist       (entget ename)
       
10279.         old-elist   elist
       " x8 e1 k* D& o( q0 C. c
10280.         modlist     elist
       
10281.         etype       (strcase (cdr (assoc 0 elist)))
       
10282.         ecolor      (cdr (assoc 62 elist))
       
10283.         elayer      (cdr (assoc 8 elist))
       
10284.         eltscale    (cdr (assoc 48 elist))
       $ _+ g. @1 M. Z, ?9 u
10285.         ethickness  (cdr (assoc 39 elist))
       5 y7 t4 o( }% T' N$ e- |' ?
10286.         eltype      (cdr (assoc 6 elist))
       
10287.   )
       
10288.   (if (= (assoc 210 elist) nil)
       
10289.     (setq extru (list 0.0 0.0 1.0))
       " @4 w4 F# D  V$ K1 n7 P
10290.     (setq extru (cdr (assoc 210 elist)))
       
10291.   )
       / L* |. A' O% q' h9 g- P
10292. 
       
10293.   (if (not ecolor) (setq ecolor 256))
       
10294.   (if (not eltype) (setq eltype "BYLAYER"))
       
10295.   (if (not ethickness) (setq ethickness 0))
       8 f+ S+ T  W: s: `
10296.   (if (not eltscale) (setq eltscale 1))
       
10297. ) ; end ddmodify_init
       
10298. 
       ' b9 J7 X& ?5 \! w& p& V
10299. ;;; --------------------------------------------------------------------------
       
10300. ;;; Function: DDMODIFY_SELECT
       + |" m! `& p- W
10301. ;;;
       
10302. ;;; Object aquisition function.
       8 ^& e3 ^8 {" h1 ~, @+ y' R6 M
10303. ;;;
       " q1 w( x! K+ `
10304. ;;; (ddmodify_select)
       
10305. ;;;
       4 \0 _4 N$ ]7 p
10306. ;;; Obtains object to be modified, in one of three ways:
       7 ~! y$ w! G8 I# w$ R
10307. ;;;
       
10308. ;;;   1 - Autoselected.
       
10309. ;;;   2 - Prompted for.
       8 ^8 G5 G4 n/ d" C5 U
10310. ;;;   3 - Passed as an argument in a call to (ddmodify <ename> )
       
10311. ;;;
       
10312. ;;; The (ddmodify_select) function also sets the value of the
       
10313. ;;; global symbol AI_SELTYPE to one of the above three values to
       
10314. ;;; indicate the method thru which the object was aquired.
       4 w, D# n# z1 G: A. z) S
10315. ;;;
       3 o* e8 m% S4 y  i0 Q& c5 L  L
10316. ;;; This value can be useful to applications that want to RESTORE
       
10317. ;;; an object that was autoselected to its previous selected state
       7 x5 g2 Q# x& {  t# W  z) K6 P+ `
10318. ;;; when they terminate, although there doesn't appear to be any
       
10319. ;;; way to do this right now.
       & z8 |: ^& ~# g( I/ f+ M
10320. 
       
10321. (defun ddmodify_select ()
       # M: J+ U! ~) U' D! S9 G6 N
10322.    (cond
       
10323.       (  ename                             ; (ddmodify) was called
       
10324.          (cond                             ; with an <ename> argument
       + _" M" m5 X' a9 E5 p
10325.             (  (entget ename)              ;   If object is non-deleted
       & |1 n6 L! L, v% X- j: M
10326.                (setq ai_seltype 3)         ;   then return its ename.
         y" ^* `9 j+ P: {" y6 ]
10327.                (ai_return ename))))
       3 N# r3 E. H: k. |. N
10328. 
       
10329.       ;; return auto-selected , see ai_utils.lsp
       
10330.       (  (ai_autossget1 "\nSelect one object to modify: "))
       2 I: k; f; n/ n* H  E
10331. 
       
10332.       (t (princ "\nNothing selected.")
       
10333.          (ai_return nil))
       * }( X9 T$ O, C  k
10334.    )
       
10335. )
       
10336. 
       
10337. ;;; ============= Command line interface function =======================
         A: K& q. d3 A8 @9 a  v
10338. 
       2 K( ~) [  R) m, _/ _6 R
10339. (defun C:MMO ()
       
10340.    (ddmodify nil)
       
10341.    (princ)
       
10342. )
       # z: F, V  T3 i
10343. 
       9 B: h& }9 Y& p0 w, h# o
10344. ;;; ================== (ddmodify) - Main program ========================
       
10345. ;;;
       
10346. ;;; (ddmodify <ename> )
       ! p1 P1 E% [" ?+ C4 S* O% J6 b5 R
10347. ;;;
       / }: `) F6 V7 ?6 D
10348. ;;; Main program function, callable as a subroutine.
       : w7 k& r  S, I2 L1 ~/ S7 L
10349. ;;;
       # k# O1 `# a( e
10350. ;;; <ename> = object name of the object to modify.
       
10351. ;;;
       $ B; m! q1 y, H2 W6 T
10352. ;;; If <ename> is nil, then user is prompted to select
       0 ^, X- s; ?+ Y: O4 `8 N
10353. ;;; the object interactively.
       5 i% ~/ Z: _5 Q  R# v6 V
10354. ;;;
       
10355. ;;; Before (ddmodify) can be called as a subroutine, it must
       
10356. ;;; be loaded first.  It is up to the calling application to
       # s8 ?) A0 m! Y3 q7 g! i2 G
10357. ;;; first determine this, and load it if necessary.
       & P( |  [" ^; \7 Q
10358. 
       7 T6 \  ]6 C+ j* N: M
10359. 
       
10360. (defun ddmodify (ename /
       9 v2 B4 z2 U( o0 q; v( }
10361. 2ndpt              ell_calc_area            move_pt1               templist
       3 P+ `& r2 K- R" T
10362. add_mdash          ell_tile                 n                      tempmod
       
10363. alipt              eltscale                 name                   tempst_ang
       
10364. ang                eltype                   newpoint               test_ok
       2 `' c& ?% _6 \
10365. arc_calc           emod                     next                   text
       
10366. arclen             end_ang                  next_vertex            th-value
       
10367. assoclist          endpt                    obl                    tile
       
10368. atprompt           errchk                   off                    tile_rect
       
10369. attag              ethickness               old_majrad             tilemode
       
10370. attprompt          etype                    old-closed             totang
       
10371. bit                extru                    old-closedm            tstyle
       0 Y1 D1 j; X, ^9 M" ^" K
10372. bit1               fchk                     old-closedn            u
       
10373. bit-10             first-10-rec             old-elist              undo_init
       
10374. bit-11             first-10-time            olderr                 upsd
         W3 g4 N, G7 j9 I' a
10375. bit2               first-11-rec             old-fit                v
       
10376. bit3               first-11-time            old-idx                va
       
10377. bit4               fit                      oldlist                value
       5 N* x3 g/ c# p
10378. bit70              frozth                   old-spltype            ver_4
       3 V' ^/ A7 A( Y, D/ H
10379. bit-70             f-vis                    old-u                  ver_ang1
       
10380. bit75              fx                       old-v                  ver_ang2
       
10381. bk-up              get_color                on                     ver_col
       
10382. bkwd               getcolor                 onoff                  ver_colsp
       + c7 X! `* P! r
10383. boxlength          getindex                 on-off                 ver_eangle
       6 S6 |1 A; I8 H% v
10384. bylayer_col        getlayer                 patlist                ver_hght
       
10385. bylayer_lt         getltype                 pattern                ver_majrad
       
10386. calc               getthickness             pltype                 ver_obl
       % N* f" C5 o" k0 C$ K9 g
10387. cancel             globals                  polytype               ver_pt1
       6 ]; P- @' `9 h: {1 T8 [" q
10388. cir_calc           ha                       pre                    ver_pt2
       
10389. closed             ha-prev                  proplist               ver_pt3
       ) _% Y6 s* z& G& [2 }
10390. closedm            help_entry               pt                     ver_pt4
       ; w6 l* E# @4 t
10391. closedn            hght                     pt1                    ver_rad
       . d) m5 `$ q4 }8 b8 N
10392. cmd                icvp                     pt1_eq_pt2             ver_rot
       
10393. cn                 image_add_vector         pt2                    ver_row
       % e! d2 j/ v; H- g# \) x
10394. cname              image_clean_variables    pt3                    ver_rowsp
       
10395. cntl-pt-indicator  image_cross_product      pt4                    ver_tag
       3 ]3 \" Z1 d6 P, T+ {- o
10396. code_71            image_disp_opt           ptype                  ver_u
       * L. ]( Q( @! z/ N) \( a* f+ J
10397. col_tile           image_dot_product        radius                 ver_v
       
10398. col-idx            image_normalize_vector   rational_spl_flag      ver_wid
       
10399. colname            image_rotate_vector      reset                  ver_x1
       4 Z. p4 {$ x6 l+ }8 u
10400. colnmlst           image_scale              reset_flag             ver_x2
       
10401. colnolst           image_scale_vector       reset_lay              ver_x3
       
10402. colnum             image_update             reset_lt               ver_x4
       ; o9 n/ u4 T3 q+ N# P; X/ k
10403. color              index                    reset_uv               ver_xline_pt1
       
10404. colorname          inv                      rot                    ver_xline_pt2
       
10405. colorno            item                     rows                   ver_xline_x1
       
10406. col-sp             item1                    row-sp                 ver_xline_x2
       3 r+ B1 a6 Q! R8 W# |/ v
10407. columns            item2                    rrat                   ver_xline_y1
       
10408. con                itemlist                 s                      ver_xline_y2
       
10409. coord              jlist                    set_action_tiles       ver_xline_z1
       9 g2 q# B# c, Y
10410. ctr                jlist_act                set_just_idx           ver_xline_z2
       
10411. cur-10-rec         just-idx                 set_tile_bk-up         ver_xscl
       
10412. cur-11-rec         layedit_act              set_tile_cntl_pt       ver_y1
       7 t( x, s% g" {( {. f& M0 g4 S3 p
10413. cvpname            lay-idx                  set_tile_data_pt       ver_y2
       - Y; Z! L' p- e; e$ r
10414. dash               layinfo                  set_tile_dirv          ver_y3
       % F' p) ]+ g# u" Y$ z
10415. dashdata           laylist                  set_tile_edges         ver_y4
       5 p" f0 C: I$ }/ @# ~/ F
10416. dashlist           laylist_act              set_tile_endang        ver_yscl
       . B" Q* i: j  c4 h( K( y! H
10417. dashsize           layname                  set_tile_hght          ver_z1
       5 k( g! r' S8 F6 f/ h
10418. data-pt-indicator  laynmlst                 set_tile_icvp          ver_z2
       
10419. dcl_id             layvalue                 set_tile_just          ver_z3
       + e6 R9 f- p8 B" C/ e% p
10420. dd3dface           line_calc                set_tile_obl           ver_zscl
       ' z1 y2 [+ ^+ I6 k
10421. dd3dsolid          linetype                 set_tile_prompt        verify_a
       
10422. ddarc              list1                    set_tile_props         verify_d
       / c) x" `# A( p" Y; D! ?- k( b
10423. ddblock            longlist                 set_tile_pt1           verify_i
       4 v9 E, a7 Y3 L  a
10424. ddbody             ltabstr                  set_tile_pt2           verify_xline
       / M. V+ \- e& K! B' x% [
10425. ddcircle           ltedit_act               set_tile_pt3           vfy
       
10426. ddellipse          ltidx                    set_tile_pt4           vi
       $ J" E5 A4 b, c
10427. ddgetprompt        lt-idx                   set_tile_rad           vlist
       
10428. ddgettext          ltlist                   set_tile_rc            vname
       + {8 d. @& F0 d: y& ?5 {
10429. ddimage            ltlist_act               set_tile_rot           vpf
       4 w" ?6 [, r" k! I" i" F/ y
10430. ddimen             ltlist1                  set_tile_scale         vpid
       
10431. ddleader           ltname                   set_tile_spline_props  vpldata
       
10432. ddline             ltnmlst                  set_tile_stang         vpn
       8 f$ y8 ?5 S9 z
10433. ddlist             ltvalue                  set_tile_style         vpt
       " j. y' h) b5 V# C
10434. ddmline            ltype                    set_tile_tag           which_tiles
       + B3 f( `2 g: O" d; A
10435. ddmodify_err       m                        set_tile_text          wid
       
10436. ddmtext            majrad                   set_tile_vpt           x
       ) s/ \$ e; L- q2 f& W5 x
10437. ddpline            make_lay_lists           set_tile_wid           x1
       
10438. ddpoint            make_lt_lists            set_tile_xline_pt1     x2
       
10439. ddray              mdashlist                set_tile_xline_pt2     x3
       0 a/ e! x: Q: A; w
10440. ddregion           minrad                   setcolor               x4
       : C+ X. _9 [) R; w9 N) O* E
10441. ddshape            modify_3dface            shght                  xdlist
       * p/ y0 n  ?% G; X& v4 A0 B0 D4 u2 m
10442. ddsolid            modify_3dsolid           showpt                 xline_pt1
       & {/ a( R7 d7 L& ]$ w0 N' X. `
10443. ddspline           modify_arc               size                   xline_pt2
       ! m1 q; H/ N8 l
10444. ddtext             modify_block             slist                  xline_x1
       / O( I0 o! r$ \4 ?
10445. ddvport            modify_body              sname                  xline_x2
       6 B) o/ @8 a4 {( H7 p- R
10446. ddxline            modify_circle            sortlist               xline_y1
       * v' s$ j% l8 b# Y2 e3 O& @
10447. denom              modify_ellipse           spltype                xline_y2
       
10448. dialog-state       modify_image             ss                     xline_z1
       
10449. dir_pt             modify_line              st_ang                 xline_z2
       
10450. dir_ptx            modify_mline             stpt                   xscale
       / ]* E8 O( R* g2 ?; s% o& N
10451. dir_pty            modify_mtext             style_act              xx
       ) O1 T( [8 q/ N. I* g* u9 i
10452. dir_ptz            modify_point             style-idx              y
       
10453. dismiss_dialog     modify_polyline          style-list             y1
       
10454. drawpattern        modify_prop_geom         tagval                 y2
       
10455. echo               modify_properties        temp                   y3
       9 ^9 f$ l' K) y9 Q
10456. ecolor             modify_ray               temp_color             y4
       
10457. edge1              modify_region            temp_dir_x             yscale
       
10458. edge2              modify_shape             temp_dir_y             yy
       
10459. edge3              modify_solid             temp_dir_z             z1
       
10460. edge4              modify_spline            temp_xline_pt1         z2
       " I! B* W6 a$ ^# y6 `7 p5 |
10461. edgetest           modify_text              temp_xline_x1          z3
       
10462. elayer             modify_vport             temp_xline_y1          z4
       
10463. elist              modify_xline             temp_xline_z1          zscale
       
10464. ell_calc           modlist                  tempend_eang           zz
       
10465. dir-idx            safe_ddedit              ver_MtextWidth         xcliponoff
       
10466. MText_style
       7 P( ?/ C9 z/ Y- J- _- M- c
10467.   )
       . a; P3 s. y: X5 [
10468. 
       : i2 R% c% K1 b0 ?
10469.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
       
10470.         old_error  *error*            ; save current error function
       
10471.         *error* ai_error              ; new error function
       
10472.   )
       * }" q" G: `7 B0 O( |8 |  {
10473. 
       
10474.   (setq old_pickstyle (getvar "PICKSTYLE"))          ; save old pickstyle
       
10475.   (setq new_pickstyle (logand old_pickstyle (~ 1)))  ; turn off group selection
       
10476.   (setvar "pickstyle" new_pickstyle)                 ; bit and set to new value
       
10477. 
       
10478.   (setvar "cmdecho" (cond (  (or (not *debug*) (zerop *debug*)) 0)
       " O% D) `& Q8 K+ ^4 S
10479.                           (t 1)))
       + Q3 G/ x7 x7 J4 Q! A& m7 `
10480.   (cond
       
10481.      (  (not (ai_notrans)))                      ; Not transparent?
       
10482.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
       
10483.      (  (not (setq dcl_id (ai_dcl "ddmodify")))) ; is .DLG file loaded?
       - _8 L3 j" A0 m! @9 \
10484.      (  (not (setq ename (ddmodify_select))))    ; object to modify?
       
10485. 
       
10486.      (t (ai_undo_push)
       
10487.         (ddmodify_init)                          ; everything okay, proceed.
       ! k  Q0 e, p7 v9 `4 k6 h
10488.         (cond
       
10489.            ((= etype "LEADER")
       
10490.              (setq help_entry  "modify_Leader_dialog")
       # R3 [: \. Q8 _( e
10491.              (ddleader)
       
10492.            )
       
10493.            ((= etype "ARC")
       5 x' H7 U/ y# }* z% h  N9 b
10494.              (setq help_entry  "modify_Arc_dialog")
       
10495.              (ddarc)
       ' r, n9 s( E2 K1 b- g6 Y
10496.            )
       
10497.            ((= etype "ATTDEF")
       
10498.              (setq help_entry  "modify_Attribute_Definition_dialog")
       * t! r+ D7 i( n5 t1 V( O
10499.              (ddtext)
       ! q. k% c( K' e4 B2 o
10500.            )
       # ^8 {  P+ f& E
10501.            ((= etype "CIRCLE")
       
10502.              (setq help_entry  "modify_Circle_dialog")
       8 ^8 [% C0 v0 b
10503.              (ddcircle)
       + C3 }' a- t2 j1 t
10504.            )
       
10505.            ((= etype "ELLIPSE")
       
10506.              (setq help_entry  "modify_Ellipse_dialog")
       1 T; @% K& E. T, z" x3 `/ K
10507.              (ddellipse)
       7 k) U5 D$ H" v% i) O2 Z
10508.            )
       
10509.            ((= etype "3DSOLID")
       
10510.              (setq help_entry  "modify_3d_Solid_dialog")
       ' o; \* ]1 g( ~/ [  Z3 G
10511.              (dd3dsolid)
       $ u0 ^% R& R$ O! R
10512.            )
       
10513.            ((= etype "BODY")
       $ V3 J  `* w/ [. h8 n, D
10514.              (setq help_entry  "modify_Body_dialog")
       . l2 C* h$ ^6 X; h) j
10515.              (ddbody)
       
10516.            )
       
10517.            ((= etype "REGION")
       
10518.              (setq help_entry  "modify_Region_dialog")
       9 h8 H' c& ]+ _; h3 G8 v
10519.              (ddregion)
       
10520.            )
       
10521.            ((= etype "HATCH")
       % H: F8 ]1 h/ ]" T
10522.              (setq help_entry  "modify_Hatch_dialog")
       
10523.              (ddnewhatch)
       
10524.            )
       
10525.            ((= etype "SPLINE")
       - Q# s- }+ E1 h5 u/ H* V
10526.              (setq help_entry  "modify_Spline_dialog")
       
10527.              (ddspline)
       
10528.            )
       & @5 Z5 ]8 G0 a
10529.            ((= etype "INSERT")    ; see ddblock for help_entry
       
10530.              (ddblock)
       
10531.            )
       ( P$ t$ |; M8 M: x
10532.            ((= etype "LINE")
       - x  m0 P  g% m
10533.              (setq help_entry  "modify_Line_dialog")
       8 s; y; j: b+ k
10534.              (ddline)
       / [7 x; x7 \: D* m% l
10535.            )
       
10536.            ((= etype "MLINE")
       
10537.              (setq help_entry  "modify_multiLine_dialog")
       
10538.              (ddmline)
       2 d3 c: p+ b  p
10539.            )
       2 D- o% `. ?- J: B
10540.            ((= etype "RAY")
       ) O- y, p/ i( H
10541.              (setq help_entry  "modify_Ray_dialog")
       , O3 w8 a; b8 g) _
10542.              (ddxline)
       ' R, R. |" i: K& H: {
10543.            )
       , r  H$ g, F( t% s3 Y
10544.            ((= etype "XLINE")
       4 z- K& q3 k5 f8 {
10545.              (setq help_entry  "modify_Xline_dialog")
       
10546.              (ddxline)
       6 K! o2 L9 I* h5 |' K6 i
10547.            )
       
10548.            ((= etype "POINT")
       ; |; P) f1 q6 i3 f' Z4 b
10549.              (setq help_entry  "modify_Point_dialog")
       
10550.              (ddpoint)
       
10551.            )
       
10552.            ((or (= etype "POLYLINE") (= etype "LWPOLYLINE"))
       + A, s! j- R, N; D2 p- `
10553.              (setq help_entry  "modify_Polyline_dialog")
       7 X9 Q% b3 d* N# W* v& r
10554.              ;; If a 2D pline, check to see if it is planar to the current
       
10555.              ;; UCS, reject if not.   To see if the pline is parallel,
       % |+ |# v  ^$ Y- ?" t
10556.              ;; the 210 group (WCS) is added to the current UCS origin (WCS)
       
10557.              ;; and then converted to the current UCS and checked to see if
         x; Z3 O6 m5 u2 s; L
10558.              ;; it is equal to (0,0,1).
       
10559. 
       : K- U1 W; |" b; f, T/ ]* `
10560.              ;; Incase the 210 is default and not in the dxf list.
       ) z+ I3 o( O) R0 w6 D! j+ t5 d
10561.              (if (= (assoc 210 (entget ename)) nil)
       
10562.                 (ddpline)
       # f  [3 V3 ~: J' _- r
10563.                 (progn
       - D/ p0 _2 ~4 {) ^. d
10564.                     (if (and (zerop (logand 120 (cdr (assoc 70 (entget ename)))))
       
10565.                             (not (equal '(0.0 0.0 1.0)
       4 _* H1 i: V: v* z
10566.                                    (trans (mapcar '+
       
10567.                                              (cdr (assoc 210 (entget ename)))
       8 E6 y0 k2 b1 Y: q3 I
10568.                                              (trans '(0.0 0.0 0.0) 1 0)
       2 Y8 E# ~. R7 b* o& E. [' Y
10569.                                           )
       , ?& y5 W$ z: a; z" Y. k
10570.                                      0 1
       / d- [+ M/ l9 F- y, ~% H
10571.                                    )
       
10572.                                    0.0000000001            ; fuzz
       - ~% t& m2 Q% @8 z4 c1 w9 b: z
10573.                                 )
       3 C( ]6 G9 k* B. z8 ~
10574.                             )
       
10575.                         )
       ! d+ H# l4 f9 ^6 e3 [
10576.                     (princ "\nThe 2D Polyline is not parallel to the current UCS.")
       
10577.                     (ddpline)
       
10578.                     )
       $ l7 x% B" B8 E
10579.                 )
       * x( I0 b% V2 l0 G, Y& g. `
10580.              )
       
10581.            )
       ' O/ a) s0 N' `9 n) a" H
10582. 
       
10583.            ((= etype "SHAPE")
       
10584.              (setq help_entry  "modify_Shape_dialog")
       7 u" I6 C5 u+ ?( V  o( K" k# A+ Q3 N
10585.              (ddshape)
       
10586.            )
       
10587.            ((= etype "SOLID")
       ) r- Y5 A& ~8 ?$ g7 v' X/ d
10588.              (setq help_entry  "modify_Solid_dialog")
       
10589.              (ddsolid)
       + a( o! z4 A5 d2 T. V
10590.            )
       . d* [& U/ M! c) N! W# S
10591.            ((= etype "TEXT")
       
10592.              (setq help_entry  "modify_Text_dialog")
       ; |7 g1 @# ]$ F; B
10593.              (ddtext)
       ( S8 {+ k; A" w2 K3 P) D
10594.            )
       
10595.            ((= etype "MTEXT")
       
10596.              (setq help_entry  "modify_MText_dialog")
       0 R$ C  M9 H4 t7 a
10597.              (ddmtext)
       
10598.            )
       
10599.            ((= etype "TRACE")
       
10600.              (setq help_entry  "modify_Trace_dialog")
       
10601.              (ddsolid)
       8 U" a+ K$ J- H% V7 h6 j
10602.            )
       
10603.            ((= etype "VIEWPORT")
       
10604.              (setq help_entry  "modify_Viewport_dialog")
       
10605.              (ddvport)
       
10606.            )
       + K8 {% ~0 g: E* M1 H+ ^9 H
10607.            ((= etype "IMAGE")
       
10608.              (setq help_entry  "modify_Image_dialog")
       # t; R6 v7 ]3 V
10609.              (ddimage)
       0 R8 [7 a, n, {" w
10610.            )
       : B2 S( s5 U2 @' T# b  z4 \9 }
10611.            ((= etype "3DFACE")
       4 k& a) }4 n6 [& p1 \9 \0 f
10612.              (setq help_entry  "modify_3D_Face_dialog")
       
10613.              (dd3dface)
       
10614.            )
       
10615.            ((= etype "DIMENSION")
       
10616.              (setq help_entry  "modify_Dimension_dialog")
       8 G( Q; E! d  k% ^6 o+ N& w- J9 G
10617.              (ddimen)
       
10618.            )
       
10619.            ((= etype "TOLERANCE")
       4 p: |, y- F% |6 v+ f
10620.              (setq help_entry  "modify_Tolerance_dialog")
       " [  z0 V) W5 A" s) J' o: ?
10621.              (ddtolerance)
       
10622.            )
       6 m$ g) i7 {- N# s( |2 v2 [
10623. ;; Fall-through condition changed by MCAD for MDT 1.1 release.
       9 J" u6 I/ ?$ U5 O2 B" b; }
10624. ;; This allows DDMODIFY to work on any custom object or any new object type
       7 w7 g' F& _, E7 P* ^
10625. ;; that isn't specifically handled above by calling the more generic DDCHPROP.
       
10626.            (t
       
10627.              (if (and (not ddchprop) (not (load "ddchprop" nil)))
       % S0 z. V5 z3 N, T7 X
10628.                 (princ (strcat "No dialog support for object type: " etype ".")))
       * M) V: }( D' N6 v' F$ x( Y
10629.              (progn
       
10630.                 (setq tempss (ssadd ename))
       - F' S. t- N. n( q( y+ @
10631.                 (ddchprop tempss)
       : d; u, Z3 O' \7 z( y2 f
10632.                 (setq tempss nil)
       
10633.              )
       8 s9 e8 j9 z8 \+ n
10634.            )
       
10635.         )
       2 x0 |) t& p& d; y3 V
10636. ;; Previous fall-through condition.
       
10637. ;;           (t (princ (strcat "No dialog support for object type: "
       
10638. ;;                             etype "."
       
10639. ;;                     )
       4 A5 N/ b% B& U) T) f+ P5 ]
10640. ;;              )
       
10641. ;;           )
       * [, p" L( m7 d# C# r  ]! i6 ~6 L
10642. ;;        )
       * B& O% a* m  W1 n0 x' A" C5 s
10643.         (ai_undo_pop)
       
10644.      )
       & [( j3 l" j: Y  _
10645.   )
       
10646. 
       6 F5 P3 D) E7 q, {5 W
10647.   (if (eq new_pickstyle (getvar "PICKSTYLE")) ; if user didn't change pickstyle
       
10648.       (setvar "PICKSTYLE" old_pickstyle)      ; transparently then set it back
       
10649.   )                                           ; to what we started with
       * o& u2 I0 p2 f; z
10650. 
       
10651.   (setq *error* old_error)
       , {5 \5 t8 b, k8 l: g
10652.   (setvar "cmdecho" old_cmd)
       0 s" F$ {- v% r) u+ E( k
10653.   (if (not reset_flag)            ; if object was modified, then
       
10654.       (ai_return ename)           ; return it's ename to caller
       
10655.   )
       + ~' }3 o, O" m/ G! W+ [
10656. )
       4 ~( {* f7 A* E3 Z
10657. 
       , z- V* J0 ?# o3 {5 N
10658. (defun checkForLockedLayer (ename)
       
10659.     (setq layername (cdr (assoc 8 (cdr (entget ename)))))
       ) M) W3 ?9 v, h! ]9 h
10660.     (setq layerflag (cdr (assoc 70 (tblsearch "LAYER" layername))))
       
10661.     (if (= layerflag 4)
       
10662.         T
       
10663.         nil
       
10664.     )
       ! M9 {$ P$ r( T" i: z
10665. )
       
10666. 
       7 [+ T6 e$ \4 `: N* b2 o' w8 |
10667. (princ "  DDMODIFY loaded.  ")
       
10668. (princ)
       
10669. ;;;???;;;---------------------------------------------------------------------------------------
       4 V5 Z0 C) d# R4 b: b( e
10670. 
       
10671. ; Next available MSG number is    8
       " [$ o! K, ]1 y% p% F4 j
10672. ; MODULE_ID DDUCSP_LSP_
       7 T% S8 O2 V5 N4 \& B5 t/ X
10673. ;;;
       # }2 f8 F& O, {- s0 I2 j5 E9 y
10674. ;;;    dducsp.lsp
       
10675. ;;;
       ) i3 A/ B9 e) u/ X4 S# E. J- A# b5 `
10676. ;;;    Copyright 1992, 1994, 1996 by Autodesk, Inc.
       + z+ r9 s; j+ M7 w" X- K  g
10677. ;;;
       ( x9 l5 |7 d2 @5 J. ^
10678. ;;;    Permission to use, copy, modify, and distribute this software
       $ F+ D/ F6 @4 R( y5 l$ w
10679. ;;;    for any purpose and without fee is hereby granted, provided
       1 |  o' j6 m3 H
10680. ;;;    that the above copyright notice appears in all copies and
       " s8 I6 `* c# ?. ~: j
10681. ;;;    that both that copyright notice and the limited warranty and
       ' D; E, q2 x) `0 i; G% {) n$ z+ H; F5 ?
10682. ;;;    restricted rights notice below appear in all supporting
       3 r" B' y: K. @. |) w2 o, I
10683. ;;;    documentation.
       6 g( }4 H+ I5 z' Y
10684. ;;;
       ; o- l1 @  H/ s# w" ~2 Y: A% A
10685. ;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
       
10686. ;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
       + Q* d( V, V$ E+ g0 ]4 M
10687. ;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
       6 a4 x% s) c* U$ \
10688. ;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
       
10689. ;;;    UNINTERRUPTED OR ERROR FREE.
       % ^& |+ D- I7 g' {
10690. ;;;
       5 v, }# ^, s7 B6 j
10691. ;;;    Use, duplication, or disclosure by the U.S. Government is subject to
       
10692. ;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
       
10693. ;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
       
10694. ;;;    (Rights in Technical Data and Computer Software), as applicable.
       8 W+ G+ Y- P. Z# i8 k% @
10695. ;;;
       
10696. ;;;.
       
10697. ;;;   C:DDUCSP - User Coordinate System presets dialogue.
       
10698. ;;;     
       
10699. ;;;              Uses DDUCSP.DCL for the dialogue definition.  The
       . K3 R8 J( ~% ^- |/ }
10700. ;;;              slide images are in ACAD.SLB.
       
10701. ;;;
       6 _9 P! A" A) ?
10702. ;;; ===========================================================================
       
10703. ;;; ===================== load-time error checking ============================
       ( b/ \4 k8 |/ k
10704. ;;;
       
10705. 
       7 h" N$ A9 K* q4 f; R* ?
10706.   (defun ai_abort (app msg)
       
10707.      (defun *error* (s)
       % H; B( s5 a! T3 x7 a" _' g7 _+ s# R
10708.         (if old_error (setq *error* old_error))
       
10709.         (princ)
       " k2 U* u: U5 H4 Y1 D7 j1 j
10710.      )
       + p, J2 p  |) R/ |% l5 a
10711.      (if msg
       * x7 ?5 }) Q7 \
10712.        (alert (strcat " Application error: "
       ( v' i+ P& F2 t) P% s1 @. V
10713.                       app
       
10714.                       " \n\n  "
       + s  C) j: m. d* Z$ X
10715.                       msg
       ! F3 R4 X4 S, w6 m4 o
10716.                       "  \n"
       1 ]2 I/ _2 A& c0 E! V7 o+ Q& Q+ G
10717.               )
       ; V2 e  I5 K# M9 f6 @. W3 v: [
10718.        )
       $ k& J0 F, w+ S; @8 l, B
10719.      )
       3 r+ M) ~. y: |# k; u9 z1 A
10720.      (exit)
       
10721.   )
       
10722. 
       $ w: b; k3 Q  R" D9 l
10723. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
       
10724. ;;; and then try to load it.
       % [, d6 T2 o! ?* ~* e9 a3 J
10725. ;;;
       
10726. ;;; If it can't be found or it can't be loaded, then abort the
       , I# ]! o- I) ?. w* f! U
10727. ;;; loading of this file immediately, preserving the (autoload)
       
10728. ;;; stub function.
       % b* i$ y, n4 a/ C7 r# m. e
10729. 
       5 _$ Z: R" v+ E( R1 s8 b
10730.   (cond
       - {  r! \6 {* R& a! q) c0 t. r
10731.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
       4 t0 q5 b9 x3 Y- \- ?2 L# l# g
10732. 
       
10733.      (  (not (findfile "ai_utils.lsp"))                     ; find it
       
10734.         (ai_abort "DDUCSP"
       3 m9 x- o; g# q0 J9 d" z5 O
10735.                   (strcat "Can't locate file AI_UTILS.LSP."
       
10736.                           "\n Check support directory.")))
       1 I( F% E/ C2 |: I& T
10737. 
       6 o9 y0 y6 e4 O, v* N
10738.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
       
10739.         (ai_abort "DDUCSP" "Can't load file AI_UTILS.LSP"))
       
10740.   )
       / @4 ~( I/ X7 P# g% a2 S- {
10741. 
       
10742.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
       
10743.       (ai_abort "DDUCSP" nil)         ; a Nil <msg> supresses
         R1 }; O! ?9 ?/ S
10744.   )                                    ; ai_abort's alert box dialog.
       & a! O! A" j* w! h
10745. 
       
10746. ;;; ==================== end load-time operations ===========================
       
10747. 
       
10748. (defun ai_ucsp_start ( / program)
       
10749.   ;; Get program name
       8 @7 d* O1 u# I/ _, c' t6 U
10750.   (if (not (setq program (getvar "program")))
       
10751.      (setq program "acad")
       + ^  p% \) [! A3 ~
10752.   )
       . l, H& A! Y$ u' R; o3 q
10753.   (foreach v0 '("world" "left" "cview" "top" "front"
       - }5 p* v& n3 k
10754.                 "bottom" "back" "right" "prev")
       
10755.     (start_image (strcat "ucsp_" v0))
       
10756.     (slide_image
       
10757.       0 0
       
10758.       (- (dimx_tile (strcat "ucsp_" v0)) 1) (- (dimy_tile (strcat "ucsp_" v0)) 1)
       $ E5 ?8 A4 M9 y* o. q
10759.       (strcat program "(u-" v0 ")")
       $ u& p  Y0 _& N6 a
10760.     )
       . x" |+ @% R5 @% o! m" S* i& k; J
10761.     (end_image)
       
10762.   )
       
10763. )
       
10764. 
       
10765. (defun ai_ucsp_set ()
       
10766.   (if ai_ucsp_sv
       4 t) \3 ]4 L1 o/ ]6 M$ ]. ]5 ~$ i0 }) J
10767.     (command "_.UCS" "_V")
       0 n1 F' Y: \9 O
10768.     (if ai_ucsp_prevs
       & m# {( P; Q7 I# L
10769.       (command "_.UCS" "_P")
       
10770.       (if ai_ucsp_chg
       / W: b6 f8 a  _; Y0 b
10771.         (progn
       4 c2 g+ o3 ~* J, A
10772.           (if (/= ai_ucsp_a "*")
       ( B* _: ~( {1 ~" x7 |
10773.             (setvar "LASTPOINT" (trans (getvar "UCSORG") 0 1))
       . k# O/ e! s* p3 U4 J4 f3 T
10774.           )
       + K; B' v: C! i+ g1 t
10775.           (if (< ai_ucsp_pick 6)
       
10776.             (setq ai_ucsp_set0 "@")
       5 }3 \& `' t% d5 R8 B
10777.             (setq ai_ucsp_set0 "*0,0,0" ai_ucsp_a "*")
       
10778.           )
       5 ?9 P: w, R9 z* @
10779.           (cond ((= ai_ucsp_pick 0)
       
10780.                  (setq ai_ucsp_set1 "0,-1,0"
       
10781.                        ai_ucsp_set2 "0,0,1"
       + d2 ]$ y; r" X* X2 H
10782.                  )
       
10783.                 )
       
10784.                 ((= ai_ucsp_pick 2)
       / f2 f" C7 @# |1 G
10785.                  (setq ai_ucsp_set1 "1,0,0"
       " `# X9 H" s, r7 f0 d
10786.                        ai_ucsp_set2 "0,0,1"
       
10787.                  )
       
10788.                 )
       
10789.                 ((= ai_ucsp_pick 3)
       
10790.                  (setq ai_ucsp_set1 "1,0,0"
       8 C$ ~; f& g9 w% O: E" l
10791.                        ai_ucsp_set2 "0,-1,0"
       
10792.                  )
       4 ~6 u. O5 M! i' T5 \/ e! t  j  E
10793.                 )
       3 k9 R" l  H7 ?$ T
10794.                 ((= ai_ucsp_pick 4)
       
10795.                  (setq ai_ucsp_set1 "-1,0,0"
       
10796.                        ai_ucsp_set2 "0,0,1"
       
10797.                  )
       4 O8 j/ P* G2 P7 E
10798.                 )
       $ A9 l% G" p& x5 a" I
10799.                 ((= ai_ucsp_pick 5)
       . w  Q4 K; D" M) u
10800.                  (setq ai_ucsp_set1 "0,1,0"
       8 u" @. X$ F/ ?+ Y* l( H8 G2 @
10801.                        ai_ucsp_set2 "0,0,1"
       " E) a6 {, z4 ^+ H
10802.                  )
       
10803.                 )
       : M6 |' k3 y' W4 V
10804.                 (T
       
10805.                  (setq ai_ucsp_set1 "1,0,0"
       
10806.                        ai_ucsp_set2 "0,1,0"
       
10807.                  )
       
10808.                 )
       ' h+ O" X3 u! ~5 _
10809.           )
       . X, I8 A, Q. d. @* L0 }
10810.           (command "_.UCS" "_3P" ai_ucsp_set0
       
10811.                    (strcat ai_ucsp_a ai_ucsp_set1)
       
10812.                    (strcat ai_ucsp_a ai_ucsp_set2)
       + s- d/ o( Z* \* r# ^: s' ^+ ]$ l
10813.           )
       5 Z. h+ E, T$ x# u: o5 s
10814.         )
       
10815.       )
       ' x. ]; P7 d! J$ V+ }( A* \4 _
10816.     )
       
10817.   )
       , L. c/ h5 i( ~1 E1 K
10818. )
       8 G( ^, G( o" T+ l# d; v  e; e
10819. 
       
10820. (defun ai_ucsp_p (val currtile)
       
10821.   (mode_tile ai_ucsp_currtile 4)
       5 S* e' H6 m+ W5 T; S. S" M+ r
10822.   (setq ai_ucsp_pick val
       
10823.         ai_ucsp_sv nil
       & d! K# }4 ^5 {
10824.         ai_ucsp_currtile currtile
       
10825.   )
       
10826.   (if (/= val 1)
       . k  _9 O1 q; m' |* E
10827.     (setq ai_ucsp_chg T)
       
10828.   )
       
10829.   (mode_tile ai_ucsp_currtile 4)
         [# l( |+ T, W) ^
10830. )
       ; A. ?. t/ H; S
10831. 
       
10832. (defun ai_ucsp_swcs ()
       
10833.   (mode_tile ai_ucsp_currtile 4)
       * [7 t; d8 C. y! U* ^7 X- s$ l
10834.   (set_tile "ucsp_a_wcs" "1")
       $ v* E7 _# t9 e! G' ]
10835.   (setq ai_ucsp_pick 6
       2 i5 M+ ~: l& C9 B# P+ I
10836.         ai_ucsp_sv nil
       % h- z7 a# e6 D
10837.         ai_ucsp_currtile "ucsp_world"
       
10838.   )
       
10839.   (if (/= 1 (getvar "WORLDUCS"))
       
10840.     (setq ai_ucsp_chg T)
       
10841.     (setq ai_ucsp_chg nil)
       + ^7 b8 J+ l; p1 A' p) g
10842.   )
       
10843.   (mode_tile ai_ucsp_currtile 4)
       
10844. )
       
10845. 
       
10846. (defun ai_ucsp_cview ()
       
10847.   (mode_tile ai_ucsp_currtile 4)
       
10848.   (setq ai_ucsp_sv T
       % A5 U! d# A1 l0 [( Z
10849.         ai_ucsp_chg nil
       0 `! w# u* R1 `3 f+ {) t  V1 G
10850.         ai_ucsp_currtile "ucsp_cview"
       
10851.   )
       6 |/ {! @* r8 `" q
10852.   (set_tile "ucsp_a_wcs" "1")
       
10853.   (mode_tile ai_ucsp_currtile 4)
       8 p" y( C( l$ i# V' E! W5 s. i
10854. )
       - T6 `; P( Y$ S. x9 P
10855. 
       : u0 k& a8 b  G8 K  ^9 @& p5 M' v  A
10856. (defun ai_ucsp_rucs (typ)
       # N) W* H, X# {3 @
10857.   (setq ai_ucsp_a typ)
       
10858.   (mode_tile ai_ucsp_currtile 2)
       2 ^. B3 b5 O  ~# @0 B: v3 g
10859. )
       
10860. 
       
10861. (defun ai_ucsp_prev ()
       ( E# H' Q6 J6 |  x
10862.   (mode_tile ai_ucsp_currtile 4)
       
10863.   (setq ai_ucsp_prevs T
       
10864.         ai_ucsp_currtile "ucsp_prev"
       
10865.   )
       7 o' T7 n8 B$ O8 j, }
10866.   (mode_tile ai_ucsp_currtile 4)
       
10867. )
       " U& T& V% P: V% Z9 ^& G$ K, ?
10868. 
       7 I% U8 e+ L. F0 _4 V6 f* S
10869. (defun ai_ucsp_main ( / ai_ucsp_pick ai_ucsp_sv globals)
       
10870.   (if (not (new_dialog "dducsp" dcl_id))
       # U, ^  ~8 k3 `" H( @7 [# e
10871.     (exit)
       # n7 g8 ?, ]1 ?9 ?# U* U
10872.   )
       - X( u' F9 m; B2 \! H6 G1 u
10873. 
       1 s( T! t* {$ Z0 f) q" q. h
10874.   (ai_ucsp_start)
       
10875.   (setq ai_ucsp_a "@"
       2 a( L  D8 H9 `3 }6 a
10876.         ai_ucsp_pick 2
       1 W) c3 U7 i: s  h) L* c$ w
10877.         ai_ucsp_currtile "ucsp_top"
       % F) b9 ^1 v4 q* X
10878.   )
         o4 p! _4 h/ q* s1 P& p1 g% }' d
10879.   (if (= 1 (getvar "WORLDUCS"))
       
10880.     (progn
       
10881.       (set_tile "ucsp_a_wcs" "1")
       3 {- A4 e( r% A2 ^3 D. {# _
10882.       (setq ai_ucsp_currtile "ucsp_world")
       
10883.     )
       ) b1 L/ u4 r* c- d! e
10884.     (set_tile "ucsp_r_ucs" "1")
       
10885.   )
       1 z% {9 S; Z( C9 a  V, a
10886.   (mode_tile ai_ucsp_currtile 2)
       4 U1 A3 t$ K1 ^4 p$ Q. }" r
10887.   (mode_tile ai_ucsp_currtile 4)
       
10888.   (action_tile "ucsp_world" "(ai_ucsp_swcs)")
       + h5 R9 W  B. ]
10889.   (action_tile "ucsp_cview" "(ai_ucsp_cview)")
       
10890.   (action_tile "ucsp_left" "(ai_ucsp_p 0 $key)")
       * k% f: _) p. J6 {7 {
10891.   (action_tile "ucsp_top" "(ai_ucsp_p 1 $key)")
       
10892.   (action_tile "ucsp_front" "(ai_ucsp_p 2 $key)")
       
10893.   (action_tile "ucsp_bottom" "(ai_ucsp_p 3 $key)")
       ; l3 A% u$ s: l8 w' K
10894.   (action_tile "ucsp_back" "(ai_ucsp_p 4 $key)")
       % x3 X( f. c, Y, C% ]1 ~; ~
10895.   (action_tile "ucsp_right" "(ai_ucsp_p 5 $key)")
       
10896.   (action_tile "ucsp_prev" "(ai_ucsp_prev)")
       ' O7 V  s+ v9 g! D0 T
10897.   (action_tile "ucsp_r_ucs" "(ai_ucsp_rucs \"@\")")
       3 k2 R& k: T9 {; u+ H1 i
10898.   (action_tile "ucsp_a_wcs" "(ai_ucsp_rucs \"*\")")
       / n6 z' y, f% `; H" |
10899.   (action_tile "accept" "(done_dialog 1)")
       ; ^: A" ?% S$ o! b6 k# U3 e+ p
10900.   (action_tile "cancel" "(done_dialog 0)")
       
10901.   (action_tile "help" "(help \"\" \"DDUCSP\")")
       8 S" t) E, m2 \2 g# S+ Y8 p+ ]
10902.   (if (= (start_dialog) 1)
       
10903.     (ai_ucsp_set)
       8 \' N: o, R' |9 i0 K9 `
10904.   )
       , z8 S' }0 s, W( s+ {1 {
10905. )
       3 |8 ]; d( h& }- G+ d
10906. 
       
10907. (defun c:UUS ( / app dcl_id old_cmd old_osmode ai_ucsp_prevs
       
10908.                     ai_ucsp_sw undo_init)
       
10909. 
       ' h( f8 E5 V* A7 Y
10910.   ;; Set up error function.
       
10911.   (setq old_cmd (getvar "CMDECHO")    ; save current setting of cmdecho
       6 M+ t& Z) [& [9 V9 V
10912.         old_error  *error*            ; save current error function
       : `$ T. u; @. K$ ^. X7 S; b
10913.         *error* ai_error              ; new error function
       
10914.         old_osmode (getvar "OSMODE")  ; disable OSNAP for duration
       4 [" c2 v0 `+ K: v( U+ Q% S. a) e
10915.   )
       : m* A4 k" s# ]% C5 j
10916. 
       8 D, ^" }" |& x: `. T
10917.   (setvar "CMDECHO" 0)
       
10918. 
       
10919.   (cond
       
10920.      (  (not (ai_notrans)))                     ; transparent not OK
       
10921.      (  (not (ai_acadapp)))                     ; ACADAPP.EXP xloaded?
       
10922.      (  (not (setq dcl_id (ai_dcl "dducsp"))))  ; is .DCL file loaded?
       % o  R  H" Y- h" E* B5 u
10923.      (T (ai_undo_push)
         h# j6 f  B$ ?# p" K) t
10924.         (setvar "OSMODE" 0)
       + a" d% P3 ^2 g3 ?3 d
10925.         (ai_ucsp_main)
       
10926.         (setvar "OSMODE" old_osmode)
       
10927.         (ai_undo_pop)
       
10928.      )
       
10929.   )
       
10930. 
       9 t  W" b- c! r8 O
10931.   (setq *error* old_error)
       5 E4 N& |' ?! N# I: o4 Y1 M
10932.   (setvar "cmdecho" old_cmd)
       
10933. 
       2 L" b! K' n! K5 W3 G) d4 G
10934.   (princ)
       
10935. )
       
10936. 
       + E% U# D$ C% M$ x0 r, w
10937. (princ "  DDUCSP loaded.  ")
       
10938. (princ)
       & J2 y8 Z; ^# R$ t3 r' W
10939. 
       
10940. ;;;???;;;---------------------------------------------------------------------------------------
       6 b* }: M3 }, {5 N( p
10941. 
       ' C7 A# V# U9 I1 S% }' S% q2 {
10942. ;;;----------------------------------------------------------------------------
       , o  ?$ `0 u' u
10943. ;;;
       , m+ Z9 v& I4 }/ z- N
10944. ;;;    EXCHPROP.LSP   
       
10945. ;;;    Polyline and text modification capabilities added by
       
10946. ;;;    Randy Kintzley  
       
10947. ;;;
       
10948. ;;;    Copyright (C) 1997 by Autodesk, Inc.
       
10949. ;;;
       
10950. ;;;    Permission to use, copy, modify, and distribute this software
       
10951. ;;;    for any purpose and without fee is hereby granted, provided
       
10952. ;;;    that the above copyright notice appears in all copies and
       
10953. ;;;    that both that copyright notice and the limited warranty and
       . Q+ E$ ]: [1 ^" l2 c  v7 }- _; C: V
10954. ;;;    restricted rights notice below appear in all supporting
       2 D4 j1 b( x$ a- e- ~4 B
10955. ;;;    documentation.
       # w7 p0 p7 N$ f& q: m+ y$ h' L6 d
10956. ;;;
       / w, W6 Y/ _. L: X- Q2 p8 Y5 N5 U
10957. ;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
       $ F7 B6 x/ n2 B# i. h. m
10958. ;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
       
10959. ;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
       . l* l8 b+ I. v/ k4 J& g
10960. ;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
       
10961. ;;;    UNINTERRUPTED OR ERROR FREE.
       
10962. ;;;
       # M1 L7 k; n5 A! j* j  t
10963. ;;;    Use, duplication, or disclosure by the U.S. Government is subject to
       , Z2 r: Y5 z+ e' X
10964. ;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
       
10965. ;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
       . G( J( j5 R" O0 V3 e6 m* l
10966. ;;;    (Rights in Technical Data and Computer Software), as applicable.
       , U) [+ T, x' P" ]
10967. ;;;
       
10968. ;;;.
       5 Z1 Y3 Y% p; G' m
10969. ;;;    28 February 1997
       , A9 }( o5 U8 I
10970. ;;;
       
10971. ;;;
       
10972. ;;;----------------------------------------------------------------------------
       8 @) S1 `8 F6 {; z! A
10973. ;;;   DESCRIPTION
       
10974. ;;;----------------------------------------------------------------------------
       % N! }9 A; D- U( R, c6 _3 L; f
10975. ;;;   C:EXCHPROP is an extended or enhanced version of ddchprop. This  
       2 d/ {* ~; z+ o8 ~( w# b9 v
10976. ;;;   command gives the user the abilitie to change several characteristics
       
10977. ;;;   of selected polyline and text objects.
       $ p8 s' P% h- B, x- o
10978. ;;;       The style and height of selectected text objects can be modified
       ; Q, F( Q4 Q1 f( `
10979. ;;;   (including text, mtext and attribute definitions) as well as, width and
       
10980. ;;;   elevation characteristics of selected polylines (includes lightweight and
       ( Z8 Z' B" i% n! S+ C3 Y& j  ~
10981. ;;;   traditional polylines.)
       6 x) i2 d) a, O. _5 D
10982. ;;;----------------------------------------------------------------------------
       
10983. ;;;----------------------------------------------------------------------------
       
10984. ;;;   Prefixes in command and keyword strings:
       7 k# m" v  e; l7 [# T
10985. ;;;      "."  specifies the built-in AutoCAD command in case it has been
       
10986. ;;;           redefined.
       
10987. ;;;      "_"  denotes an AutoCAD command or keyword in the native language
       
10988. ;;;           version, English.
       
10989. ;;;----------------------------------------------------------------------------
       
10990. ;;;
       - |6 K$ }9 H$ u' i3 i" O  h
10991. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
10992. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;GLOBAL INFO.;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
10993. ;Functions created as result of loading file: exchprop.lsp
       
10994. ; DDCHPROP2
       7 H  g- h3 m4 J* w) Z' d: v: X
10995. ; DDCHPROP2_INIT
       
10996. ; DDCHPROP2_SELECT
       $ r4 e( m. z' U* K
10997. ;
       
10998. ;Variables created as result of loading file: exchprop.lsp
       
10999. ; OLD_ALLOC
       
11000. ;
       
11001. ;Functions created as a result of executing the commands in: exchprop.lsp
       0 L0 M) B* I0 [( t
11002. ;
       9 `, O! R5 v+ M& ]8 Z4 J: O# H0 b) v
11003. ;Variables created as a result of executing the commands in: exchprop.lsp
       
11004. ; AI_SELTYPE
       3 C" f$ T5 V$ {9 l+ }: e
11005. ; BONUS_ALIVE
       
11006. ; BONUS_OLD_ERROR
       1 m$ g" E/ M( d) D. X; G
11007. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;GLOBAL INFO.;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       / b! [$ j2 _* h& o6 c' u
11008. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
11009. 
       8 O' \) W, }- S, P
11010. ;;;
       
11011. ;;; Avoid (gc)s on load to improve load time.
       
11012. ;;;
       
11013. (defun do_alloc (/ old_allod new_alloc)
       4 R1 z! Q6 I: T  l5 k
11014.   (setq old_alloc (alloc 2000) new_alloc (alloc 2000))
       
11015.   (expand (1+ (/ 4750 new_alloc)))
       
11016.   (alloc old_alloc)
       % a( z! f( \9 \3 ~
11017. );defun
       2 q5 C5 E4 P; s
11018. 
       
11019. ;runs at load time - rk
       # b/ x5 k3 _8 L9 x5 d$ Q
11020. (do_alloc)
       / L/ h; H" e: m6 I& G' d5 [5 ?
11021. (setq do_alloc nil)
       6 e1 n. |6 X4 x* l9 m. Q" v
11022. ;;;
       6 l* r% E8 N0 T/ J
11023. ;;; ===========================================================================
       
11024. ;;; ===================== load-time error checking ============================
       9 u9 r4 @  k5 x- W
11025. ;;;
       % n7 L# Z( Z8 h5 p- I
11026. 
       6 x) N2 b4 k& N
11027.   (defun ai_abort (app msg)
       
11028.      (defun *error* (s)
       
11029.       (if old_error (setq *error* old_error))
       . _: F1 z# t5 V; {* K  u/ i
11030.       (princ)
       5 k& Q+ r: @! E  Z9 n
11031.      );defun
       
11032.      (if msg
       $ D' Q( ~# S7 U: T# Q
11033.        (alert (strcat " Application error: "
       
11034.                       app
       
11035.                       " \n\n  "
       
11036.                       msg
       
11037.                       "  \n"
       
11038.               )
       % L- r2 I" D! U* I$ K
11039.        );alert
       
11040.      );if
       ( n/ H7 [8 l" Z5 j3 m* p% L3 s9 @
11041.      ;(*error* msg)
       
11042.      (exit)
       7 H# [, G/ q, e; N$ Z
11043.   );defun ai_abort
       
11044. 
       - O' ]  }, d# k
11045. ;runs at load time - rk
       
11046. ;(if (and *error*      ;added the if wrapper around this - rk.
       % i! G; e/ u1 _, b* U+ u5 }
11047. ;         (not old_error)      
         i+ w& o. y% ]
11048. ;    );and
       
11049. ;    (setq old_error *error*);setq
       % V3 m! g! B- f
11050. ;);if
       2 J& s/ M! _5 |, X
11051. 
       
11052. 
       7 [$ l" H& E+ T+ l  `4 j* h. l3 r
11053. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
       
11054. ;;; and then try to load it.
       
11055. ;;;
       1 w6 O- W( \9 h* r2 L9 I; ]6 X  J( D
11056. ;;; If it can't be found or it can't be loaded, then abort the
       # V( K3 ]( E) B+ b. d1 G, g
11057. ;;; loading of this file immediately, preserving the (autoload)
       
11058. ;;; stub function.
       
11059. 
       $ @- ^/ P6 k" k( }: r! _
11060. ;runs at load time - rk.
       
11061. (cond
       
11062. (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
       
11063. (  (not (findfile "ai_utils.lsp"))                     ; find it
       ! E, r% B. h  K' {" Z) J$ F* j
11064.     (ai_abort "EXCHPROP"
       
11065.               (strcat "Can't locate file AI_UTILS.LSP."
       
11066.                       "\n Check support directory.")
       
11067.     );ai_abort
       
11068. )
       # K' R: }6 Y' K( W, ]
11069. (  (eq "failed" (load "ai_utils" "failed"))            ; load it
       ! y9 k9 `* E1 Y6 `
11070.     (ai_abort "EXCHPROP" "Can't load file AI_UTILS.LSP")
       ) v: {& J' N7 a! x
11071. )
       
11072. );cond close
       % x6 x5 g6 M8 O7 d$ E3 f
11073. 
       ! \5 I0 _+ v% Q9 h
11074. (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
       
11075.     (ai_abort "EXCHPROP" nil)       ; a Nil <msg> supresses
       9 f- ?, l; [4 c6 {; b
11076. );if                                 ; ai_abort's alert box dialog.
       
11077. 
       
11078. ;;; ==================== end load-time operations ===========================
       
11079. 
       
11080. ;;; Initialize program subroutines and variables.
       1 j. T/ X2 T2 g/ Q, ?
11081. 
       " s3 P7 \+ p9 t7 |) K
11082. (defun ddchprop2_init()
       & s5 F# B' h% |) [: q7 x
11083. 
       ( O' ?' n6 {# V6 ^" W
11084. 
       - s* |7 |' z' D2 k3 W4 K& z
11085. 
       
11086.   ;;
       ; Z, P3 M0 ]. ]  m' W
11087.   ;; Define buttons and set values in CHPROP dialogue box
       1 f* g! |9 J5 m' z  @+ j7 S! N
11088.   ;;
       ' H( n6 I' a0 n5 J5 x2 n
11089.   (defun call_chp2 (/ cmdact p1 p2)
       
11090. 
       
11091.     (if (not (new_dialog "ch_prop" dcl_id))
       
11092.         (exit)
       5 e3 A; a2 Q% J) f# j8 s+ N: Y& N
11093.     )
       
11094. 
       
11095.     (set_tile "error" "")
       $ q5 `% G9 `2 h) L
11096.     ;; Set initial dialogue tile values
       
11097.     (set_col_tile)
       , }- c8 H: ^, T6 ?! f: P: L4 }
11098.     (set_tile "t_layer" elayer)
       
11099. 
       " F1 T: C  u/ X7 n
11100.     (cond
       + }, M; n! n: q0 k) Z6 ~% f
11101.       ((= lt-idx nil)
       
11102.         (set_tile "t_ltype" "Varies")
       
11103.       )
       
11104.       ((= lt-idx 0) ; set tile "By layer & layer linetype"
       
11105.         (set_tile "t_ltype" (bylayer_lt))
       
11106.       )
       0 P2 [! Q# t, Q4 f" \+ k. d
11107.       (T
       - D' I2 S6 h3 Z+ O( Y1 w$ N
11108.         (set_tile "t_ltype" (nth lt-idx ltnmlst))
       
11109.       )
       
11110.     )
       
11111. 
       
11112.     (if (or (= ethickness nil)
       ' l: `2 s8 l1 p7 C' \) Z& s9 W
11113.             (= ethickness "")
       
11114.             (= ethickness "Varies")
       
11115.         );or
       
11116.         (set_tile "eb_thickness" "")
         N) C, M1 H0 ^, @. K0 l
11117.         (set_tile "eb_thickness" (ai_rtos ethickness))
       2 w/ N. f/ e  y
11118.     );if
       " l2 e2 w, A9 }: H4 D: T( ~9 n
11119.     (if (or (= eltscale nil)
       % ^  N4 Q( h/ }' S+ ~* |: g
11120.             (= eltscale "")
       ' ?0 @- ?; o( u1 D. i( C
11121.             (= eltscale "Varies")
       
11122. 
       * O& T# r2 s' H2 q, j  [6 _0 c
11123.         )
       2 K# K$ o/ n* d  n" A( m
11124.         (set_tile "eb_ltscale" "")
       
11125.         (set_tile "eb_ltscale" (ai_rtos eltscale))
       
11126.     )
       
11127.     (if
       7 n" A& {/ y2 _6 J/ ^" G+ h. ~
11128.       (numberp ewidth)
       
11129.       (set_tile "poly_wid" (ai_rtos ewidth))
       
11130.       (set_tile "poly_wid" ewidth)
       1 V6 H% T7 U6 ~1 k+ L/ v9 l: s
11131.     )
       
11132.     (if
       ( e& g5 i- {+ c) i- ~, B
11133.       (numberp eelevation)
       6 c2 T2 E- E$ n0 D
11134.       (set_tile "poly_elev" (ai_rtos eelevation))
       
11135.       (set_tile "poly_elev" eelevation)
       
11136.     )
       ; p& ~  o' t& c$ Z7 b
11137.     (if
       ( q- E& ?6 w& u& i4 U
11138.       (numberp eheight)
       / J8 [4 X9 a- G# Z  g
11139.       (set_tile "text_hgt" (ai_rtos eheight))
       
11140.       (set_tile "text_hgt" eheight)
       
11141.     )
       ) g8 ]/ I8 a1 u% i
11142.     (if (not estyle)
       
11143.         (setq estyle "")
       
11144.     );if
       
11145.     (setq hair_style_list (tnlist '("style" 16)));setq
       
11146.     (if (not (member estyle hair_style_list))
       
11147.         (setq hair_style_list (append hair_style_list (list estyle)));setq
       9 ~* o! b  H! I! x
11148.     );if
       
11149. 
       
11150.     (setq hair_style_list (acad_strlsort hair_style_list));setq
       
11151.     (mpoplst "text_style" hair_style_list)
       1 j' Q8 I+ J0 B. S0 Z1 |
11152.     (set_tile "text_style"
         a% X, n6 H; C
11153.               (itoa (position estyle hair_style_list))
       7 f) f! }( |5 {8 Q
11154.     );set_tile
       
11155. 
       $ R6 o' F" t4 I8 |+ q- B- o7 y
11156.     ;; Disable tiles if need be...  ;@RK
       
11157.     (setq a 0)
       
11158.     (while ( < a  (sslength ss))
       
11159.       (setq which_tiles
       ' T5 ?/ R) @0 d" T* z% v& `
11160.             (ai_common_state (cdr (assoc '0 (entget (ssname ss a))))))
       3 B' F$ ^* U& I4 M
11161.    
       
11162.       ;; If all fields are enabled, don't bother checking anymore.
       8 v* n3 ~( z. x# r
11163.       (if (/= which_tiles (logior 1 2 4 8 16))
       7 |$ j2 A4 r  }$ T4 f! h4 X3 F
11164.         (setq a (1+ a))
       . ]: o, O% q$ y8 p2 A" r  M7 ^4 `
11165.         (setq a (sslength ss))
       
11166.       )
       
11167.     )
       0 ]2 v3 N8 @. `2 `  g. O7 n
11168.     ;; Layer Button and Text Field
       1 U. g1 v9 r. a: r* [2 t
11169. 
       , \- q+ D! j" E- D2 v
11170.     (if (/= 1 (logand 1 which_tiles))
       
11171.       (progn
       
11172.         (mode_tile "t_layer" 1)
       * A) T' q, I* y% n/ y
11173.         (mode_tile "b_name" 1)
         H8 s) I" _% Y- i- {/ p  |" M$ a
11174.       )
       
11175.     )
       # V4 k2 r/ o  j- z9 V& O  r) K
11176. 
       
11177.     ;; Color Button and Text Field
       ; t" d! L0 _. U) \: L
11178.     (if (/= 2 (logand 2 which_tiles))
       . K5 n4 L7 h4 y7 J. m" f" U% ?
11179.       (progn
       
11180.         (mode_tile "t_color" 1)
         W. @8 G- u: Q
11181.         (mode_tile "b_color" 1)
       3 R- B) Q# Z! `4 _9 F
11182.         (mode_tile "show_image" 1)
       
11183.       )
       ; v! G8 O7 v  W# I' @
11184.     )
       4 `# u% S0 U( Q) e8 u
11185.     ;; Linetype Button and Text Field
       . j1 J) p! n; a  @
11186.     (if (/= 4 (logand 4 which_tiles))
       / w6 v. X8 E0 e3 \: k
11187.       (progn
       / @" F( I. `2 c5 Z
11188.         (mode_tile "t_ltype" 1)
       
11189.         (mode_tile "b_line" 1)
       
11190.       )
       - o7 I; a2 H% G) G) M
11191.     )
       , e5 _/ a4 X2 P" f
11192.     ;; Linetype Scale Edit Field
       + _) W0 x8 Y0 d& R4 p: K% j$ ~
11193.     (if (/= 8 (logand 8 which_tiles))
       . B0 Z; |0 L: T, {% O0 w# D" H1 _
11194.       (progn
       / S1 _- {* e* X7 k+ f+ @
11195.         (mode_tile "eb_ltscale" 1)
       
11196.       )
       
11197.     )
       ; h; U! Q3 W* z- R; M7 @3 E
11198.     ;; Thickness Edit Field.
       6 X8 s, C) f* K; c
11199.     (if (/= 16 (logand 16 which_tiles))
       
11200.       (progn
       
11201.         (mode_tile "eb_thickness" 1)
       ; u- B) b, ?# }
11202.       )
       
11203.     )
       # |, Z7 ^$ R0 n$ R
11204. 
       . C9 }( ]$ G' U" J) d, H: k
11205.     ;; Polyline box and tiles          @rk 10:05 AM 1/30/97
       
11206.     (if (not (= 2 (logand 2 eflag)))
       
11207.         (progn
       
11208.          (mode_tile "text_hgt" 1)
       + d* ?) W. I3 h- h/ t2 a' s
11209.          (mode_tile "text_style" 1)
         b/ I0 W2 @' Q8 N" C0 D- K
11210.         );progn
       
11211.     );if
       
11212.     (if (not (= 1 (logand 1 eflag)))
       
11213.         (progn
       
11214.          (mode_tile "poly_wid" 1)
       ( s3 g" M6 t3 ]- O) o; f6 [
11215.          (mode_tile "poly_elev" 1)
       / ?# k* m- F' y( o# A
11216.         );progn then disable polyline fields
       
11217.     );if
       4 O7 x; r& z/ ~) Y. W# J
11218. 
       
11219.     ;; Define action for tiles
       
11220.     (action_tile "b_color" "(setq ecolor (getcolor))")
       1 P9 A9 f; i2 b
11221.     (action_tile "show_image" "(setq ecolor (getcolor))")
       
11222.     (action_tile "b_name" "(setq elayer (getlayer))")
       ) [5 Y8 o1 m5 x+ J
11223.     (action_tile "b_line" "(setq eltype (getltype))")
       8 [- [4 {9 r; m2 |8 r
11224.     (action_tile "eb_ltscale"  "(getscale $value)")
       1 e' C! [# o2 `: x
11225.     (action_tile "eb_thickness"  "(getthickness $value)")
       + F# T: V) {3 G% }$ K
11226.     (action_tile "poly_wid" "(getwidth $value)")
       
11227.     (action_tile "poly_elev" "(getelevation $value)")
       
11228.     (action_tile "text_hgt" "(getheight $value)")
       2 f' C( J$ x' J9 I9 }' |% @; @
11229.     (action_tile "text_style" "(getstyle $value hair_style_list)")
       
11230.     (action_tile "help" "(help \"AC_BONUS.HLP\" \"EXCHPROP\")")
       
11231.     (action_tile "accept" "(test-main-ok)")
       
11232. 
         }, }0 w) w* |% |+ O9 e* p
11233.     (if (= (start_dialog) 1)
       
11234.       (progn
         k0 @2 j3 c5 Q$ a1 Q
11235.         ; Update special properties for polyline and text selection-sets.
       
11236.         
       
11237.         (if (and (= 1 (logand 1 eflag))   ; polylines rk chprop
       
11238.                  (or ewidth
       3 C+ I; j8 |8 S5 n# ^* D
11239.                      eelevation
       
11240.                  );or
       3 w2 H& i: e4 \, U* _6 E
11241.             );and
       
11242.             (progn
       * M, w! ?( k; i' ?- @
11243.              (setq  ss-index 0
       
11244.                    ss-length (sslength poly_ss)
       % s% e1 K; _& U
11245.              );setq
       
11246.              (while (< ss-index ss-length)
       
11247.                (setq ename (ssname poly_ss ss-index)
       ' n; X7 F$ s/ p. I8 {
11248.                      elist (entget ename)
       2 e8 b9 i0 m6 s% S6 y
11249.                );setq
       
11250.                (ucs_2_ent (cdr (assoc 210 elist)));this function lives in ac_bonus.lsp
       ' b9 s$ j$ |- E3 U/ E) R/ O$ w7 V6 I
11251.                (if ewidth
       
11252.                    (command "_.pedit" ename "_W" ewidth "_x")
       
11253.                );if
       
11254.                (if eelevation
       / f$ W! p; y6 E
11255.                    (progn
       
11256.                     (setq p2 (list 0.0 0.0 eelevation));setq
       
11257.                     (if (equal (cdr (assoc 0 elist)) "POLYLINE")
       * |7 [. L1 _  g5 |. n
11258.                         (setq p1 (list 0.0 0.0
       0 ^2 u8 ]$ ^4 E( x
11259.                                        (caddr (cdr (assoc 10 elist)))
       + e4 R; l3 k  {8 r0 r
11260.                                  );list
       
11261.                         );setq
       
11262.                         (progn
       . ^9 M5 q7 v0 V, h8 O- @
11263.                          (if (assoc 38 elist)
       
11264.                              (setq p1 (list 0.0 0.0
       
11265.                                             (cdr (assoc 38 elist))
       
11266.                                       );list
       , [9 d8 N% c4 j! d& a- i
11267.                              );setq
       1 O, [+ n' K3 h/ d& m9 V8 @
11268.                              (setq p1 '(0.0 0.0 0.0))
       $ A# x3 C8 Z9 t- I8 J1 I- t* I  r4 V
11269.                          );if
       
11270.                         );progn
       . K( S* C& T; g# n
11271.                     );if
       8 a4 C1 |, _' m5 X5 B) ^
11272.                     (command "_.move" ename "" p1 p2)
       
11273.                    );progn then change the elevation of the polyline
       
11274.                );if
       
11275.                (command "_.ucs" "_p")
       
11276.                (setq ss-index (1+ ss-index))
       $ I, p/ X- o- |" g/ D+ X
11277.              );while
       : R6 X3 S1 Z& o/ P* o
11278.            );progn then polylines are in the selset
       4 K, |4 q, }/ S  C
11279.          );if
       6 |9 k% {" t& v8 |, {0 z
11280.          (if (and (= 2 (logand 2 eflag))     ; text
       + P0 V5 r8 B* B- N, ^/ n# R! g, R" D! U
11281.                   (or eheight
       
11282.                       estyle
       % V3 m4 j' Q. P- ^1 }+ J
11283.                   );or
       ) _8 A  w) O& I- z8 R; @( T
11284.              );and
       
11285.              (progn
       - Z; k* P# w# S1 H
11286.               (setq ss-index 0 ss-length (sslength txt_ss))
       " x: {( e- h$ N( X
11287.               (while
       $ a7 z. F- F7 `6 c
11288.                 (< ss-index ss-length)
       . v, x9 w( h3 j% w* K" z
11289.                 (setq elist (entget (setq ename (ssname txt_ss ss-index))))
       
11290.                 (if (numberp eheight)
       . p" ?, Y- J  r- e1 _; R
11291.                     (setq elist (subst (cons 40 eheight)
       + O: x) R9 `4 l" B/ o$ B1 {
11292.                                        (assoc 40 elist)
       + R5 \4 E% l5 x' w* e
11293.                                        elist
       
11294.                                 );subst
       % p' {9 h& j6 r- C
11295.                     );setq
       
11296.                 );if
       2 B* \: x- z: E
11297.                 (if (and estyle ;(not (equal estyle ""))
       2 X5 |; R) F  [! I8 y
11298.                          (not (equal estyle (cdr (assoc 7 elist))))
         R* P2 ^4 c+ k$ E0 |
11299.                     );and
       , ^) I( g; ^$ B& W! x4 g* E, G; L
11300.                     (progn  
       
11301.                      ;rk. This needs to be implemented as per mtext font issue in                                                                                                          ;    ddchprop_notes.txt
       " p, U9 C2 ]5 i! t/ Z
11302.                      ;(if (equal "MTEXT" (cdr (assoc 0 elist)))
       
11303.                      ;    (setq elist (fix_mtext_fonts estyle
       
11304.                      ;                                 elist
       
11305.                      ;                )
       " M! y( `. \/ j; u# _
11306.                      ;    );setq then
       - p+ |. r$ B% P1 W. y' l# k, k
11307.                          (setq elist (subst (cons 7 estyle)
       
11308.                                             (assoc 7 elist)
       
11309.                                             elist
       ) h' j2 S! J  u
11310.                                       );subst
       : i% M- D, w' G2 u8 d
11311.                          );setq else
       / A5 s# J; a8 o7 w1 K
11312.                      ;);if
       % p; J9 [) E  G* v: k8 Z" J
11313.                     );progn
       
11314.                 );if
       % l1 ~4 E5 v& V- T0 }4 T/ \5 W
11315.                 (entmod elist)
       
11316.                 (setq ss-index (1+ ss-index))
       / L8 e& z" ^5 m0 F9 A/ F+ E; a
11317.               );while
       
11318.              );progn then
       
11319.          );if
       ( h6 d/ n$ ^8 `9 G3 _
11320. 
       
11321.         (setq cmdact (getvar "cmdactive"))
       $ n+ F5 p) ], ^
11322.         (command "_.chprop" ss "")
       5 O% A$ v3 H$ K" y' w8 }; k
11323.         (if (/= cmdact (getvar "cmdactive"))  ; Is CHPROP actually running?
       
11324.           (progn
       # i# W6 ~$ k# L; _
11325.             (if ecolor
       ! ^  q0 w- D3 Q. x
11326.                 (progn
       6 k$ i5 D. q3 Q1 {: b
11327.                  (if (= 0 ecolor)   (setq ecolor ;|MSG0|;"BYBLOCK"))
       
11328.                  (if (= 256 ecolor) (setq ecolor ;|MSG0|;"BYLAYER"))
       
11329.                  (command "_c" ecolor)
       4 w! Y5 A* L: o$ M- o
11330.                 );progn then
       $ x3 G* x, G1 t
11331.             )
       , z! f& }0 \0 T4 y3 J& J/ Y- i
11332.             (if (and lt-idx
       , M: n/ z- m1 e8 y
11333.                      (/= eltype ;|MSG0|;"Varies")
       6 e' G  D& O' I+ \3 t4 ]
11334.                 )
       : _( G# F. P! Y: b1 I
11335.                 (command "_lt" eltype)
       
11336.             )
       $ Y0 g! ^+ E2 M8 k' U- ~% m
11337.             (if (and lay-idx
       + F) e- W. ~) y  K3 x+ D
11338.                      (/= elayer ;|MSG0|;"Varies")
       
11339.                 )
       2 k: N# o8 }2 k6 v& `' |' r
11340.                 (command "_la" elayer)
       
11341.             )
       , p- z9 L9 K1 X' O5 G$ s. Z
11342.             (if (and ethickness
       
11343.                      (/= ethickness "")
       9 L6 O- n# u- `6 A, Q1 Y$ @" B1 W5 N
11344.                      (/= ethickness "Varies")
       : C6 p$ B6 y: ^( f# {
11345.                 )
       8 |( d( G' h* V) t3 J( |' v* V
11346.                 (command "_t" ethickness)
       
11347.             )
       
11348.             (if (and  eltscale (/= eltscale ""))
       
11349.                 (command "_lts" eltscale)
       % D, O% _1 H4 Y
11350.             );if
       ) ^; G6 x' q  R. c
11351.             (command "")
       & ~( @/ T/ _+ s6 L2 z+ {
11352.           )
       7 j  g  A. S, V3 }/ ^
11353.           (princ "\nProperties unchanged")  ; CHPROP didn't like our SS set
       
11354.         )
       ; v# j7 o' H! O! \" t+ e
11355. 
       $ T2 F' B7 k9 O5 o
11356.       );progn then OK was picked in the dialog.
       & _  Q3 t6 l4 t/ a& d3 \
11357.       
       
11358.       ;; Fred GERBER - 25-AUG-94
       1 o* z# h4 Q( G9 f0 E0 F: E
11359.       ;; Don't print the "Properties unchanged" message when the user cancels
       ) d! }/ s8 A" z1 m( P+ B
11360.       ;; the dialog because he knows that already (otherwise he would have
       
11361.       ;; hit the "OK" button). Display the message only if CHPROP fails for
       
11362.       ;; some reason, because it is not the expected behavior of the command.
       
11363.       ;;
       / T& _* L- s, ~7 i
11364.       ;; (princ ;|DDCHPROP2_LSP_8|;"\nProperties unchanged")
       2 @5 N9 u( T7 n
11365.     );if
       
11366.     (princ)
       3 t! n) m6 o3 X
11367.   );defun call_chp2
       # m, A) C! r9 a: c  [/ x2 x
11368.   ;;
       
11369.   ;; Function to set the Color text tile and swab to the current color value.
       , H1 c9 O/ |4 ?" R' S" p% X1 R
11370.   ;;
       
11371.   (defun set_col_tile()
       
11372.     (cond
       
11373.       ((= ecolor nil)
       " Z' j. I6 ^# _& C8 \
11374.         (set_tile "t_color" "Varies")
       
11375.         (col_tile "show_image" 0 nil)
       ) f0 k7 j# t! u
11376.       )
       
11377.       ((= ecolor 0)
       
11378.         (set_tile "t_color" "BYBLOCK")
       
11379.         (col_tile "show_image" 7 nil)    ; show BYBLOCK as white
       ! i( u- p* R5 w% D4 E* d& V# X
11380.       )
       9 }7 H, B! B8 z/ m- A& X1 s
11381.       ((= ecolor 1)
       ( q- K7 @9 R3 x# l  ^: J: b" c" S
11382.         (set_tile "t_color" "1 red")
       
11383.         (col_tile "show_image" 1 nil)
       # U5 Y/ ^! B! ]6 t% C' b  e! t4 \# }
11384.       )
       
11385.       ((= ecolor 2)
       
11386.         (set_tile "t_color" "2 yellow")
       
11387.         (col_tile "show_image" 2 nil)
       & I/ c5 J4 r% n, {8 s
11388.       )
       
11389.       ((= ecolor 3)
       
11390.         (set_tile "t_color" "3 green")
       
11391.         (col_tile "show_image" 3 nil)
       
11392.       )
       
11393.       ((= ecolor 4)
       . X$ h( `" R; r6 t, s" N. r
11394.         (set_tile "t_color" "4 cyan")
       0 {6 j" Z! T! v: v* G2 j
11395.         (col_tile "show_image" 4 nil)
       - F, P4 \: q0 o
11396.       )
       
11397.       ((= ecolor 5)
       
11398.         (set_tile "t_color" "5 blue")
       
11399.         (col_tile "show_image" 5 nil)
       
11400.       )
       3 y# S7 a5 K" X0 k9 y
11401.       ((= ecolor 6)
       + V4 A$ e& s% T: u
11402.         (set_tile "t_color" "6 magenta")
       , Y0 |: v) [& B
11403.         (col_tile "show_image" 6 nil)
       ! l+ X7 s& A0 }  f3 l4 i
11404.       )
       
11405.       ((= ecolor 7)
       3 `4 ]- b  T' x/ D4 I% W3 C$ A
11406.         (set_tile "t_color" "7 white")
       . Y$ H5 q' T3 F( a9 A, L
11407.         (col_tile "show_image" 7 nil)
       
11408.       )
       $ H& G, V, I: r+ ?
11409.       ;; If the color is "BYLAYER", then set the tile to
       
11410.       ;; show it's set By layer, but also indicate the
       ! l/ s2 |/ `2 _
11411.       ;; color of the layer - i.e. By layer (red)
       
11412.       ((= ecolor 256)
       
11413.         (set_tile "t_color" (bylayer_col))
       
11414.         (col_tile "show_image" cn nil)
       
11415.       )
       
11416.       (T
       9 L: T+ r0 {, I
11417.         (set_tile "t_color" (itoa ecolor))
       4 C7 u6 n! @' p" J% Q0 q
11418.         (col_tile "show_image" ecolor nil)
       
11419.       )
       * [1 p+ K3 g2 t3 S- }
11420.     )
       
11421.   )
       : X# l+ J* z6 a& B1 a7 l* b8 t: G
11422.   ;;
       
11423.   ;;  Function to put up the standard color dialogue.
       
11424.   ;;
       * n4 f& Z8 l) H6 r
11425.   (defun getcolor(/ col_def lay_clr temp_color)
       $ Z/ x- q+ f2 }
11426.     ;; col_def is the default color used when rq_color is called.  If ecolor
       : P2 O* p+ i; D
11427.     ;; is nil (varies) then set it to 1, else use the value of ecolor.
       
11428.     (if ecolor
       
11429.       (setq col_def ecolor)
       ) J! r! C) D! Q! {- Y
11430.       (setq col_def 1)
       
11431.     )
       9 ]; i9 e  e& }4 Y; M' K. Z/ A& i
11432. 
       ' r8 l7 h1 C3 R4 d# m& I
11433.     ;; If we're working with a single layer, get its color
       
11434.     ;; for use in the color swatch if the user selects color BYLAYER.
       7 d% g) B# S: u( F- N
11435.     (if (/= elayer ;|MSG0|;"Varies")
       * y) @8 A" {; n! L
11436.       (setq lay_clr (cdr (assoc 62 (tblsearch "layer" elayer))))
       ' w' D$ ^8 D0 M: S* X; K+ y. ]
11437.       (setq lay_clr 0)
       & s/ ?8 e$ s$ G  X: [
11438.     )
       1 v6 L9 X' G: Y/ P7 N' P
11439.     (if (numberp (setq temp_color (acad_colordlg col_def T lay_clr)))
       7 j* `7 h5 \3 I3 r( p* S0 \3 E
11440.       (progn
       
11441.         (setq ecolor temp_color)
       - J4 S; h. `& F# q3 {% O& o
11442.         (set_col_tile)
       8 A2 C# U$ {1 g0 ^9 P# T. o4 h
11443.         ecolor
       6 N& g. F- z# s6 Z0 J+ G: x
11444.       )
       
11445.       ecolor
       
11446.     )
       3 n& q9 p0 Q* R  G8 O
11447.   )
       
11448.   ;;
       5 b: }9 Q: S- c' I( C
11449.   ;; This function pops a dialogue box consisting of a list box, image tile,
       
11450.   ;; and edit box to allow the user to select or type a linetype.  It returns
       7 z2 X$ T' f, {) d
11451.   ;; the linetype selected.
       0 s* t' t& O7 j5 i6 b- f
11452.   ;;
       
11453.   (defun getltype (/ old-idx ltname)
       ' R3 n! e' h  M  v1 N
11454.     ;; Initialize a dialogue from dialogue file
       7 {9 w9 Y4 c! n$ b
11455.     (if (not (new_dialog "setltype" dcl_id)) (exit))
       - @2 m6 i) `" R7 u8 a
11456.     (start_list "list_lt")
       , l- Z5 g. T# H- j5 S: \; E2 a8 {
11457.     (mapcar 'add_list ltnmlst)         ; initialize list box
       7 V8 h- i4 R( j# U1 c
11458.     (end_list)
         |( w8 d6 Q) T$ f; C$ f
11459.     (setq old-idx lt-idx)
       + T0 T" N4 ?, j4 X  N! v
11460.     ;; Show initial ltype in image tile, list box, and edit box
       
11461.     (if (/= lt-idx nil)
       ; [( x: ~# S- ^; U  t
11462.         (ltlist_act (itoa lt-idx))
       + r6 L7 w' b3 a& F- A4 i- ~
11463.         (progn
       
11464.          (set_tile "edit_lt" "")
       : g4 p" v& l1 j3 ?- ^
11465.          (col_tile "show_image" 0 nil)
       
11466.         );progn else
       
11467.     );if
       7 T4 [& O2 L9 L4 Y$ H& B
11468.     (action_tile "list_lt" "(ltlist_act $value)")
       
11469.     (action_tile "edit_lt" "(ltedit_act)")
       4 w) p& F0 e# G  V0 y
11470.     (action_tile "accept" "(test-ok)")
         ^7 P) w# k4 u' ?: p- g
11471.     (action_tile "cancel" "(reset-lt)")
       
11472.     (if (= (start_dialog) 1)           ; User pressed OK
       - U0 `& m1 ^0 B' h
11473.         (cond
       6 Z& H* \) F  y: Y6 J. g9 @% J
11474.          ((or (= lt-idx nil)
       , f/ e9 `4 O$ c: u1 G
11475.               (= lt-idx (1- (length ltnmlst)))
       
11476.           );or
       : n+ v+ N9 n( K; Z' s: N) d% Z7 ]" m
11477.           (set_tile "t_ltype" "Varies")
       
11478.           ;|MSG0|;"Varies"
       5 m% @; b2 r0 s) t" O) ^
11479.          )
       9 |# h4 o  S0 h! i7 z5 P
11480.          ((= lt-idx 0)
       
11481.           (set_tile "t_ltype" (bylayer_lt))
       ; w& |# J& C' R; o- a/ `' s% B2 |
11482.            ;|MSG0|;"BYLAYER"
       0 k) z' Y* t) B! P, V& \/ L
11483.          )
       
11484.          ((= lt-idx 1)
       
11485.            (set_tile "t_ltype" "BYBLOCK")
       . X! E4 a7 W/ W* L
11486.            ;|MSG0|;"BYBLOCK"
       ' R- V$ D* ?+ o9 E9 r& B
11487.          )
       
11488.          (T
       ) m: o* z  J7 h$ z
11489.            (set_tile "t_ltype" ltname)
       
11490.            ltname
       2 u; _3 S5 R. c  u, M- B; ]
11491.          )
       ( V4 F4 V) Q9 D; z0 R& q( J
11492.         );cond then
       
11493.         eltype
       * k: n$ H% H! e2 F9 o
11494.     );if
       
11495.   );defun
       5 f& I: F- c  w
11496.   ;;
       
11497.   ;; Edit box entries end up here
       / v* b$ r" w2 e; m. M2 p
11498.   ;;
       
11499.   (defun ltedit_act ( / flag)
       5 M  b2 A9 J' a1 X0 e
11500.     ;; If linetype name,is valid, then clear error string,
       
11501.     ;; call ltlist_act function, and change focus to list box.
       ! m; F' _- F2 z7 X5 E8 g* ]
11502.     ;; Else print error message.
       
11503.    
       
11504.     (setq ltvalue (xstrcase (get_tile "edit_lt")))
       ) n0 K: Z$ ~, e/ {9 T( c6 Z( p
11505.     (if (or (= ltvalue ;|MSG0|;"BYLAYER")
       
11506.             (= ltvalue "BY LAYER")
       ! H' [7 x- a! g+ r6 h4 b) J
11507.         )
       
11508.         (setq ltvalue "BYLAYER")
       
11509.     )
       # s! Y3 F# E3 ^
11510.     (if (or (= ltvalue ;|MSG0|;"BYBLOCK")
       
11511.             (= ltvalue "BY BLOCK")
       
11512.         )
       
11513.         (setq ltvalue "BYBLOCK")
       
11514.     )
       ' Q! n/ n# w1 G0 T; k) v
11515.     (if (setq lt-idx (getindex ltvalue ltnmlst))
       / S% N" [- h% ~8 `5 Z' W$ a1 v  j
11516.         (progn
       - ?7 }, ?" B6 }' ^  h2 R
11517.          (set_tile "error" "")
       ' @  x9 f% m& s: Q
11518.          (ltlist_act (itoa lt-idx))
       
11519.          ;(mode_tile "list_lt" 2)
       " I: _8 k9 i' C# r$ V
11520.         );progn then
       
11521.         (progn
       
11522.          (if (/= ltvalue "")
       
11523.              (progn
       6 n# ~# `* g  E% z5 x: b
11524.                (set_tile "error" "Invalid linetype.")
       - b7 Q# r5 C  w+ I
11525.                (setq flag T)
       % x. w- Q$ C4 m
11526.              );progn
       0 C8 \: ]7 c8 h1 D6 B  l# ~. @
11527.          )
       - |5 N& b$ R7 W) K9 ?2 B( p* J5 p' E
11528.          (setq lt-idx old-idx)
       
11529.         );progn else
       
11530.     );if
       
11531.     (if (and (not flag) ;added so a return will take you out of the dialog.
         Y+ _( ?. ~- r9 L! b, @
11532.              (= $reason 1)
       0 Q% j$ A" j$ k# w
11533.         );and
       
11534.         (done_dialog 1)
       $ B4 j# Q+ H4 n6 B% m+ C( I
11535.     );if
       
11536.   );defun ltedit_act
       
11537.   ;;
       # w  @( v2 ^9 q1 c& y' r
11538.   ;; List selections end up here
       - o' n2 s+ r( G1 U; b; h
11539.   ;;
       * s2 ]3 \: h7 q" O  J$ P- j4 I& P
11540.   (defun ltlist_act (index / dashdata)
       $ M+ }& d/ }2 }, ^- D$ K3 f
11541.     ;; Update the list box, edit box, and color tile
       
11542.     (set_tile "error" "")
       
11543.     (setq lt-idx (atoi index))
       , J7 e' `# i' ~/ z5 ?3 p9 w
11544.     (setq ltname (nth lt-idx ltnmlst))
       3 x( H+ z+ Z  f
11545.     (setq dashdata (nth lt-idx mdashlist))
       
11546.     (col_tile "show_image" 0 dashdata)
       
11547.     (set_tile "list_lt" (itoa lt-idx))
       
11548.     (set_tile "edit_lt" ltname)
         b: p; p1 l% R" n
11549.   )
       
11550.   ;;
       
11551.   ;; Reset to original linetype when cancel it selected
       ! C* ~# H3 M& V( h3 q+ d
11552.   ;;
       1 M: @- O% j' C" |% |3 H* q/ [
11553.   (defun reset-lt ()
       
11554.     (setq lt-idx old-idx)
       . C1 d6 m) U9 [9 |
11555.     (done_dialog 0)
       
11556.   )
       % l; O3 Z% u2 ^( @, ?
11557.   ;;
       
11558.   ;; This function pops a dialogue box consisting of a list box and edit box to
       
11559.   ;; allow the user to select or type a layer name.  It returns the layer name
       # V; o% n' l' ]/ D
11560.   ;; selected.  It also the status (On, Off, Frozen, etc.) of all layer in the
       ' o. c+ }9 f( V6 V: p* ^% F# }
11561.   ;; drawing.
       
11562.   ;;
       
11563.   (defun getlayer (/ old-idx layname on off frozth linetype colname)
       6 M2 W, t* m- l. a' l( Z
11564.     ;; Create layer list the first time the layer
       
11565.     ;; dialogue is called.
       . O2 d2 H! N: x4 K: V: k# c% I! w  x
11566.     (if (not lay-idx)
       0 d( f4 E8 \" s8 i( s- s3 a9 c
11567.         (progn
       
11568.          (makelaylists)                     ; layer list - laynmlst
       
11569.          ;rk
       ) k& P3 X) U+ Z- g2 T# K
11570.          (setq lay-idx (getindex elayer laynmlst))
       ! v( ?9 c" @. u% m9 X$ p2 J
11571.         );progn
       4 C% T: `3 s5 Q" }1 ~( ~5 ^: }6 c
11572.     );if
       
11573. 
       0 n/ o* ?3 Z2 q8 c
11574.     ;; Load a dialogue from dialogue file
       
11575.     (if (not (new_dialog "setlayer" dcl_id)) (exit))
       
11576.     (start_list "list_lay")
       ( l$ l8 u0 r4 B# o9 }
11577.     (mapcar 'add_list longlist)        ; initialize list box
       
11578.     (end_list)
       , s2 _9 x' l2 p
11579.     ;; Display current layer, show initial layer name in edit
       ; i2 X2 c+ [- i8 y9 j2 \
11580.     ;; box, and highlight list box.
       
11581.     (setq old-idx lay-idx)
       & N; h% n9 s# @" N( m
11582.     (if (/= lay-idx nil) (laylist_act (itoa lay-idx)))
       
11583.     (set_tile "cur_layer" (getvar "clayer"))
       
11584.     (action_tile "list_lay" "(laylist_act $value)")
       # ]* p. T6 ~) r5 i+ P
11585.     (action_tile "edit_lay" "(layedit_act)")
       
11586.     (action_tile "accept" "(test-ok)")
       
11587.     (action_tile "cancel" "(reset-lay)")
       + y; s0 r: {- ]( O3 j$ Q
11588.     (if (= (start_dialog) 1)           ; User pressed OK
       
11589.        (progn
       
11590.          (if (or (= lay-idx nil)
       
11591.                  (= lay-idx (1- (length laynmlst)))
       
11592.              );or
       7 z0 i' q  Y5 n4 G7 ^( s
11593.              (progn
       
11594.               (setq lay-idx nil)  
       
11595.               (setq layname ;|MSG0|;"VARIES")
       
11596.               (set_tile "t_layer" "Varies")
       
11597.               (setq layname "")
       
11598.              );progn
       
11599.              (set_tile "t_layer" layname)
       
11600.          );if
       
11601.          ; If layer or ltype equals bylayer reset their tiles
       
11602.          (if (= lt-idx 0)
       0 `  M8 _8 }4 F6 t+ A1 |# |$ o: I
11603.              (set_tile "t_ltype" (bylayer_lt))
       
11604.          );if
       
11605.          (if (= ecolor 256)
       
11606.              (progn
       
11607.               (set_tile "t_color" (bylayer_col))
       ) ]7 W/ b6 _$ q# F+ }' K
11608.               (col_tile "show_image" cn nil)
       
11609.              )
       $ P& x3 E8 o$ T9 b* U4 I" k& B# V/ o
11610.          );if
       
11611.          layname
       2 B' t+ c! ^8 v( M
11612.        );progn
       
11613.        elayer
       
11614.     );if
       
11615.   )
       
11616.   ;;
       1 g  O# Q, x5 ?! y
11617.   ;; Edit box selections end up here
       
11618.   ;;
       
11619.   (defun layedit_act()
       $ t7 Q0 c$ W9 y( r5 g# r8 ~
11620.     ;; Convert layer entry to upper case.  If layer name is
       
11621.     ;; valid, clear error string, call (laylist_act) function,
       
11622.     ;; and change focus to list box.  Else print error message.
       ! ?4 J& W" H( _+ O$ N+ c) c
11623.     (setq layvalue (xstrcase (get_tile "edit_lay")))
       
11624.     (if (setq lay-idx (getindex layvalue laynmlst))
       4 V1 S- Z6 a4 m1 }* m5 V& h
11625.         (progn
       
11626.          (set_tile "error" "")
       * C/ \% i* O3 C' |) Q' I
11627.          (laylist_act (itoa lay-idx))
       
11628.         )
       ' `) E, m3 M) ^
11629.         (progn
       
11630.          (set_tile "error" "Invalid layer name.")
       9 G* g+ a# m5 b* Y( F9 a4 |
11631.          (mode_tile "edit_lay" 2)
       
11632.          (setq lay-idx old-idx)
       ; R$ W: U" a# C6 K4 O; S  N1 l
11633.         )
       ) e+ F  J. ?( ]/ e. S5 f* F$ d
11634.     );if
       
11635.   );defun
         x& h" u( Y! Y; U) _$ |
11636.   ;;
       
11637.   ;; List entry selections end up here
       
11638.   ;;
       1 ]& Q% b2 a" J. K" q7 o1 i% m
11639.   (defun laylist_act (index / layinfo color dashdata)
       
11640.     ;; Update the list box, edit box, and color tile
       
11641.     (set_tile "error" "")
       
11642.     (setq lay-idx (atoi index))
       8 i% {; ?0 F" F) h
11643.     (if (not (equal lay-idx (1- (length laynmlst))))
       
11644.         (progn
       ' V( d' I" s) z7 k- m( Z9 U& y
11645.          (setq layname (nth lay-idx laynmlst))
       
11646.          (setq layinfo (tblsearch "layer" layname))
       & k! r0 ]  S- d- u% S% X% ~
11647.          (setq color (cdr (assoc 62 layinfo)))
       # S& e/ Z, r/ ?
11648.          (setq color (abs color))
       ( K; U: C& `) r
11649.          (setq colname (colorname color))
       
11650.          (set_tile "list_lay" (itoa lay-idx))
       ; j3 @" |7 ^: _
11651.          (set_tile "edit_lay" layname)
       
11652.          ;(mode_tile "list_lay" 2)
       
11653.         );progn then
       1 H) a! Y/ u0 m7 F$ t
11654.         (set_tile "edit_lay" "")
       * |% {2 g" g, }# Y6 V  {
11655.     );if
       
11656.   );defun laylist_act
       & j, n& ?2 d# a7 o* I* q
11657.   ;;
       ( M  A  t# m' r. ]( ~% \0 j
11658.   ;; Reset to original layer when cancel is selected
       $ q; q4 q' X) ~1 o9 y' A
11659.   ;;
       5 {+ P9 m  q* X, c
11660.   (defun reset-lay ()
       
11661.     (setq lay-idx old-idx)
       
11662.     (done_dialog 0)
       
11663.   )
       
11664. 
       
11665.   ;; Checks validity of linetype scale from edit box.  It checks to
       
11666.   ;; see if the value equals "Varies".
       3 x& m7 b% A- E- ~# I# C, L5 r
11667. 
       
11668.   (defun getscale (value / rval)
       * c/ N8 e' ~# q$ S. K. W1 x
11669.     (setq value (strcase value)
       # j; A* \9 v3 T
11670.            rval (distof value)
       7 l$ |" Y6 T6 ^* h% Z8 Z! T+ q
11671.     );setq
       
11672.     (if (or (= value "")
       0 m+ \7 V) s% k/ t/ S) F; [4 |
11673.             (> rval 0.0)
       2 W$ d5 c. f; i" Z1 d
11674.         )
       
11675.         (progn
       / r/ k3 v7 S: X$ N" ?; K, z  Y% E
11676.           (set_tile "error" "")
       
11677.           (if (= value "")
       
11678.               (progn
       5 G$ R' b! L3 M! S& w  q
11679.                (set_tile "eb_ltscale" "")
       
11680.                (setq eltscale nil)
       
11681.               );progn then
       
11682.               (progn
       : p" }3 g1 O# Z6 I9 Z
11683.                (setq eltscale (distof value))
       # n! {! }+ U% V( G# {! Y
11684.                (set_tile "eb_ltscale" (ai_rtos eltscale))
       
11685.                eltscale
       
11686.               );progn else
       
11687.           );if
       4 T# E% ^* j/ Y% i2 q
11688.         );progn
       2 w0 ?: P8 U& f: l  x) b
11689.         (progn
       
11690.          (set_tile "error" "Invalid ltscale.")
       - t! w2 G8 n; {/ I
11691.          nil
       0 m, d9 o! _9 n0 I) O4 w$ g! m
11692.         );progn else
       
11693.     );if
       
11694.   );defun
       6 ?8 U) Z' B: j/ L. [$ V# J& x3 I
11695.   ;;
       
11696.   ;; Checks validity of thickness from edit box. Since (atof) returns 0 when a
       
11697.   ;; string can't be converted to a real, this routine checks if the first
       / f, b2 q& W4 b) f
11698.   ;; character is "0".  It also checks to see if the value equals "Varies".
       
11699.   ;;
       
11700.   (defun getthickness (value)
       ; @7 t# `. f5 U$ F
11701.     (setq value (strcase value))
       - Y/ F3 o% e: `. P" _$ B* ]
11702.     (if (or (= value "")
       
11703.             (distof value)
       : Z1 C) O8 ?1 w) _
11704.         );or
       " w; T& N# z1 @! I
11705.         (progn
       / q8 a+ r2 F8 t& z# K4 v% G
11706.          (set_tile "error" "")
       
11707.          (if (= value "")
       
11708.              (progn
       + L: x' V6 F6 N( F! D
11709.               (set_tile "eb_thickness" "")
       5 ?4 H" b/ F! u" m9 Y
11710.               (setq ethickness nil)
       
11711.              );progn
       , F" Y. j+ O( v, p6 u3 O1 K/ S
11712.              (progn
       
11713.               (setq ethickness (distof value))
       
11714.               (set_tile "eb_thickness" (ai_rtos ethickness))
       & j9 l! h! C2 b0 G* S
11715.               ethickness
       . h" g. R0 G* u% C
11716.              );progn
       
11717.          );if
       
11718.         );progn
       
11719.         (progn
       * M0 m' J; G! y$ U, @" q" [
11720.           (set_tile "error" "Invalid thickness.")
       
11721.           nil
       
11722.         );progn
       
11723.     );if
       % N* s0 [3 p% F- Z8 L4 M
11724.   );defun
       6 g- a( F. ~' s0 X- \( k& Q% {
11725.   ;;
       ( j1 t% e/ T% I- n
11726.   ;; Checks validity of polyline elevation from edit box.
       
11727.   ;;
       2 c' r6 q; @- H* E, j* v! p
11728.   (defun getelevation (value)
       
11729.     (setq value (strcase value))
       + U' X1 i4 P1 m  g5 t+ @
11730.     (if (or (= value "")
         z: E, o$ U" _- V
11731.             (distof value)
       
11732.         )
       
11733.         (progn
       
11734.          (set_tile "error" "")
       : \( X3 y8 L/ C% f9 I" J/ X" w
11735.          (if (= value "")
       # O4 n4 a! u4 W' m6 f0 v2 S' q
11736.              (progn
       
11737.               (set_tile "poly_elev" "")
       * f9 W5 a+ S3 z8 w
11738.               (setq eelevation nil)
       
11739.              );progn
       
11740.              (progn
       
11741.               (setq eelevation (distof value))
       ( r5 V0 N5 @! A6 r
11742.               (set_tile "poly_elev" (ai_rtos eelevation))
       " W: B2 i. Q, M& `+ W  H
11743.               eelevation
       
11744.              );progn
       % @& Z( S- l: F7 {  F( J! D" i7 M
11745.          );if
       ! A/ a0 ~4 P3 k% W0 B, y6 i" R
11746.         );progn
       
11747.         (progn
       * @/ o$ S- ~9 ?, ^
11748.          (set_tile "error" "Invalid elevation.")
       
11749.          nil
       
11750.         );progn
       
11751.     );if
       
11752.   );defun
       
11753.   ;;
       
11754.   ;; Checks validity of polyline width from edit box.
       
11755.   ;;
       
11756.   (defun getwidth (value / rval)
       ' @! j- N; J+ A, S$ c( K* n; D
11757.     (setq value (strcase value)
       0 _% e0 B* v; N- j
11758.            rval (distof value)
       2 w. a, A5 _. Y6 f0 t7 b5 G- ~
11759.     )
       ' Y& A1 @+ x5 T) ~+ y! [- t
11760.     (if (or (= value "")
       2 ^' _# Q( J$ b# ?& l0 b5 l4 w; `
11761.             (>= rval 0.0)
       
11762.         )
       ' ]2 `) O' G' K% P5 T5 Q
11763.         (progn
       
11764.          (set_tile "error" "")
       
11765.          (if (= value "")
       & u' p. I- g+ }5 `* n) x
11766.              (progn
       
11767.               (set_tile "poly_wid" "")
       
11768.               (setq ewidth nil)
       
11769.              );progn
       
11770.              (progn
       
11771.               (setq ewidth (distof value))
       7 r1 D; z. ~# o* F( u
11772.               (set_tile "poly_wid" (ai_rtos ewidth))
       . l+ a; L4 O9 @0 c5 ]1 K
11773.               ;width
       
11774.              );progn
       0 q8 l) Z9 {5 }6 d7 s" Z
11775.          );if
       
11776.         );progn
       
11777.         (progn
       
11778.          (set_tile "error" "Invalid width.")
       ! g6 j- Y! m7 H1 b8 S# B
11779.          ;(setq ewidth nil)
       % i* w2 p# u3 x
11780.          nil
       ) \2 R+ p, E2 v+ k; F
11781.         );progn
       
11782.     );if
       
11783.   );defun
       
11784.   ;;
       5 K" G2 H7 M+ Z8 i. k
11785.   ;; Checks validity of text height from edit box.
       
11786.   ;;
       ! e: {7 _8 Z  A' ^- K/ Q7 h+ B, B
11787.   (defun getheight (value / rval)
       
11788.     (setq value (strcase value)
       
11789.            rval (distof value)
       
11790.     )
       
11791.     (if (or (= value "")
       
11792.             (> rval 0.0)
       
11793.         )
       3 i3 T4 m& ]1 H- ^
11794.         (progn
       : z+ M9 j* M% \9 o9 P' M, {: R$ S  ]
11795.          (set_tile "error" "")
       8 U- u6 F4 Z' S% S3 Y
11796.          (if (= value "")
       
11797.              (progn
       0 S6 g0 r" @9 n! B5 `
11798.               (set_tile "text_hgt" "")
       
11799.               (setq eheight nil)
       + _8 m, G# F% C1 O) W' \: f1 f
11800.              );progn
       . u+ E2 J' |( R4 Z# T
11801.              (progn
       0 ^6 z) G: l( l7 ]" I& L6 E) Q
11802.               (setq eheight (distof value))
       
11803.               (set_tile "text_hgt" (ai_rtos eheight))
       
11804.               eheight
       
11805.              );progn
       
11806.          );if
       8 K& }6 ?6 v7 j6 M( y
11807.         );progn
       
11808.         (progn
       
11809.          (set_tile "error" "Invalid height.")
       
11810.          nil
       # S( W- g0 \- ~+ d1 I. |  b  g$ e
11811.         );progn
       
11812.     );if
       
11813.   );defun
       5 Y2 \  z" W/ [" A% o+ _8 x  `
11814. 
       4 S. I! p" Z$ X
11815.   (defun getstyle (value lst / rval)
       , R5 b4 s6 ~7 y9 @. F$ t; |  `
11816.     ;(setq value (strcase value))
       ) G4 \3 \3 B6 R# q4 c6 R- ?( _
11817.     (set_tile "error" "")
       
11818.     (setq estyle (nth (atoi value) lst))
       - y) z+ r+ y; R  s9 `! v# [: l* o3 ?
11819.     (if (equal estyle "")
       
11820.         (setq estyle nil)
       
11821.     );if
       
11822. 
       
11823.   );defun getstyle
       4 N5 m0 ]* w  M7 J/ c
11824. 
         W6 ^1 S4 _/ t9 |
11825.   ;;
       # N) T" a5 L5 Q' i, u/ P" D
11826.   ;; This function make a list called laynmlst which consists of all the layer
       
11827.   ;; names in the drawing.  It also creates a list called longlist which
       
11828.   ;; consists of strings which contain the layer name, color, linetype, etc.
       $ }. R2 G6 ~/ x* `+ k' H
11829.   ;; Longlist is later mapped into the layer listbox.  Both are ordered the
       
11830.   ;; same.
       
11831.   ;;
       
11832.   (defun makelaylists (/ layname onoff frozth color linetype lock vpf vpn ss cvpname
       ' K( n& w. j/ t: _% k5 `1 j, e
11833.                          xdlist vpldata sortlist name templist bit-70
       
11834.                          layer_number
       
11835.                       )
       0 j. d8 ]3 G* c, E" N
11836.     (if (= (setq tilemode (getvar "tilemode")) 0)
       ; G* A3 ^  f" I# c* H* P5 m
11837.       (progn
       ( W6 L, |5 b; d
11838.         (setq ss (ssget "_x" (list (cons 0 "VIEWPORT")
       
11839.                                   (cons 69 (getvar "CVPORT"))
       
11840.                             )
       
11841.                  )
       $ ~4 r1 X- b* M0 }) B2 \
11842.         )
       
11843.         (setq cvpname (ssname ss 0))
       
11844.         (setq xdlist (assoc -3 (entget cvpname '("acad"))))
       # |. {* m, c/ O3 o: N
11845.         (setq vpldata (cdadr xdlist))
       
11846.       )
       9 t. Z( d0 w4 O0 O2 S
11847.     )
       
11848.     (setq sortlist nil)
       
11849.     (setq templist (tblnext "LAYER" T))
       
11850.     (setq layer_number 1)
       , `& M1 |' q# ]# i! `
11851.     (while templist
       0 e: E, A. y- I/ L
11852.       (if (not (equal 16 (logand 16 (cdr (assoc 70 templist)))))
       3 F% i3 C% o9 S3 u( R" `. s+ q2 R
11853.           (progn  
       $ @; ^' t' K# u
11854.            (setq name (cdr (assoc 2 templist)))
       
11855.            (setq sortlist (cons name sortlist))
       . i0 S2 L" u1 y# v
11856.            ;; Not dead message...
       . V  f8 A* b' z/ V# I
11857.            (setq layer_number (1+ layer_number))
       
11858.           );progn
       
11859.       );if
       ' `9 D9 x; g) W, _+ x' L
11860.       (setq templist (tblnext "LAYER"))
       
11861.       (if (= (/ layer_number 50.0) (fix (/ layer_number 50.0)))
       # X8 ]2 s/ `& U/ a
11862.           (set_tile "error" (strcat "Collecting..." (itoa layer_number)))
       
11863.       );if
       4 L7 u, J- S% C# z8 {- y' ^  q
11864.     )
       
11865.     (set_tile "error" "")
       
11866.     (if (>= (getvar "maxsort") (length sortlist))
       1 }4 P, V- |7 q8 R! R
11867.       (progn
       
11868.         (if (> layer_number 50)
       " d. u. \  N9 g2 g' \# |
11869.           (set_tile "error" "Sorting...")
       - {1 w/ m2 j4 B. j- w. ?
11870.         )
       ' p- {2 S. \$ k  a3 ?* F4 Y
11871.         (setq sortlist (acad_strlsort sortlist))
       
11872.       )
       , l# B0 H, i3 e: X1 z# l
11873.       (setq sortlist (reverse sortlist))
       $ Z0 `! ^; t/ F% W6 G" o; k) n
11874.     )
       
11875.     (set_tile "error" "")
       : F% ?) B! d& ~, D
11876.     (setq laynmlst sortlist)
       
11877.     ;rk
       , `9 q! G% ?- ^6 T# L
11878.     (setq laynmlst (append laynmlst (list "")))     
       
11879. 
       
11880.     (setq longlist nil)
       
11881.     (setq layname (car sortlist))
       
11882.     (setq layer_number 1)
       0 p- _  O" b7 g0 l
11883.     (while layname
       
11884.       (if (= (/ layer_number 50.0)
       
11885.              (fix (/ layer_number 50.0))
       
11886.           )
       
11887.           (set_tile "error" (strcat "Analyzing..." (itoa layer_number)))
       
11888.       );if
       6 e3 m3 O) |( m) x
11889.       (setq layer_number (1+ layer_number))
       
11890.       (setq laylist (tblsearch "LAYER" layname))
       9 X1 T. S, i0 b) I5 V% B, P: N
11891.       (setq color (cdr (assoc 62 laylist)))
       5 r. {$ X* ~: V7 s6 j8 E  t
11892.       (if (minusp color)
       " ]: w# m* H6 r# x+ s) [6 g" E) Q" k; ?9 P
11893.         (setq onoff ".")
       
11894.         (setq onoff "On")
       - B% ?2 ^8 R2 k* O/ Z' Y. V
11895.       )
       
11896.       (setq color (abs color))
         {9 H( T) y* |* v+ L
11897.       (setq colname (colorname color))
       
11898.       (setq bit-70 (cdr (assoc 70 laylist)))
       
11899.       (if (= (logand bit-70 1) 1)
       & F: P5 [- \$ v9 N1 X
11900.         (setq frozth "F" fchk laylist)
       
11901.         (setq frozth ".")
       2 H0 |$ x% v7 l% E0 P2 Q: D
11902.       )
       
11903.       (if (= (logand bit-70 2) 2)
       
11904.         (setq vpn "N")
       / U& m& ?+ i, K: r0 @; l) a
11905.         (setq vpn ".")
       . v  J9 F) x" L( d9 }4 G- |$ O
11906.       )
       6 ~1 O% v/ i5 b- a8 U; ]5 E
11907.       (if (= (logand bit-70 4) 4)
       + J/ l- w2 c! Y9 L) Q) D
11908.         (setq lock "L")
       
11909.         (setq lock ".")
       ) X& v* j* t! M' W# V) Z# a
11910.       )
       / |! I7 i/ a/ c7 Z
11911.       (setq linetype (cdr (assoc 6 laylist)))
       
11912.       (setq layname (substr layname 1 31))
       $ f% y6 C1 n. X* ^8 u% K
11913.       (if (= tilemode 0)
       % b; E+ `+ V' k, y% @& l% \
11914.         (progn
       
11915.           (if (member (cons 1003 layname) vpldata)
       2 ]3 ]0 d7 e, Y
11916.             (setq vpf "C")
       
11917.             (setq vpf ".")
       
11918.           )
       
11919.         )
       
11920.         (setq vpf ".")
       / o8 v& E* X: t5 S: d
11921.       )
       
11922.       (setq ltabstr (strcat layname "\t"
       
11923.                               onoff "\t"
       4 n7 o* E1 l1 L8 e# H
11924.                              frozth "\t"
       5 Q5 T9 n2 k, Z  N- c9 }
11925.                                lock "\t"
       
11926.                                 vpf "\t"
       ; F2 l' c" q' y8 q. o0 l
11927.                                 vpn "\t"
       1 q) [- \# H, B: N4 `+ ^4 ^9 J8 `
11928.                             colname "\t"
       8 `- r% Q6 d2 @4 @& X+ U
11929.                            linetype
       
11930.                     )
       8 W$ C; C' n/ H. ?' D6 y  q
11931.       )
       
11932.       (setq longlist (append longlist (list ltabstr)))
       5 f9 V" X# F7 [$ d1 x5 Z
11933.       (setq sortlist (cdr sortlist))
       & L4 L( I0 D( c+ N9 u5 P; J1 N
11934.       (setq layname (car sortlist))
       
11935.     );while
       
11936.     (setq longlist (append longlist (list "")))
       
11937.     (set_tile "error" "")
       
11938.   )
       
11939.   ;;
       5 ?, Z+ e9 |" R0 D
11940.   ;; This function makes 2 lists - ltnmlst & mdashlist.  Ltnmlst is a list of
       / q/ V' D" \2 t! u# V! Q
11941.   ;; linetype names read from the symbol table.  Mdashlist is list consisting
       5 p4 v# d" v- N; r$ \
11942.   ;; of lists which define the linetype pattern - numbers that indicate dots,
       1 ^+ X5 w* D( H/ w5 L- E# m
11943.   ;; dashes, and spaces taken from group code 49.  The list corresponds to the
       6 u) h6 Y1 ~* w% C3 K
11944.   ;; order of names in ltnmlst.
       % d. W. u3 o; M. b$ U1 S
11945.   ;;
       
11946.   (defun makeltlists (/ ltlist ltname)
       9 Y( E2 N: o1 R: Y5 X- H
11947.     (setq mdashlist nil)
       
11948.     (setq ltlist (tblnext "LTYPE" T))
       
11949.     (setq ltname (cdr (assoc 2 ltlist)))
       1 @( p& c- I5 n
11950.     (setq ltnmlst (list ltname))
       
11951.     (while (setq ltlist (tblnext "LTYPE"))
       # P3 Z) l: D5 u7 W; d8 P6 b, `/ O; m
11952.      (if (not (equal 16 (logand 16 (cdr (assoc 70 ltlist)))))
       
11953.          (progn
       
11954.           (setq ltname (cdr (assoc 2 ltlist)))
       
11955.           (setq ltnmlst (append ltnmlst (list ltname)))
       
11956.          );progn
       + \0 j* x8 E$ n' n+ |. h
11957.      );if
       
11958.     );while
       : J8 X; m/ g- |
11959.     (setq ltnmlst (acad_strlsort ltnmlst))
       
11960.     (setq ltnmlst (append ltnmlst (list "")));add by rk
       
11961.     (foreach ltname ltnmlst
       3 S& u$ c1 A" t+ o. a1 b2 j
11962.       (setq ltlist (tblsearch "LTYPE" ltname))
       # ?  v: r- \! y! |" T( h/ |* C
11963.       (if (= ltname "CONTINUOUS")
       
11964.         (setq mdashlist (append mdashlist (list "CONT")))
       " O' a' I% d3 {4 P  b6 D7 N
11965.         (setq mdashlist
       
11966.             (append mdashlist (list (add-mdash ltlist)))
       
11967.         )
       
11968.       )
       
11969.     )
       7 M! h' F2 P7 y# S5 ~
11970.     (setq ltnmlst (cons "BYBLOCK" ltnmlst))
       
11971.     (setq mdashlist  (cons nil mdashlist))
       
11972.     (setq ltnmlst (cons "BYLAYER" ltnmlst))
       
11973.     (setq mdashlist  (cons nil mdashlist))
       
11974.   )
       
11975.   ;;
       # e( u/ @" G& Y+ H
11976.   ;; Get all the group code 49 values for a linetype and put them in a list
       
11977.   ;; (pen-up, pen-down info)
       
11978.   ;;
       
11979.   (defun add-mdash (ltlist1 / dashlist assoclist dashsize)
       
11980.     (setq dashlist nil)
       
11981.     (while (setq assoclist (car ltlist1))
       8 w( w4 z8 n; t# m+ W; `
11982.       (if (= (car assoclist) 49)
       
11983.         (progn
       
11984.           (setq dashsize (cdr assoclist))
       
11985.           (setq dashlist (cons dashsize dashlist))
       
11986.         )
       . J3 a2 v1 r& k
11987.       )
       
11988.       (setq ltlist1 (cdr ltlist1))
       ) A/ n+ ^; d  W
11989.     )
       
11990.     (setq dashlist (reverse dashlist))
       
11991.   )
       7 x/ x+ A  d" u5 v  M! P, e
11992.   ;;
       
11993.   ;; Color a tile, draw linetype, and draw a border around it
       * p  F7 T* `/ \5 d+ P$ O) E
11994.   ;;
       
11995.   (defun col_tile (tile color patlist / x y)
       
11996.     (setq x (dimx_tile tile))
       
11997.     (setq y (dimy_tile tile))
       
11998.     (start_image tile)
       & E$ i% w4 q5 f7 I+ O4 [
11999.     (fill_image 0 0 x y color)
       
12000.     (if (= color 7)
         p' J) d0 ^, n$ U3 c  E9 v
12001.       (progn
       8 X9 s' O0 E8 f
12002.         (if patlist (drawpattern x (/ y 2) patlist 0))
       
12003.         (tile_rect 0 0 x y 0)
       
12004.       )
       + R$ Z' k* m7 u' V/ S! Y9 O" v1 T
12005.       (progn
       ) T; P/ b+ z- Y9 s9 r) u
12006.         (if patlist (drawpattern x (/ y 2) patlist 7))
       
12007.         (tile_rect 0 0 x y 7)
       
12008.       )
       - S4 r; Z2 t/ K, N
12009.     )
       ! x6 M/ l1 T9 C4 r4 r
12010.     (end_image)
       
12011.   )
       6 L9 |6 x! T& X  ~9 Q+ J: M* G
12012.   ;;
       
12013.   ;; Draw a border around a tile
       
12014.   ;;
       + P( z+ L- z. P/ k; x
12015.   (defun tile_rect (x1 y1 x2 y2 color)
       ' {2 R( H% r# n2 l' e
12016.     (setq x2 (- x2 1))
       
12017.     (setq y2 (- y2 1))
       - w1 c) k  N+ A& e2 ^/ h
12018.     (vector_image x1 y1 x2 y1 color)
       
12019.     (vector_image x2 y1 x2 y2 color)
       # }  [, a: h1 @) d1 L
12020.     (vector_image x2 y2 x1 y2 color)
       
12021.     (vector_image x1 y2 x1 y1 color)
       1 m, j8 i0 g' N; o8 R, q) Q- ]5 C  J
12022.   )
       $ {2 g7 v2 O: A6 x) j4 W& {
12023.   ;;
       7 K; K. t: r* h& |  R
12024.   ;; Draw the linetype pattern in a tile.  Boxlength is the length of the image
       
12025.   ;; tile, y2 is the midpoint of the height of the image tile, pattern is a
       
12026.   ;; list of numbers that define the linetype, and color is the color of the
       
12027.   ;; tile.
       ' I6 V0 p/ \6 A, ~* Z, m
12028.   ;;
       3 J4 k' ~, T. v2 g0 o6 L! p$ |
12029.   (defun drawpattern (boxlength y2 pattern color / x1 x2
       
12030.                       patlist dash)
       
12031.     (setq x1 0 x2 0)
       
12032.     (setq patlist pattern)
       
12033.     (setq fx 30)
       
12034.     (if (= patlist "CONT")
       " ]6 }4 y$ Y4 ~: D7 @8 P
12035.       (progn
       
12036.         (setq dash boxlength)
       $ B' ?9 S: W& _. F7 r
12037.         (vi)
       5 _$ X9 j0 v/ d
12038.         (setq x1 boxlength)
       $ W$ Z* Q% r  ~1 v+ c) q
12039.       )
       0 _: g* b! ]9 R7 M+ y
12040.       (foreach dash patlist
       
12041.         (if (> (abs dash) 2.5)
       ) O( w. _  g3 H9 E& g- l
12042.           (setq fx 2)
       
12043.         )
       
12044.       )
       & e0 J, X( N& L+ W" }! d3 g
12045.     )
       3 Q# d4 m3 s. G% h: `5 |9 Y
12046.     (while (< x1 boxlength)
       7 ~& @- U, U9 n( X1 U
12047.       (if (setq dash (car patlist))
       
12048.         (progn
       
12049.           (setq dash (fix (* fx dash)))
       2 Q& \, |9 w1 |. n9 T" ?% \
12050.           (cond
       
12051.             ((= dash 0)
       
12052.               (setq dash 1)
       
12053.               (vi)
       9 y* q. |* u" `* x
12054.             )
       ; z8 A/ j  q7 B5 a
12055.             ((> dash 0)
       
12056.               (vi)
       2 U) h# }2 g- `2 y: W+ ^6 [
12057.             )
       
12058.             (T
       6 a* |" {! G( t2 x' i
12059.               (if (< (abs dash) 2) (setq dash 2))
       
12060.               (setq x2 (+ x2 (abs dash)))
       
12061.             )
       : Z5 x4 v& Y1 s$ ]7 p% @0 _. u! W' Y
12062.           )
       % k, m6 x& Q* ~' D' j
12063.           (setq patlist (cdr patlist))
       0 Q4 }  g2 ]) b- L5 \. U8 g( n6 m
12064.           (setq x1 x2)
       0 \% U$ U4 d  Y
12065.         )
       : K  o1 R8 W5 x6 ]/ |% f# d$ w  _) O
12066.         (setq patlist pattern)
       
12067.       )
       9 E. Z' B7 v- ?5 a9 ]/ o9 {
12068.     )
       
12069.   )
       
12070.   ;;
       
12071.   ;; Draw a dash or dot in image tile
       0 W" ~+ h5 A* i; N
12072.   ;;
       : K* r1 g! y' {& n. i3 q' j8 Z
12073.   (defun vi ()
       
12074.     (setq x2 (+ x2 dash))
       
12075.     (vector_image x1 y2 x2 y2 color)
       
12076.   )
       ' R/ [1 S# C# ], d) x" r/ k
12077. 
       
12078.   ;; This function takes a selection and returns a list of the color,
       
12079.   ;; linetype, layer, linetype scale, and thickness properties that
       + _+ N" ]! W. A/ I6 R) e5 t. C6 N" ]
12080.   ;; are common to every entities in the selection set - (color
       2 `. T# q8 Z' _& |9 J) [
12081.   ;; linetype layer thickness).  If all entities do not share the same
       1 {0 u* d5 e, y. o  G3 f1 b
12082.   ;; property value it returns "Varies" in place of the property
       
12083.   ;; value.  i.e.  ("BYLAYER" "DASHED" "Varies" 0)
       
12084.   ;; The last item in the return list is an integer flag for the
       
12085.   ;; homegenity of the selection-set object types.
       
12086.   ;;   1 = All polylines
       , ~) ~( A4 ?* A1 P8 L
12087.   ;;   2 = All text or mtext or attdef, or a combination of the three
       
12088.   ;;  -1 = Any other mix of objects
       ( j0 o: J$ A) T% M$ W
12089. 
       
12090.   (defun getprops (selset / sslen elist color ltype layer ltscale thickness
       
12091.                           width elevation height go ctr
       # v3 y- r5 U' V0 X& p- Z
12092.                           eflag
       
12093.                           etype temp
       
12094.                           txt_ss     ;;;;rk 11:24 AM 1/30/97
       
12095.                           tmp
       " x9 k2 t) G, I4 G
12096.                           poly_ss   
       
12097.                           style
       8 G* ]' S/ F. a& u* B- D$ m
12098.                   )
       
12099. 
       
12100. 
       
12101.     (setq     sslen (sslength selset)
       
12102.               elist (entget (ssname selset 0))
       
12103.               etype (strcase (cdr (assoc 0 elist)))
       , t2 g" V9 N: w
12104.               color (cdr (assoc 62 elist))
         P" W" [7 |( Z# r% |
12105.               ltype (cdr (assoc 6 elist))
       " i0 D) K) Y" [, s3 A
12106.               layer (cdr (assoc 8 elist))
       
12107.           thickness (cdr (assoc 39 elist))
       : S  j" L3 ]& i
12108.             ltscale (cdr (assoc 48 elist))
       5 `; S+ X6 f0 |' l: q1 y/ x
12109.     );setq
       0 d4 J% z0 \+ z4 E
12110. 
       1 k4 k2 K$ G' J$ q
12111.     (if (not color)     (setq color 256))
       ' O5 E" b$ G3 \. A7 u/ U
12112.     (if (not ltype)     (setq ltype "BYLAYER"))
       & P3 a1 t6 m5 }1 B2 A1 K; y
12113.     (if (not thickness) (setq thickness 0))
       ; R" ^' t6 n: J4 s" y9 f1 ?1 M
12114.     (if (not ltscale)   (setq ltscale 1))
       
12115. 
       9 I0 l, \( N5 C0 R" E
12116.     (if (not width)     (setq width ""))
       # j/ N% A1 e! A1 S
12117.     (if (not elevation) (setq elevation ""))
       $ v4 l  T+ I: Y+ V1 `
12118.     (if (not height)    (setq height ""))
       
12119. 
       
12120.     (setq      go T
       
12121.           chk-col T
       2 m3 U( f5 x3 Y9 l& O. Z/ o. O9 G
12122.            chk-lt T
       
12123.           chk-lay T
       9 }9 N! V: k9 C
12124.           chk-lts T
       
12125.            chk-th T
       
12126.               ctr 0
         z7 M! \; h3 c
12127.     );setq
       / w& u4 s: n/ e2 R1 H, M
12128. 
       8 w$ h; [* S. I' `2 ]4 ]
12129.     ;; Page through the selection set.  When a property
       
12130.     ;; does not match, stop checking for that property.
       
12131.     ;; When the selection set is not homogenous, stop checking.
       3 {$ k0 y& S7 \1 D# Y
12132.     ;; If all properties vary and the set is not a type 1
       
12133.     ;; (polyline) or type 2 (attdef/text/mtext) set, stop paging.
       
12134. 
       
12135.     ;Lets set the eflag so we know if the selection set includes any
       1 a2 \5 B5 v! \4 ]  {6 P* g
12136.     ;combination of polylines, lwpolylines, text, mtext or attdefs.
       % f2 h1 G" k( N
12137. 
       
12138.     ;watch out for 3dpolyline and 3dmeshes here! @rk 10:17 AM 1/30/97
       
12139.     (setq eflag 0)
       
12140.     (if (setq poly_ss
       # ]8 F" \# z, l) ^* B' K
12141.               (ssget "P" (list '(0 . "*POLYLINE")
       
12142.                                '(-4 . "<AND")
       
12143.                                   '(-4 . "<NOT") '(-4 . "&=") '(70 . 8)  '(-4 . "NOT>")
       + G- o1 Z& n* s
12144.                                   '(-4 . "<NOT") '(-4 . "&=") '(70 . 16) '(-4 . "NOT>")
       
12145.                                   '(-4 . "<NOT") '(-4 . "&=") '(70 . 64) '(-4 . "NOT>")
       
12146.                                '(-4 . "AND>")
       1 c" v' L/ E3 G( T1 _, z
12147.                          );list
       
12148.               );ssget get 2d polylines (legacy and lw)
       : }5 U9 _4 k) u$ T/ ]9 l8 \" N
12149.         );setq
       
12150.         (progn
       
12151.          (setq eflag (+ eflag 1))
       - o* m) p/ j8 f' Q7 _& P9 U
12152.          
       & j0 N7 ?+ S! h* P, l! f: Y7 ]
12153.          (setq tmp (entget (ssname poly_ss 0)));setq
       
12154. 
       % O7 ^4 [) X: {8 S) s1 R; r9 a
12155.          (if (equal "POLYLINE" (cdr (assoc 0 tmp)))
       
12156.              (setq elevation (last (cdr (assoc 10 tmp))))
       % d1 P' x$ j2 N6 {1 ~* t
12157.              (setq elevation (cdr (assoc 38 tmp)))
       : K) K- u; [  A4 {. E  }$ u3 J
12158.          );if
       6 f) r. I+ P6 }# U6 z
12159.          (if (not elevation)
       * z; m! ^$ R  g; e% y3 L* b$ S
12160.              (setq elevation 0.0);setq
       
12161.          );if
       8 r0 d/ w* X+ e$ ]( J9 e
12162. 
       
12163.          (setq tmp (ssget "P"
       
12164.                           (list
       ! R. v0 _2 e) l  q) p
12165.                              '(-4 . "<OR")
       ) F% c9 C- D5 w* |
12166.                                '(-4 . "<AND")
       
12167.                                  '(0 . "LWPOLYLINE")
       
12168.                                   (cons 38 elevation)
       
12169.                                '(-4 . "AND>")
       
12170.                                '(-4 . "<AND")
       
12171.                                  '(0 . "POLYLINE")
       & Q0 T) {2 {* q* N
12172.                                  '(-4 . "*,*,=")
       ' k! Y+ `1 G8 Y! c5 S
12173.                                   (cons 10 (list 1.0 1.0 elevation))
       
12174.                                '(-4 . "AND>")
       2 k3 @, N1 l+ d/ c' s1 V" p
12175.                               '(-4 . "OR>")
       1 B, L& B1 B  ~0 Z
12176.                          );list
       ) A# Q7 i5 H: q6 I4 B' ~% s% x7 ~
12177.                    );ssget
       
12178.          );setq
       
12179. 
       ; z4 \- W# \1 s/ K$ L8 D
12180.          (if (and tmp
       
12181.                   (equal (sslength tmp) (sslength poly_ss))
       
12182.              );and
       5 v2 `: V1 f# D- [$ ~& ^
12183.              (setq elevation (ai_rtos elevation));setq
       
12184.              (setq elevation "")
       # }/ V& D1 ^# U- v" }# H+ m
12185.          );if
       - t% y0 z) f: W5 a6 ?* |# o
12186.          
       6 r4 p! y( R' D0 H3 ?  o5 Y% \
12187.          (setq width (pl_width_getter poly_ss));setq
       + j  y" U  H) |; ^$ u- O
12188.          
       ) b" w0 ^* e/ n. x0 U
12189.         );progn then 2d polylines and/or lwpolylines are in the HHHHHOUSE!
       6 K3 @- x& G7 `1 x% O# i( y
12190.     );if
       
12191.     (command "_.select" selset "")
       . b4 Z( v  t, O& f- W6 l
12192.      
       
12193.     (if (setq txt_ss
       
12194.               (ssget "P" '((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT")
       
12195.                            (0 . "ATTDEF") (-4 . "OR>"))
       
12196.               )  
       
12197.         );setq
       
12198.         (progn
       ! V* b' [% U( A' u# L9 y% i/ T1 ?
12199.          (setq eflag (+ eflag 2))
       5 s5 |( i1 T3 ], N9 u
12200.          (setq height (cdr (assoc 40 (entget (ssname txt_ss 0))))
       
12201.                   tmp (ssget "P" (list (cons 40 height)))
       : f$ T9 ~; s% X1 y/ r
12202.          );setq
       
12203.          (if (and tmp
       8 g9 `* y/ j& d0 @4 N$ R' M
12204.                   (equal (sslength txt_ss) (sslength tmp))                    
       . ^+ |" L* |8 r
12205.              );and
       8 t7 E( q% M& Y" R1 T* _0 P
12206.              (setq height (ai_rtos height));setq  ;@rk need to translate from float
       
12207.                                                    ;to string and back again easily
       
12208.              (setq height "");setq else the height varies
       $ U3 g- t/ d; j9 U! `
12209.          );if
       
12210.          (command "_.select" txt_ss "")
       
12211.          (setq style (cdr (assoc 7 (entget (ssname txt_ss 0))))
       $ j. [& [2 o  j+ y0 i2 t$ M& L6 ^
12212.                  tmp (ssget "P" (list (cons 7 style)))
       
12213.          );setq
       5 Y7 N: E. n- y" t. b
12214.          (if (not (and tmp
       ) b& d( Q! _4 x, m# e8 f$ }$ y
12215.                        (equal (sslength txt_ss) (sslength tmp))                    
       # o& O8 M. E) v7 L/ C( J: |
12216.                   );and
       ; W6 [3 J' L, y" `! d7 N' B
12217.              );not
       3 R' X7 {# V3 {( [
12218.              (setq style "");setq then the style varies
       
12219.          );if
       
12220.         );progn the text type objects are in the selection set
       
12221.     );if
       9 H4 j- `; E$ y& s& Q$ Y
12222.     (command "_.select" selset "")
       
12223.    
         w5 V; d1 D6 b" l7 s5 @1 ?
12224.     (while (and (> sslen ctr)
       
12225.                 go
       7 g0 _/ {7 N! w+ x$ ^
12226.            );and
       6 Z5 W% p- d1 ?% ?
12227.       (setq elist (entget (setq en (ssname selset ctr))))
       
12228. 
       
12229.       (if chk-col (match-col))
       
12230.       (if chk-lt (match-lt))
       
12231.       (if chk-lay (match-lay))
       
12232.       (if chk-lts (match-lts))
       
12233.       (if chk-th (match-th))
       
12234. 
       
12235.       ;(if chk-etype (match-etype))
       
12236. 
       & d; r8 R, I$ c) ?$ J
12237.       (setq ctr (1+ ctr))
       
12238.       (if (and (not chk-col)
       
12239.                (not chk-lt)
       
12240.                (not chk-lay)
       
12241.                (not chk-lts)
       : p) n# r6 n8 y
12242.                (not chk-th)
       
12243.                ;(not chk-etype)
       
12244.           );and
       
12245.           (setq go nil)
       
12246.       );if
       / B; @  v* |% i; z( ^
12247.     );while
       & O+ `  Y6 n" ^4 s7 d
12248.    
       
12249.     (list color ltype layer thickness ltscale
       + [. ]6 j% W; @* k6 |! n
12250.           width elevation height eflag
       6 p, H" [: k6 @9 `( s1 Y- X, {) T
12251.           style poly_ss txt_ss
       
12252.     )
       2 k' M; r4 L; s2 U  y
12253.   );defun getprops
       2 v  V4 I* c2 G1 X0 n0 T7 z1 u' ~
12254. 
       
12255.   ;  This is a speedy little routine to tell whether the polylines in
       
12256.   ;the selection set argument are of varying width or a constant value.
       8 ?* B! E- `6 u* O# I
12257.   ;Looping through the vertex's has to be done for old polylines when
       4 c* r8 Q) U) ?  v6 \
12258.   ;the polyline header has width values of 0.0. Basically, in this case,
       
12259.   ;information in the polyline entity header is abmiguous. Width values
       
12260.   ;of 0.0 in the header entity could mean the polyline has a constant
       4 D0 t2 k% y+ }
12261.   ;width of 0.0 or it could mean that the polyline has vertex's of varying
       ( e4 M4 l( n1 l, d
12262.   ;width.
       3 m7 o3 A/ ^3 k6 U7 _  \
12263.   ;
       
12264.   ;  It's all in wrist. Err a.., I mean it's all in the 'if'
       , D% F, ^/ S8 R0 R# k
12265.   ;;
       
12266.   (defun pl_width_getter ( ss / ss2 ss3 n na e1 width width_a width_b flag flag2)
       : ]' o1 o3 P; O  t
12267. 
       & m8 M/ p9 Q/ k0 L" K) W% h5 e
12268.    (if ss
       
12269.        (command "_.select" ss "")
       
12270.    );if
       
12271.    (setq width ""
       3 f: i9 s. b1 B3 i
12272.           flag nil
       & \% k( @% r' Q- O( y
12273.          flag2 nil
       9 U8 T9 V/ A$ ^
12274.    );setq
       
12275.    (if (not
       , c0 a! X# u! G* G5 p/ Z- F7 B5 h% `
12276.          (and ss
       
12277.               (setq ss2 (ssget "p" '((0 . "LWPOLYLINE"))));setq
       
12278.               (setq    na (ssname ss2 0)
       
12279.                     width (cdr (assoc 43 (entget na)))
       
12280.               );setq
       
12281.               (setq ss3 (ssget "p" (list '(0 . "LWPOLYLINE")
         `/ J3 ^* O" {' Y! w6 l
12282.                                           (cons 43 width)
       ; l- D2 p" H* O2 l* F, W
12283.                                    );list
       . n6 n3 `+ L  ]0 J! \" P
12284.                         );ssget
       ; M2 d) C. R+ T8 r1 X
12285.               );setq
       
12286.               (setq flag T)
       ! ^* `! f; _* W# a# t7 Q
12287.               (equal (sslength ss2) (sslength ss3))
       
12288.          );and
       + {7 l5 z& z( h1 B8 R0 c9 ^! @
12289.        );not
       . u/ d2 f5 R& P3 ~8 P7 r
12290.        (progn
       
12291.         (if flag
       7 U6 ^4 L/ e/ n+ E
12292.             (setq width nil)
       
12293.         );if
       ! C+ Z1 h/ n2 `: k1 P. Z
12294.        );progn
       
12295.    );if
       
12296.       
       + Y7 s. D% H  u
12297.    (if (not
       ' `, ^8 g* S5 R) K, U" s) R
12298.         (and
       
12299.              ss
       8 D* \# e' [4 h0 t- U$ i
12300.              (progn (command "_.select" ss "")
       
12301.                     (setq ss2 (ssget "p" '((0 . "POLYLINE"))));setq
       
12302.              )
       
12303.              (setq      na (ssname ss2 0)
       
12304.                         e1 (entget na)
       
12305.                    width_a (cdr (assoc 40 e1))
       $ i3 C; I  W0 j! D
12306.                    width_b (cdr (assoc 41 e1))
       
12307.              );setq
       
12308.              (equal width_a width_b)
       ) q8 S+ ]6 j9 ]
12309.              (setq ss3 (ssget "p" (list '(0 . "POLYLINE")
       ; G% P0 }6 a3 k$ K) l4 x$ G0 L2 t2 F% P
12310.                                          (cons 40 width_a)
       9 }! ^& l+ u( z! n9 F4 `1 g2 \
12311.                                          (cons 41 width_b)
       2 c: S' w. c) H+ Y- T: l; _4 q
12312.                                   );list
       
12313.                        );ssget
       : n; B0 V9 k* P" X, T; k. h, y
12314.              );setq
       
12315.              (setq flag2 T)
         v- |# Q0 B* g
12316.              (equal (sslength ss2) (sslength ss3))
       . j8 G3 D7 z( b" F  I9 t
12317.         );and
       
12318.        );not
       
12319.        (progn
       + e# d; k9 @: d# L; @0 p: x
12320.         (if flag2
       3 o/ k6 l  k% Q1 M+ v" x& l5 i
12321.             (setq width nil);setq
       
12322.         );if
       
12323.        );progn then
       
12324.        (progn
       $ h/ x1 \! t$ T* e9 B% ]
12325.         (if (or (equal width "")
       * ^0 V; D0 s2 S4 k9 ?, L
12326.                 (not flag)
       1 c: k) t2 M  @) s) \) E4 S. H
12327.             );or
       
12328.             (setq width width_a)
         z( W; N! v/ P# C( u  Y4 a( C* U
12329.             (progn
       ! z! h2 ]/ s% P0 _( {$ Q
12330.              (if (not (equal width width_a))
       / B6 p* T: ^6 _  Q
12331.                  (setq width "")
       
12332.              );if  
       . Z/ c6 l; U2 E2 }$ Z- z+ \! Y
12333.             );progn
       
12334.         );if
       - E5 h% l: K6 o0 I6 ^6 h
12335.        );progn
       - g& {) _3 Y( R
12336.    );if
       
12337.       
       % c2 f9 y3 Y  S# i2 V
12338. 
       - d8 k8 I. T" R
12339.    ;now for the special handling for old polylines
       
12340.    (if (and width
       0 n# L7 T% j, L$ {( [+ c! y
12341.             (equal width 0.0)
       * y, y8 w- y: ?- i# f' U+ S) n
12342.             flag2
       , }4 `/ _6 j, L/ \
12343.        );and
       
12344.        (progn
       ) Q2 e9 e3 n% `1 n
12345.         
       
12346.         (setq n 0);setq
       % _- A1 W; y! i" ]! e! v3 n
12347.         (while (and (equal width 0.0)
       8 b! a- C4 B1 D. h2 ~$ f8 q3 B8 b
12348.                     (< n (sslength ss3))
       " O& U; g1 _4 N8 h9 y
12349.                );and
       
12350.          (setq flag nil
         o' e9 V* p: y( t
12351.                  na (ssname ss3 n)
       
12352.                  na (entnext na)
       
12353.                  e1 (entget na)
       ' r- X( B5 Q6 o( |( V+ N2 Q
12354.          );setq
       
12355.          (while (not flag)
       
12356.           (if (or (equal (cdr (assoc 0 e1)) "SEQEND")
       % z) K# p7 |* V
12357.                   (not (equal (cdr (assoc 40 e1)) 0.0))
       
12358.                   (not (equal (cdr (assoc 41 e1)) 0.0))
       
12359.               );or
       
12360.               (progn
       7 q  Y1 Q& [. h8 ~
12361.                (setq flag T);
       
12362.                (if (not (equal (cdr (assoc 0 e1)) "SEQEND"))
       7 J* _) m3 w  I
12363.                    (setq width nil)
       
12364.                );if
       ( I) N# q0 r! \
12365.               );progn then jump out of the loop
       
12366.               (setq na (entnext na)
       
12367.                     e1 (entget na)
       & c% G2 k$ s( L  X1 l
12368.               );setq
       
12369.           );if
       
12370.          );while
       
12371.         (setq n (+ n 1));setq  
       
12372.         );while
       
12373.            
       0 g3 Z3 `' j0 v/ s8 Y
12374.        );progn then it's a legacy
       
12375.    );if    ;legacy polylines that may have varying widths  
       8 w% t/ B3 c6 G1 |; M& Y2 S' b
12376. 
       
12377.    (if (not width)
       
12378.        (setq width "");setq
       
12379.    );if
       
12380.    (if (not (equal 'STR (type width)))
       
12381.        (setq width (ai_rtos width));setq
       
12382.    );if
       : X7 q: {, N7 G/ O# J
12383.    
       , b) ^5 b7 K/ p" [! m: d% c
12384.    width   
       : i% F) N; S0 j. L
12385.   );defun pl_width_getter
       
12386. 
       
12387.    
       2 E' ~- ?6 b9 m' M& b- W( j+ G
12388.   (defun match-col (/ ncolor)
       ) ^( s9 ?0 z  b) K
12389.     (setq ncolor (cdr (assoc 62 elist)))
       # Y5 [5 G$ n6 M$ \" T6 c
12390.     (if (not ncolor) (setq ncolor 256))
       & U( d' @4 V% T1 G5 v, F! T' {
12391.     (if (/= color ncolor)
       $ L  Q3 M% |* N3 D& I
12392.       (progn
       
12393.         (setq chk-col nil)
       
12394.         (setq color nil)
       
12395.       )
         J' o  O2 A% i9 t2 M/ u* P4 l9 H( U$ ]
12396.     )
       
12397.   )
         W( K# e: I. n- A# t% u
12398. 
       
12399.   (defun match-lt (/ nltype)
       
12400.     (setq nltype (cdr (assoc 6 elist)))
       $ U2 I! |* E  w" c& W
12401.     (if (not nltype) (setq nltype "BYLAYER"))
       ( |: u9 d4 j; V. {+ \6 E
12402.     (if (/= ltype nltype)
       , R# Q7 l8 ~3 \$ G
12403.       (progn
       
12404.         (setq chk-lt nil)
       
12405.         (setq ltype ;|MSG0|;"Varies")
       
12406.       )
       & L1 [) u: F6 O0 P" [7 ?& E
12407.     )
       
12408.   )
       
12409. 
       7 Y) b7 T3 e0 C; O" j
12410.   (defun match-lay (/ nlayer)
       
12411.     (setq nlayer (cdr (assoc 8 elist)))
       
12412.     (if (/= layer nlayer)
       
12413.       (progn
       ! x" e( `, y0 M( L+ a) ^# z, X
12414.         (setq chk-lay nil)
       ) |8 |" w3 o( _/ X
12415.         (setq layer ;|MSG0|;"Varies")
       
12416.       )
       0 x# t* G8 M6 j' }2 L
12417.     )
       ' T9 E; Z0 G# b7 g4 v0 s
12418.   )
       8 S; A* @* l! X* D  M% g1 O/ t
12419. 
       
12420.   (defun match-th (/ nthickness)
       
12421.     (setq nthickness (cdr (assoc 39 elist)))
       
12422.     (if (not nthickness) (setq nthickness 0))
       , }- n6 l1 X* E0 a6 h1 x* E7 M& o* s: G
12423.     (if (/= thickness nthickness)
       
12424.       (progn
         k) t5 F3 L! S$ ?2 C
12425.         (setq chk-th nil)
       5 o8 y6 E2 y- g) D: c
12426.         (setq thickness ;|MSG0|;"Varies")
       
12427.       )
       
12428.     )
         |9 H; c  U) J% ^: G
12429.   )
       
12430. 
       2 r8 m; W, b4 m* A1 w( c/ O* C/ M
12431.   (defun match-lts (/ nltscale)
       , o4 [/ B9 B3 B! C
12432.     (setq nltscale (cdr (assoc 48 elist)))
       + f/ R( e- _- k3 T2 `. U6 p6 T( n
12433.     (if (not nltscale) (setq nltscale 1))
       : i9 i, y1 q/ ^& T) s
12434.     (if (/= ltscale nltscale)
       
12435.       (progn
       . m( N5 K4 I6 n+ W- z0 D
12436.         (setq chk-lts nil)
       
12437.         (setq ltscale ;|MSG0|;"Varies")
       / M8 o3 R& p. J- J8 [& Z  {
12438.       )
       
12439.     )
       6 U1 `4 b7 j6 o; M7 w. l
12440.   )
       
12441. 
       
12442.   ;;
         R( S/ R0 o7 K& j% v* Y' l
12443.   ;; If an item is a member of the list, then return its index number, else
       / u1 q( s- T" z! J( h$ ]
12444.   ;; return nil.
       
12445.   ;;
       % u0 Y5 w5 N% p: P& |9 u% o
12446.   (defun getindex (item itemlist / m n)
       
12447.     (setq n (length itemlist))
       & M: Z' V) E$ |- z
12448.     (if (> (setq m (length (member item itemlist))) 0)
       
12449.         (- n m)
       
12450.         nil
       
12451.     )
       
12452.   )
       
12453.   ;;
       ; u5 e+ q* r; E: K, U
12454.   ;; This function is called if the linetype is set "BYLAYER". It finds the
       
12455.   ;; ltype of the layer so it can be displayed beside the linetype button.
       
12456.   ;;
       8 S  k' u0 x9 W3 E( E. l! \) R
12457.   (defun bylayer_lt (/ layname layinfo ltype)
         W. n* q, |% c9 l
12458.     (if lay-idx
       . ?1 E+ H, j- e
12459.       (progn
       
12460.         (setq layname (nth lay-idx laynmlst))
       ; s) u& Q1 |7 P2 E
12461.         (setq layinfo (tblsearch "layer" layname))
       # c) |' q9 B& N+ L8 G# o0 Y
12462.         (setq ltype (cdr (assoc 6 layinfo)))
       0 z6 V& _7 M' T' |9 ]
12463.         (strcat "BYLAYER" " (" ltype ")")
       
12464.       )
       
12465.       "BYLAYER"
       
12466.     )
       
12467.   )
       $ A. ]8 N) x' N, l* K7 p1 f
12468.   ;;
       5 w6 {! G7 {! G4 E% h3 g: e8 R: P
12469.   ;; This function is called if the color is set "BYLAYER".  It finds the
       
12470.   ;; color of the layer so it can be displayed  beside the color button.
       
12471.   ;;
       6 ~* q) o" U  }5 c
12472.   (defun bylayer_col (/ layname layinfo color)
       8 S9 w% N: B: h% q) n- s; E: X
12473.     (if lay-idx
       
12474.       (progn
       # f9 f+ Q* d1 Q2 f0 ], j
12475.         (setq layname (nth lay-idx laynmlst))
       
12476.         (setq layinfo (tblsearch "layer" layname))
       
12477.         (setq color (abs (cdr (assoc 62 layinfo))))
       : i0 K0 V" [! \5 f& c
12478.         (setq cn color)
       
12479.         (strcat "BYLAYER" " (" (colorname color) ")")
       
12480.       )
       + |9 j& N9 L( M5 {: _
12481.       (progn
       : n  c6 L' y. T5 L; k+ y
12482.         (setq layname elayer)
       ) Q) I9 y' _7 n1 M9 A6 h9 m
12483.         (if (and (/= elayer "")
       0 K9 K* c: o3 {7 y
12484.                  (/= elayer "Varies")
       4 d" p' e# u) }, o7 c0 V! b+ C
12485.             );and
       
12486.             (progn
       
12487.              (setq layinfo (tblsearch "layer" elayer))
       1 x% I, [7 ~0 _1 u5 N5 V3 O8 P
12488.              (setq color (abs (cdr (assoc 62 layinfo))))
       
12489.              (setq cn color)
       
12490.              (strcat "BYLAYER" " (" (colorname color) ")")
       ! Y% y' M& K3 h* D
12491.             )
       % ^5 q8 \8 {9 M0 L
12492.             (progn
       ' n& U* H( [0 {2 m
12493.              (setq cn 0)
       
12494.              "BYLAYER"
         `. y5 i5 G- E
12495.             )
       $ ~  U" l' h! U+ e! n
12496.         );if
       3 }) G3 R& g' G/ x
12497.       );progn
       
12498.     );if
       - O2 q1 |5 K9 B) D& t
12499.   )
       % M! l: G0 u9 a1 B% T) [
12500.   ;;
       
12501.   ;; If there is no error message, then close the dialogue
       
12502.   ;;
       % }2 ]3 O& |7 R
12503.   ;; If there is an error message, then set focus to the tile
       . `% L) S/ B9 J% T3 s
12504.   ;; that's associated with the error message.
       $ C) j3 [9 `) {+ o% Y$ G
12505.   ;;
       
12506.   (defun test-ok ( / errtile)
       " J/ t0 e) w( u) a
12507.     (setq errtile (get_tile "error"))
       
12508.     (cond
       1 L9 l3 ~% Z, B; _& H
12509.       (  (= errtile "")
       . y1 B' \$ Q: _) W. C. t2 n( x
12510.          (done_dialog 1))
       
12511.       (  (= errtile "Invalid thickness.")
       * ^+ G, O" F* p* h5 \4 E6 |! U
12512.          (mode_tile "eb_thickness" 2))
       ; f2 d) ~' M( a. v
12513.     )
       
12514.   )
       0 x+ B$ v% B: E
12515.   ;;
       7 e& V% l' r# F
12516.   ;; OK in main dialogue.
       7 j  B7 m: U! z! J
12517.   ;;
       
12518.   (defun test-main-ok ( / flag)
       
12519.    (setq flag T)
       / c3 s: e1 j2 o" n4 s
12520.    (if (not (or (distof (get_tile "eb_thickness"))
       
12521.                 (= "" (get_tile "eb_thickness"))
       # o" r0 _- c% P
12522.             );or
       
12523.        );not
       
12524.        (progn
       
12525.         (set_tile "error" "Invalid thickness.")
         w8 x6 K% f4 ]  i, b
12526.         (mode_tile "eb_thickness" 2)
       1 }* f2 S% T, s" @, \0 t) [6 j
12527.         (setq flag nil);setq
       
12528.        );progn
       
12529.    );if
       / y$ @5 }5 \1 f
12530.    (if (and flag
       
12531.             (not (or (< 0 (distof (get_tile "eb_ltscale")))
       
12532.                      (= "" (get_tile "eb_ltscale"))
       
12533.                  );or      
       + O6 P5 m+ R7 q# P
12534.             );not
       3 y( M1 B1 ?5 G; G0 @+ B  i+ x
12535.        );and
       
12536.        (progn
       - |4 \& z1 i5 n8 r! {7 J+ Y/ c
12537.         (set_tile "error" "Invalid ltscale.")
       
12538.         (mode_tile "eb_ltscale" 2)
       / R3 {3 U1 b3 A, E$ G" V$ {
12539.         (setq flag nil);
       + _, r, x! z! U% W+ Y
12540.        );progn then
       
12541.    );if
       
12542.    (if (and flag
       * H9 d( @( {9 ^% H+ ~3 n
12543.           ; Don't test the tile's value unless it's enabled.
       & G/ O0 {' F& h
12544.           ; We're not set up for the display-only value
       : E/ ?) r0 v2 `) @$ }4 U$ k/ F! r
12545.           ; of "" here in the error handler.
       0 r! ^: Z$ L1 }7 t
12546.           (= 2 (logand 2 eflag))
       
12547.           (not (or (< 0 (distof (get_tile "text_hgt")))
       , |# h. c% Z2 @5 m( {. r9 o7 K
12548.                    (= "" (get_tile "text_hgt"))
       
12549.                );or
       5 H" \$ I; K2 I+ k1 o0 ^
12550.           );not
       
12551.         );and
       
12552.         (progn
       
12553.          (set_tile "error" "Invalid height.")
       , @( A. I4 @( w6 M: F: O
12554.          (mode_tile "text_hgt" 2)
       
12555.          (setq flag nil);
       
12556.         );progn then
       ; W/ P9 c. Z/ b: M" |) `9 K, G
12557.    );if
       
12558.    (if (and flag
       8 i6 X3 M; G) v  `( i! S
12559.             (= 1 (logand 1 eflag))
       6 K3 R& x* U  \- @
12560.             (not (or (<= 0 (distof (get_tile "poly_wid")))
       
12561.                      (= "" (get_tile "poly_wid"))
       
12562.                  );or
       
12563.             );not
       . T; m: F* N5 `, N( C
12564.        );and
       8 m7 q& x' k" y! U: B7 A9 @; V
12565.        (progn
       
12566.         (set_tile "error" "Invalid width.")
       - ^  X: C6 {7 G
12567.         (mode_tile "poly_wid" 2)
       : a' o3 j2 I% V/ G% T7 I
12568.         (setq flag nil)
       ! a' N3 T+ G9 T$ U( X8 d5 P
12569.        );progn then
       % j" k4 r. }0 @5 f- ?% v  R
12570.    );if
       & t  G* W  }5 [& C1 P
12571.    (if (and flag
       
12572.             (= 1 (logand 1 eflag))
       6 ^( q: _' z( S" T4 b" ^) D
12573.             (not (or (distof (get_tile "poly_elev"))
       
12574.                      (= "" (get_tile "poly_elev"))
       0 @6 |- B  {* {2 }% r
12575.                  );or
       9 ?( x  {5 O4 Y( `+ ~9 j
12576.             );not
       
12577.         );and
       / I* n; w; X3 Z$ J* Z/ \: v
12578.         (progn
       
12579.          (set_tile "error" "Invalid elevation.")
       
12580.          (mode_tile "poly_elev" 2)
       
12581.          (setq flag nil)
       
12582.         );progn then
       
12583.    );if  
       
12584.    (if flag
       
12585.        (done_dialog 1)
       , u, i6 X/ ]& G1 h: R% u
12586.    );if
       8 t% F3 E0 h/ I0 x5 F9 B
12587.   );defun test-main-ok
       
12588. 
       
12589.   ;;
       ' h6 Z6 f; a+ R6 _0 H2 t
12590.   ;; A color function used by getlayer.
       
12591.   ;;
       
12592.   (defun colorname (colnum)
       8 j$ z9 I8 o9 i1 }. U; T/ ^
12593.     (setq cn (abs colnum))
       , y; G* B8 ~3 N& t* G8 e
12594.     (cond ((= cn 1) "red")
       % E9 C$ f$ ^, m2 t$ g+ e; N4 z
12595.           ((= cn 2) "yellow")
       5 l- I( D7 z. h. O; U
12596.           ((= cn 3) "green")
         y9 m) `- n+ A$ _2 S6 J4 s" W! `
12597.           ((= cn 4) "cyan")
       
12598.           ((= cn 5) "blue")
       7 P0 Q( q  m! u6 e0 ^
12599.           ((= cn 6) "magenta")
       
12600.           ((= cn 7) "white")
       ; o  D7 W; D. y6 D1 N
12601.           (T (itoa cn))
       
12602.     )
       
12603.   );defun
       4 S% z0 a+ r2 D; e% t( H# s- Q5 D
12604. 
       
12605. ;;; Construct layer and ltype lists and initialize all
       . @% }# v: Q1 ^# M& n/ T
12606. ;;; program variables:
       
12607. 
       
12608. ;  (makelaylists)                     ; layer list - laynmlst
       # ~9 ]# U8 r4 P* w. `+ f) N4 x
12609. 
         {6 F7 `! o9 Y3 z7 K4 t
12610. 
       
12611.   (makeltlists)                      ; linetype lists - ltnmlst, mdashlist
       
12612. 
       " |: b, U0 @& w: E% e6 j
12613.   ;; Find the property values of the selection set.
       
12614.   ;; (getprops ss) returns a list of properties from
       ! W$ X1 |. C! S% Q7 @, H; q) J
12615.   ;; a selection set - (color ltype layer thickness HEGHT STYLE WIDTH).
       " q) L, L8 C/ }- ?
12616. 
       $ B$ f$ ^* S; r3 k  H) E: s
12617.   (setq proplist (getprops ss));@rk interesting things happen here
       . y* B8 i0 V3 B- z. l
12618. 
       ) G$ g' o% D5 i0 h2 I+ }6 T" ]
12619.   (setq
       + g* N4 p  n% Q6 Y8 M
12620.             ecolor (car proplist)
       
12621.             eltype (nth 1 proplist)
       ! o) y3 f# b0 c+ n* D# z% w, n
12622.             elayer (nth 2 proplist)
       7 `1 U! n# N7 E- V
12623.         ethickness (nth 3 proplist)
       
12624.           eltscale (nth 4 proplist)
       
12625.             ewidth (nth 5 proplist)
       
12626.         eelevation (nth 6 proplist)
       
12627.            eheight (nth 7 proplist)
       % X- {. `- U% K6 L. a
12628.             ;etype (nth 8 proplist);commented out and replaced with the line below. RK.
       
12629.              eflag (nth 8 proplist)
       
12630.             estyle (nth 9 proplist)
       
12631.            poly_ss (nth 10 proplist)
       
12632.            txt_ss  (nth 11 proplist)
       
12633.   );setq
       ( e4 h2 l) G9 q; b. L# _# Y! p& R* `
12634. 
       
12635.   ;; Find index of linetype, and layer lists
       1 ^0 e! S4 C  A. C7 z  C$ ?# z
12636.   (cond
       * n8 R% B6 D+ p- f
12637.     ((= eltype "Varies") (setq lt-idx nil))
       
12638.     ((= eltype "BYLAYER")
       # t, [9 W6 `% {
12639.      (setq lt-idx (getindex "BYLAYER" ltnmlst)))
       $ \2 r) M$ M; o+ r4 g5 z
12640.     ((= eltype "BYBLOCK")
       
12641.      (setq lt-idx (getindex "BYBLOCK" ltnmlst)))
       
12642.     (T (setq lt-idx (getindex eltype ltnmlst)))
       
12643.   )
       
12644.   (if (= elayer "Varies")
       # A# H. [  f( }$ I! z
12645.       (setq lay-idx nil)
       
12646.       (setq lay-idx (getindex elayer laynmlst))
       ; g1 R+ e1 h8 Z2 J' ~& j
12647.   );if
       
12648.   (if (= ethickness "")
       & ~( f* N( F/ x" ~2 ~
12649.       (setq ethickness nil)
       
12650.   );if
       
12651.   (if (= eltscale "")
       $ N" u4 m% e0 k+ O
12652.       (setq eltscale nil)
       
12653.   );if
       ' z& W* S, y! s0 S
12654. 
       " H9 p6 |* T+ ]9 e5 f: l
12655. );defun ddchprop2_init   ; end (ddchprop2_init)
       , O1 E  l" J0 S. @8 X
12656. 
       
12657. ;;; (ddchprop2_select)
       
12658. ;;;
       
12659. ;;; Aquires selection set for DDCHPROP2, in one of three ways:
       
12660. ;;;
       - o0 M8 r2 _% K' z4 ]4 I
12661. ;;;   1 - Autoselected.
       2 Q" y" j8 U% ~- C7 I/ S
12662. ;;;   2 - Prompted for.
       ( C+ Z, X8 c/ c- Z& b: w
12663. ;;;   3 - Passed as an argument in a call to (ddchprop2 <ss> )
       
12664. ;;;
       
12665. ;;; The (ddchprop2_select) function also sets the value of the
       # {4 {2 t; L8 `3 }( }
12666. ;;; global symbol AI_SELTYPE to one of the above three values to
       ! `6 x, H: q4 G
12667. ;;; indicate the method thru which the entity was aquired.
       4 j: ^3 N+ f2 v1 R, x' y
12668. 
       7 A3 f) M2 |" o" _) z
12669. 
       
12670. (defun ddchprop2_select ( / )
       4 h, m- x" }5 L& o' I8 ?
12671. 
       4 g! e$ `) s4 w* B; p' b; ~; w5 t4 ~# D
12672. 
       
12673. ;returns only entities in ss that are in the current space.
       9 t: f" D. Z+ g8 p" Y* c1 t
12674. (defun ss_in_current_space ( ss / a cur_space ss2)
       ) h* L  n( Y. m
12675. 
       2 _  y- t7 y3 @9 I
12676. (if ss
       
12677.      (progn
       
12678.       (if (and (equal (getvar "tilemode") 0)
       2 a( s+ m) V8 {& X
12679.                (equal (getvar "cvport") 1)
       9 x7 t9 K6 y: m4 B- G7 y8 K
12680.           );and
       ( F& Y0 k  o( M+ T& G1 S0 {
12681.           (setq cur_space 1);then paper space is where we are.
       # \3 {& j* _: C7 y1 F& G$ q' t
12682.           (setq cur_space 0);else model space.
       
12683.       );if
       
12684.       (command "_.select" ss "")
       2 U% m& Y  N3 D) z
12685.       (setq ss2 (ssget "p" (list (cons 67 cur_space))));setq
       % N8 @% T3 m% z* G
12686.       (cond                              ;;;;;tell the user what's going on.
       - L# e* D; N: _3 M0 T0 i3 m/ S4 G5 h
12687.        ((not ss2) (princ "\nNo objects found in current space."))
       8 s( p5 B" c! q, p0 t% f  v
12688.        ((not (equal (sslength ss) (sslength ss2)))
       1 f6 H. D9 k3 Z/ }! x
12689.         (princ (strcat "\n" (itoa (- (sslength ss) (sslength ss2)))
       
12690.                        " object(s) were not in current space."
       
12691.                )
       - K2 g& y" f! W
12692.         )
       
12693.        )
       * @  `; j$ Z( v6 p& |" {8 t% }/ a
12694.       );cond
       
12695.      );progn then
       
12696. );if  
       
12697. ss2
       
12698. );defun ss_in_current_space
       
12699. 
       ) u+ ]  h1 p# b( S! s
12700. 
       % r3 Y6 k# V" V
12701. ;;;begin the work of ddchprop2_select
       3 h' \$ }# q: G6 W/ y  c
12702. 
       6 y0 R7 m9 F3 l* L( G
12703. ;; temporarily restore original highlight setting.
       
12704. (b_set_sysvars (assoc "HIGHLIGHT" (car bonus_varlist)))
       # F& o: b2 f! B( w$ ^7 c$ P8 |
12705. (cond
       . [9 o( A/ h) C* c) g7 v6 x' ~  E
12706.    ((and ss
       " ^* [0 |  G! \) S* R* ]
12707.          (eq (type ss) 'pickset)
       . b! \( s1 p5 I
12708.     )        ; selection set passed to
       9 \# m) z% Y$ ^0 Z( t
12709.     (cond                                   ; (ddchprop2) as argument
       
12710.      ((not (zerop (sslength ss)))       ;   If not empty, then
       
12711.       (setq ai_seltype 3)               ;   then return pickset.
       " ~$ ^5 S* C  l! k$ b9 c7 d2 {1 l2 _
12712.       (ai_return ss)
       0 j! p! e& s& Z0 p& ~+ Z& {
12713.      )
       
12714.     );cond close
       
12715.    );cond #1
       + I+ I) w4 c& H+ C. E
12716.    ((setq ss (ai_aselect)))                          ; Use current selection
       8 x, z. n1 a/ g# M& ~
12717.                                                      ; set or prompt for objects
       
12718.    (T (princ "\nNothing selected.")
       
12719.       (ai_return nil)
       . c4 M, ?  W- b5 {4 L# p+ a; |
12720.    )
       " L5 z) T. _: `1 v6 \
12721. );cond close
       
12722. (b_restore_sysvars)
       - E; @, d3 u) U7 W
12723. 
       
12724. ;(if ss
       : F5 }- r/ ]" C9 o! A
12725. ;    (setq ss (ss_remove_locked ss))
       & [1 R& K9 {1 I; W9 W
12726. ;);if
       2 r) O8 ]2 c* ]2 M' T
12727. (if ss
       1 n9 \% m1 |7 K2 j! m8 M$ p3 s
12728.      (setq ss (ss_in_current_space ss))
       3 y+ K; b! |. [. d$ R2 \; M
12729. );if
       ( W- U/ v* W, W$ ^: T1 H7 Z
12730. 
       ( Q+ O, c+ \5 A7 [
12731. ss
       : U4 ~1 Q3 N: A" ?, t, O) V! A; q
12732. );defun ddchprop2_select
       
12733. 
       % A3 s1 ^$ ?) H
12734. 
       
12735. ;;; Define command function.
       
12736. (defun C:CCH ()
       9 L0 k+ Q5 O* A9 u6 A6 e
12737.   (ddchprop2 nil)
       
12738.   (princ)
       
12739. );defun
       ) s; ]# ^8 r6 u+ v$ J2 U. Y9 w5 ]
12740. 
       3 e7 M# e' d9 [. L/ X+ _
12741. 
         e4 s  W) `* A- O, c4 F+ }1 T! j
12742. ;;; Main program function - callable as a subroutine.
       
12743. ;;;
       
12744. ;;; (ddchprop2 <pickset> )
       
12745. ;;;
         N  A  g: D+ A( `: F0 Q) q" ^5 m
12746. ;;; <pickset> is the selection set of objects to be changed.
       
12747. ;;;
       + H4 K0 l1 ^3 `) v% U8 H; P1 k0 W
12748. ;;; If <pickset> is nil, then the current selection set is
       & J( P$ u, H+ w4 @
12749. ;;; aquired, if one exists.  Otherwise, the user is prompted
       
12750. ;;; to select the objects to be changed.
       
12751. ;;;
       * v( ?1 U" g; u1 \
12752. ;;; Before (ddchprop2) can be called as a subroutine, it must
       
12753. ;;; be loaded first.  It is up to the calling application to
       
12754. ;;; first determine this, and load it if necessary.
       & S' q3 j. z! q- \$ L" I9 l, k: T
12755. 
       / L: X! h) A# l
12756. (defun ddchprop2 (ss  /
       
12757. 
       ( B) y6 T& \# y) Z* s5 S5 U- W
12758.                   a
       . C, w* N. m# i
12759.                   add-mdash
       0 p0 D( N) R4 l+ d* A" V% z+ ^
12760.                   assoclist
       & z- d) X7 b& e( n) i4 N+ d) f4 A
12761.                   bit-70
       $ n$ u% q/ w4 H: Y- `  k2 |2 E
12762.                   boxlength
       % T/ p6 Q3 J9 O/ x0 j3 n3 W
12763.                   bylayer-lt
       
12764.                   bylayer_col
       7 n7 t3 Q: b3 i3 m: C$ U
12765.                   bylayer_lt
       ; k) b3 K0 |# p9 m/ u' f
12766.                   call_chp2
       
12767.                   chk-col
       4 y. K/ O3 B& n: g
12768.                   ;chk-etype        ;var removed by rk
       6 m# t0 V7 r0 d5 M/ n
12769.                   chk-lay   
       
12770.                   chk-lt
       $ R: U# Y$ I5 ]" n" f
12771.                   chk-lts           ;var added by rk
       
12772.                   chk-th
       
12773.                   cmd
       
12774.                   cmdecho
       / d$ n0 x+ ~% N1 Q8 H' S
12775.                   cn
       
12776.                   cnum
       
12777.                   col-idx
       ; E" G" u. R# V; b3 `- r6 G, V! V
12778.                   col_def
       ! b+ y+ G+ v  I3 p5 }
12779.                   col_tile
       5 L8 P/ q$ i0 A( X8 D* @
12780.                   colname
       ; J  A7 z6 `% w  b- c
12781.                   colnum
       
12782.                   color
       ) q3 @6 R/ F, d3 m1 d  Z
12783.                   colorname
       * m! H5 M. z" m! u, l' G
12784.                   cvpname
       
12785.                   dash
       ; c2 a6 b7 F+ Q' u/ f: w
12786.                   dashdata
       
12787.                   dashlist
       
12788.                   dashsize
       ) q0 I8 P! `7 q% N3 T
12789.                   dcl_id
       - k7 j& s4 u/ C: U
12790.                   ddchprop-err
       
12791.                   drawpattern
       
12792.                   ecolor
       
12793.                   eelevation
       4 n5 `$ R; D6 k, N$ N
12794.                   eflag
       : O- y! m, B+ q) [4 ?
12795.                   eheight
       : I7 S- [, z7 }+ _
12796.                   elayer
       
12797.                   elevation
       , f$ D( S8 U1 O  r1 @. p( o! M* d
12798.                   elist
       
12799.                   eltscale
       
12800.                   eltype
       8 D0 c9 x, S& f, ^# m
12801.                   en
       
12802.                   ename
       9 l4 c% ^6 x6 \' R
12803.                   ESTYLE             ;var added by rk
       ! ]- {8 d' ]9 [4 w) r
12804.                   ethickness
       1 F5 X* `1 K( z0 R# u, l8 Z) q. n
12805.                   ;etype             ;var removed by rk
       
12806.                   ewidth
       
12807.                   fchk
       ; @+ `) n- _5 P7 S8 t% y5 N2 j3 y
12808.                   frozth
       ( N! L' F) u$ [7 L4 Z
12809.                   fx
       
12810.                   getcolor
       % }% L$ w7 }0 x) ~
12811.                   GETELEVATION      ;function added by rk
       1 R7 d0 o' T- a  |+ l3 P' H" h
12812.                   GETHEIGHT         ;function added by rk
       % v9 X3 |& H9 y9 g) G
12813.                   getindex
       0 o8 k9 d% m& [8 L7 @/ Y
12814.                   getlayer
       % G5 e* }9 Y, k* u
12815.                   ;get_locked_layers ;function added and then removed by rk
       
12816.                   getltype
       ; f9 l) l* k4 \! ^5 w0 p
12817.                   getprops
       ! r+ ?: c# h7 c' J
12818.                   getscale          ;function added by rk
       
12819.                   GETSTYLE          ;function added by rk
       " T( F7 u4 w/ q1 k& Y
12820.                   getthickness
       
12821.                   GETWIDTH          ;function added by rk
       : y3 K. F0 b/ W+ t* D/ G* p
12822.                   globals
       9 Z: V1 Z; Y8 N
12823.                   HAIR_STYLE_LIST   ;var added by rk
       
12824.                   height
       ' Z" l" l+ `# D- [
12825.                   index
       
12826.                   item
       
12827.                   item1
       
12828.                   item2
       9 T9 r3 Z4 h9 J  Q* {& f2 q% U3 j  r
12829.                   itemlist
       ) Y5 @' V( d% N( J( G+ g$ T' t
12830.                   lay-idx
       3 l! x2 Q# @# ]# V' f4 M" c
12831.                   layedit_act
       ( }1 c6 p8 A1 X4 g
12832.                   layer
       
12833.                   layinfo
       7 {$ F- [" ^. D. _6 K" s; m' _
12834.                   laylist
       
12835.                   laylist_act
       
12836.                   layname
       
12837.                   laynmlst
       ' Q" P( g& E% r3 \2 C
12838.                   layvalue
       , f. ]7 m+ w1 ]. o* T
12839.                   linetype
       
12840.                   list1
       
12841.                   longlist
       & a2 [/ t* G. T0 u+ y- G
12842.                   lt-idx
       1 H* M( Y2 u# G9 {( F
12843.                   ltabstr
       
12844.                   ltedit_act
       
12845.                   ltidx
       ( {5 y5 c  P# j0 o( e: S0 Q
12846.                   ltlist
       
12847.                   ltlist1
       
12848.                   ltlist_act
       ! D/ S! M9 e2 V+ F/ t
12849.                   ltname
       
12850.                   ltnmlst
       & j7 R2 `) c7 U+ `
12851.                   ltvalue
       5 ^* J7 i% }5 C8 s1 D
12852.                   ltype
       , ]. V$ n" X$ Y% t4 z' |$ K% C# n
12853.                   m
       $ d. x! }: X' K6 `6 j0 B& u
12854.                   makelaylists
       
12855.                   makeltlists
       * s, W% ]4 }5 ~" E! n
12856.                   match-col
       ' m# I1 `0 l2 X
12857.                   ;match-etype          ;function removed by rk
       
12858.                   match-in
       
12859.                   match-lay
       
12860.                   match-lt
       & V% T" e; P. |
12861.                   match-lts
       
12862.                   match-th
       8 i! B- n* n0 l/ l0 E$ d
12863.                   match_col
       + \# e# u( a: O4 v! F; Z) |1 H
12864.                   mdashlist
       
12865.                   ;MPOPLST               ;function added and then move to ac_bonus.lsp by rk
       1 |6 N' D2 C; b- Z/ ~) P: t
12866.                   n
       + m: }: `% n6 \
12867.                   name
       5 i8 X' s% B) _, s
12868.                   ncolor
       
12869.                   nlayer
       
12870.                   nltype
       * B" V$ U* Q. n) K
12871.                   nthickness
       
12872.                   off
       7 N; g% n  m0 ]. l. O+ q3 i0 S9 B
12873.                   old-idx
       
12874.                   olderr
       
12875.                   on
         q+ q+ |# n6 p2 @
12876.                   onoff
       1 Z( ?8 M# I' t$ Y5 o
12877.                   patlist
       # f; R* V0 X# a* V4 P
12878.                   pattern
       + |6 F7 o" Y+ H0 E5 p3 c
12879.                   PL_WIDTH_GETTER       ;function added by rk
       - b% H" {  F3 t1 l4 Z3 j
12880.                   POLY_SS               ;var added by rk
       
12881.                   ;POSITION              ;function added by rk and then moved to ac_bonus.lsp
       
12882.                   proplist
       , B9 M5 W  D) i9 a5 L' {2 d
12883.                   reset-lay
       / L  ]2 ]9 A/ x5 t/ u
12884.                   reset-lt
       
12885.                   s
       
12886.                   selset
       . Y) Q7 r9 B. }: Y/ t  W; Y0 R3 }
12887.                   set_col_tile
       $ I( d1 Q: M% \1 `( Z
12888.                   sortlist
       . o' M/ z. x3 c, u+ m
12889.                   ss
       . d) c  C3 |" A7 o$ g
12890.                   ss_in_current_space  ;function add by rk.
       
12891.                   ss-index
       
12892.                   ss-length
       ( p; I7 X5 ?4 s; {) \
12893.                   ;ss_remove_locked     ;function added and then removed by rk.
       
12894.                   sslen
       
12895.                   temp_color
       
12896.                   templist
       
12897.                   test-main-ok
       
12898.                   test-ok
       
12899.                   testidx
       
12900.                   testlay
       
12901.                   th-value
       
12902.                   thickness
       
12903.                   tile
       
12904.                   tile_rect
       * C% f* p* `0 J+ ]
12905.                   tilemode
       
12906.                   ;TNLIST           ;function removed and moved to ac_bonus.lsp by rk
       
12907.                   TXT_SS            ;var added by rk
       $ p* p7 j* @. S! z7 U. U% e  g$ u
12908.                   ;undo_init        ;removed by rk.
       
12909.                   vi
       + g2 \! a( `  k2 o+ S  V1 K
12910.                   vpf
       
12911.                   vpldata
       
12912.                   vpn
       ) \; Q% ?3 D3 f" O9 s) i
12913.                   which_tiles
       
12914.                   width
       ( G# M) j8 i2 Q5 x5 @0 d; q3 u" S: o
12915.                   x
       
12916.                   x1
       
12917.                   x2
       6 Q% A; w$ h- [
12918.                   xdlist
       
12919.                   y
       
12920.                   y1
       7 t: K1 s" M# R: Z; h. Y
12921.                   y2
       
12922.                 )
       
12923. 
       ! N3 ]- C  _; M! I  D7 t
12924.   (if (and (not init_bonus_error)
       ) j. ^5 P9 _, d$ p, d& E3 D
12925.            (equal -1 (load "ac_bonus.lsp"  -1))
       
12926.       );and
       
12927.       (progn (alert "Error:\n     Cannot find AC_BONUS.LSP.")(exit))
         n1 c: e9 f2 I) k7 ?* |" t
12928.   );if
       
12929.   (init_bonus_error (list
       
12930.                      (list   "cmdecho" 0
       5 u: f/ j& A9 f# t6 R
12931.                            "highlight" 0
       
12932.                            "regenmode" 1
       
12933.                              "ucsicon" 0
       * y' [' n8 I/ o8 Y  r) E! ~' X
12934.                      )
       6 x( R: w+ N- \8 W
12935.                      T     ;flag. True means use undo for error clean up.                    
       
12936.                     );list  
       % Q3 e; w) m! G" `  |. ]
12937.   );init_bonus_error
       
12938. 
       
12939.   (cond
       % v6 w1 ]8 a* h. u9 O
12940.      (  (not (ai_notrans)))                       ; Not transparent?
       
12941.      (  (not (ai_acadapp)))                       ; ACADAPP.EXP xloaded?
       
12942.      (  (not (setq dcl_id (ai_dcl "exchprop")))) ; is .DCL file loaded?
       
12943.      (  (not (setq ss (ddchprop2_select))))       ; objects to modify?
       
12944.      (t
       1 @9 V7 F/ V0 j- A) ~, S" s/ G* W
12945.         ;(ai_undo_push)
       ( J. H; `. L" W' H; @2 E
12946.         (ddchprop2_init)                          ; Everything's cool,
       
12947.         (call_chp2)                               ; so proceed!
       
12948.         ;(ai_undo_pop)
       
12949.      )
         @( W0 f3 p. E
12950.   );cond close
       
12951. 
       * F6 K; z7 ^2 I# i
12952.   (restore_old_error)
       
12953. 
       
12954. (princ)
       2 u0 Y" F) w' c) q
12955. );defun ddchprop2
       
12956. 
       
12957. ;;;----------------------------------------------------------------------------
       
12958. 
       
12959. (princ "   EXCHPROP loaded.")
       
12960. (princ)
       
12961. 
       9 y: p2 Q9 Q' d6 M8 z# G' z' Z
12962. ;;;----------------------------------------------------------------------------
       
12963. ;;;---------------------------------DDCOLOR_LSP--------------------------------
       
12964. ;;;----------------------------------------------------------------------------
       
12965. 
       
12966. ; Next available MSG number is    24
       
12967. ; MODULE_ID DDCOLOR_LSP_
       ! O. Y5 P  E! a5 `" T& z+ U* x
12968. ;;;
       
12969. ;;;    ddcolor.lsp
       8 y6 G4 p( B! F
12970. ;;;   
       
12971. ;;;    Copyright 1990, 1992, 1994, 1996 by Autodesk, Inc.
       
12972. ;;;
       
12973. ;;;    Permission to use, copy, modify, and distribute this software
       1 v& A8 X. {/ M! V. t
12974. ;;;    for any purpose and without fee is hereby granted, provided
       2 T& R1 k, X$ l# Y! r3 J
12975. ;;;    that the above copyright notice appears in all copies and
       
12976. ;;;    that both that copyright notice and the limited warranty and
       & @, V" ^9 E$ G. ]- m" x: }% `& i
12977. ;;;    restricted rights notice below appear in all supporting
       % {$ T: R. X: Z4 M/ v" e
12978. ;;;    documentation.
       
12979. ;;;
       ' q# L) L& |6 M% e5 b
12980. ;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
       
12981. ;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
       
12982. ;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
       
12983. ;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
       
12984. ;;;    UNINTERRUPTED OR ERROR FREE.
       3 R2 f2 ^( c$ y/ P. l
12985. ;;;
       
12986. ;;;    Use, duplication, or disclosure by the U.S. Government is subject to
       
12987. ;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
       8 N! ]0 `5 @8 E$ v. w6 z6 r
12988. ;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
       
12989. ;;;    (Rights in Technical Data and Computer Software), as applicable.
       
12990. ;;;
       ( K4 n; N1 n. z, ^5 H5 }
12991. ;;;.
       
12992. ;;;
       
12993. ;;;----------------------------------------------------------------------------
       $ D4 U9 t' V  _. \; }# ~
12994. ;;;    DESCRIPTION
       
12995. ;;;     
       
12996. ;;;    Chromatic Pallete style color selection dialog.
       
12997. ;;;   
       
12998. ;;;    Globals:
       
12999. ;;;   
       + R0 Z' x8 n2 \3 u% \! H2 `! A
13000. ;;;          chroma_color - Integer color index.  The last value selected
       
13001. ;;;              by the user in chroma dialog.  It is not cleared or reset
       ( ]" S- S# }) e; D6 U6 g/ y8 o7 c& d+ m
13002. ;;;              by a cancel.  Only used for communication between callback
       
13003. ;;;              functions and the (chroma) funciton.
       
13004. ;;;   
       
13005. ;;;    Depends on the definitions for the dialog provided in chroma.dcl.
       * u, B' L$ R" i7 _0 P$ z( O* ~+ W
13006. ;;;   
       % v4 W+ ?7 P/ y, Z4 t+ j. B
13007. ;;;
       
13008. ;;; C:DDCOLOR -- Dialogue front end to the CECOLOR sysvar.  Uses the chroma
       / x2 |' S5 ?  c) A3 Q# w  @4 B
13009. ;;; pallete style color selector.
       ( a! i" `! V$ p% u9 l- d
13010. ;;;
       0 }# {# b8 z! u* k
13011. ;;; ===========================================================================
       
13012. ;;; ===================== load-time error checking ============================
       
13013. ;;;
       
13014. 
       
13015.   (defun ai_abort (app msg)
       7 h: t4 n" H1 \% G' S5 M
13016.      (defun *error* (s)
       " Q. U- h1 n& u2 _+ s
13017.         (if old_error (setq *error* old_error))
       
13018.         (princ)
       
13019.      )
       + K# f# j! {' V: M
13020.      (if msg
       
13021.        (alert (strcat " Application error: "
       
13022.                       app
       % M3 O' H7 b# m1 |! Z* e8 r
13023.                       " \n\n  "
       
13024.                       msg
       9 Y4 }9 i9 J0 {. p
13025.                       "  \n"
       3 c! c# V6 J( f9 q  {( m# F9 G: [
13026.               )
       2 U/ G* G5 M  Y: r  n
13027.        )
       . R, S: M' o4 {4 O. z: M) F3 U5 l1 X
13028.      )
       7 c" A( Z' w; s  K  E- K' ]
13029.      (exit)
       
13030.   )
       
13031. 
       
13032. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
       
13033. ;;; and then try to load it.
       
13034. ;;;
       9 Z7 F+ C1 @* d" U9 T: K, c
13035. ;;; If it can't be found or it can't be loaded, then abort the
       
13036. ;;; loading of this file immediately, preserving the (autoload)
       ) B% e8 V; W* p, Z4 v1 g0 t5 w" W
13037. ;;; stub function.
       1 H6 e7 ]2 K2 ?' A# m( k" ^0 U  M) W
13038. 
       7 U" D; [3 k* Z* u; {
13039.   (cond
       & X. {: o+ i: d- w
13040.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
       
13041. 
       
13042.      (  (not (findfile "ai_utils.lsp"))                     ; find it
       - }  }. s6 m* ~# @5 @7 b3 c0 }
13043.         (ai_abort "DDCOLOR"
       / y5 B8 Z3 r/ C6 n. f
13044.                   (strcat "Can't locate file AI_UTILS.LSP."
       1 \5 w: C0 @6 u; Q$ F# B
13045.                           "\n Check support directory.")))
       
13046. 
       * {9 m* _4 I3 ^6 B
13047.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
       8 i4 R' z7 n  E' S0 A4 A
13048.         (ai_abort "DDCOLOR" "Can't load file AI_UTILS.LSP"))
       . K# K; M2 y* m
13049.   )
       * b: B( u7 [5 M
13050. 
       
13051.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
       3 D% _( A+ y4 Y2 ^- Y- t  g
13052.       (ai_abort "DDCOLOR" nil)         ; a Nil <msg> supresses
       
13053.   )                                    ; ai_abort's alert box dialog.
       
13054. 
       
13055. ;;; ==================== end load-time operations ===========================
       4 k, r+ {; {! }: h' i, \- }' p
13056. 
       
13057. (defun c:ccc (/ co_oce clrx co_err co_oer lay_clr)
       + l3 |/ C7 Z9 k, \& [$ V2 n
13058. 
         o9 N. C# r: R- t" P8 _  J7 r
13059.   ;; Main Color function, called by setup code.
       
13060.   (defun ddcolor_main()
       
13061. 
       
13062.     (graphscr)
       
13063.   
       , Z. C. r% H" t! \6 ?6 @5 }: u
13064.     ;; Get the color of the current layer, for possible BYLAYER color swatch.
       & S" B4 J, Z( _% [- Z' P0 t  z
13065.     (setq lay_clr (cdr (assoc 62 (tblsearch "layer" (getvar "clayer")))))
       
13066. 
       
13067.     ;; Call the dialog here...
       
13068.     (setq clr (acad_colordlg (cstoci (getvar "cecolor")) T lay_clr))
       7 V2 @" l7 X6 C5 b# L1 |
13069. 
       
13070.     (if clr
       
13071.       (setvar "CECOLOR" (citocs clr)))
       4 s8 R/ F; y( w1 O2 E
13072.   )
       * Q% S+ y/ S0 P8 P) w' [
13073. 
       
13074.   ;;;
       5 }/ t3 k+ L/ h" I$ Y7 V4 E, {
13075.   ;;; CSTOCI -- Color string to color index
       2 }( u* U+ r/ l& X- Y5 t! G* ~
13076.   ;;;   Convert an arbitrary case string into a color index.
       
13077.   ;;;   Returns nil if string is not a valid color.
       4 q  t. G) u8 l
13078.   ;;;
       
13079.   (defun cstoci (str)
       3 ^( a. G4 p9 P; |6 L
13080.     (setq str (strcase str))
       
13081.     (cond
       / P  A) m( E$ o- c, H
13082.      ((= str "RED")        1)
       6 E) E/ M1 K! `: Q- r8 y
13083.      ((= str "YELLOW")     2)
       
13084.      ((= str "GREEN")      3)
       
13085.      ((= str "CYAN")       4)
       ' \7 c0 k3 S) `! x: q. ^
13086.      ((= str "BLUE")       5)
       
13087.      ((= str "MAGENTA")    6)
       
13088.      ((= str "WHITE")      7)
       
13089.      ((= str "BYLAYER")  256)
       4 q+ E7 K; H5 d+ O/ j: c3 b5 Q9 U
13090.      ((= str "BYBLOCK")    0)
       
13091.      ((= str "BY LAYER") 256)
       5 a3 o, u- Q2 N' X/ h; N
13092.      ((= str "BY BLOCK")   0)
       7 e4 v, m/ k5 f
13093.      ((and (< 0 (atoi str)) (> 256 (atoi str))) (atoi str))
       
13094.      (nil))
       
13095.   )
       : s% X; S# b/ o9 d- v( p- X
13096. 
       % V7 u, b, D6 _3 F9 m
13097. 
       
13098.   ;;;
       
13099.   ;;; CITOCS -- Convert color index into standard color name.
       
13100.   ;;;    Will return the standard and logical color names as text
       
13101.   ;;;    strings.  Returns nil for out-of-range color indicies.
       2 Q' ?- d( J! q: I' p3 T
13102.   ;;;
       3 s7 Q+ j; S/ e; w1 K: B
13103.   (defun citocs(i)
       
13104.     (cond
       
13105.      ((= i 0)   "BYBLOCK")
       
13106.      ((= i 1)   "red")
       2 P' T8 A" \+ {1 [: c0 V# ]
13107.      ((= i 2)   "yellow")
       7 r$ n9 y+ b$ u/ @7 f+ ]2 v+ U" p
13108.      ((= i 3)   "green")
       
13109.      ((= i 4)   "cyan")
       
13110.      ((= i 5)   "blue")
       8 n2 ^9 Y" N5 G
13111.      ((= i 6)   "magenta")
       & e- e5 g+ K) {+ j
13112.      ((= i 7)   "white")
       6 P. D) b1 Y9 O( a" A- `
13113.      ((= i 256) "BYLAYER")
       * R: L- H1 h) p2 C$ w
13114.      ((and (< 0 i) (> 256 i)) (itoa i))
       ' z5 }% l' o. B% n" s" l2 t% C7 b
13115.      (nil))
       
13116.   )
       * s& L+ }/ i, R; {
13117. 
       - J# X. a. ~. f0 S6 Q& ~
13118.   ;; Start of ddcolor
       ( S/ u' R- \/ n: b) E  R
13119.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
       : E! k6 b* L. g. y
13120.         old_error  *error*            ; save current error function
       ( u4 I$ G* A4 @. w& a2 l9 y
13121.         *error* ai_error              ; new error function
       
13122.   )
       4 b" D6 F+ h: m9 S' F
13123. 
       6 I/ V! Y6 v. ?8 C' ^
13124.   (setvar "cmdecho" 0)
       
13125. 
       " k# `" m# P/ E" N  L
13126.   (cond
       $ V1 L& O1 K. {
13127.      (  (not (ai_trans)))                        ; transparent OK
       
13128.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
       
13129. 
       % o8 c5 D6 H* ]8 x$ ?+ i8 E
13130.      (t (if (and (/= 1 (logand 1 (getvar "cmdactive")))
       
13131.                  (/= 8 (logand 8 (getvar "cmdactive")))
       $ X- i' L5 {/ t, _- j
13132.             )
       3 O8 P; r3 D  t" _, t5 d# k
13133.          (ai_undo_push)
       ! v$ ]+ I( i! m5 c/ j4 s
13134.         )
       
13135. 
       
13136.         (ddcolor_main)                          ; proceed!
       ( m: R5 \2 l+ t
13137. 
       
13138.         (if (and (/= 1 (logand 1 (getvar "cmdactive")))
       : [, e) \2 d' m6 h, A, F. g$ W$ [
13139.                  (/= 8 (logand 8 (getvar "cmdactive")))
       ) ~- P9 F( O# }: [. d; k" y
13140.             )
       
13141.          (ai_undo_pop)
       
13142.         )
       9 R+ Q, d5 y) l- ~
13143.      )
       8 I: E9 n% |  O
13144.   )
       / h; R5 I  ~8 o% h& Y: w4 U5 i
13145. 
       1 @, C# m! F9 E5 a
13146.   (setq *error* old_error)
       9 x6 S& x/ W! c& y! T2 d; z  E/ C3 k7 ?
13147.   (setvar "cmdecho" old_cmd)
       ; |! D; l6 T- G4 ~+ F& D8 Z
13148.   (princ)
       
13149. 
       
13150. )
       " u8 a3 `. m6 T# b" o) d
13151. 
       
13152. ;;;----------------------------------------------------------------------------
         b8 K0 r# M& ~+ u! R; p5 z; ~
13153. 
       8 b4 n6 u, C" o4 A/ m3 o
13154. (princ "  DDCOLOR loaded.  ")
       
13155. (princ)
       
13156. 
       
13157. ;;;--------------------------------------------------------------------------;
       4 ~7 `9 k8 \) w2 z+ E- a- l4 D
13158. ;;;---------------Chon NHANH Nhieu Doi Tuong GIONG THUOC TINH----------------;
       
13159. ;;;--------------------------------------------------------------------------;
       
13160. ;;;   ssx.lsp
       
13161. ;;;   Copyright (C) 1990 by Autodesk, Inc.
       1 Z% z# g% b6 ^& p& k4 p8 i8 o2 w4 d) B
13162. ;;;   Copyright (C) 1991 by Control Systems, Inc.
       
13163. ;;;
       & {( z! ^# l# r+ K; R# x
13164. ;;;   Permission to use, copy, modify, and distribute this software and its
       8 C" K/ M% L* `9 w
13165. ;;;   documentation for any purpose and without fee is hereby granted.
       
13166. ;;;
       
13167. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.
       ' o! J$ @3 Q$ z: W2 S3 n% ]' t( y
13168. ;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
       8 c. V* e6 \: H3 ^
13169. ;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
       
13170. ;;;
       
13171. ;;;   Larry Knott                        Version 2.0    7/18/88
       
13172. ;;;   Carl Bethea & Jan S. Yoder         Version 3.0
       
13173. ;;;   Enhancements to (ssx).
       8 `3 N- l1 i: e- L0 T9 x
13174. ;;;   15 March 1990
       
13175. ;;;
       
13176. ;;;   ARTIST Software, Inc               Version 4.0   December 1991
       ! Y% @4 Q0 \3 U, M- q' M
13177. ;;;   Modified for FLEXICON usage. If the variable FLEXVAR = 1,
       
13178. ;;;   use Flexicon menus
       
13179. ;;;
       9 b  Q& }2 F; o' F9 m8 }( Z( o* a
13180. ;;;--------------------------------------------------------------------------;
       
13181. ;;; DESCRIPTION
       
13182. ;;;                              SSX.LSP                                 
       1 L+ [# \# z- d( H5 _: ?1 N
13183. ;;;                                                                          
       
13184. ;;;   "(SSX)" -  Easy SSGET filter routine.                                    
       
13185. ;;;                                                                           
       
13186. ;;;   Creates a selection set.  Either type "SSX" at the "Command:" prompt   
       : o# E4 K( ~* Q  `7 ]) h# F
13187. ;;;   to create a "previous" selection set or type "(SSX)" in response to
       , r/ k, x# ^( u6 W4 Z
13188. ;;;   any "Select objects:" prompt.  You may use the functions "(A)" to add
       
13189. ;;;   entities and "(R)" to remove entities from a selection set during
       
13190. ;;;   object selection.  More than one filter criteria can be used at a
       
13191. ;;;   time.         
       4 s3 w+ {% I6 v$ S
13192. ;;;                                                                          
       
13193. ;;;   SSX returns a selection set either exactly like a selected
       7 i; G$ _6 A+ m2 w: x
13194. ;;;   entity or, by adjusting the filter list, similar to it.
       
13195. ;;;
       8 \  ^1 A( u; c4 Y5 d
13196. ;;;   The initial prompt is this:
       
13197. ;;;   
       4 D) |. U+ c0 i
13198. ;;;     Command: ssx
       : Q9 i$ m( ?7 Y  N
13199. ;;;     Select object/<None>: (RETURN)
       # |! d& B9 A! ]/ Z" f% n( |
13200. ;;;     >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
       
13201. ;;;   
       ' ?) z, U* l  Y1 A! H5 U& V
13202. ;;;   Pressing RETURN at the initial prompt gives you a null selection
       
13203. ;;;   mechanism just as (ssx) did in Release 10, but you may select an
       2 H" ]$ m' `3 i6 r/ s
13204. ;;;   entity if you desire.  If you do so, then the list of valid types
       
13205. ;;;   allowed by (ssget "x") are presented on the command line.
       
13206. ;;;   
       
13207. ;;;     Select object/<None>:  (a LINE selected)
       & O+ h+ L( D7 h8 S9 k# _4 s% K
13208. ;;;     Filter: ((0 . "LINE") (8 . "0") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
       ( H) Z6 G$ t9 @( S
13209. ;;;     >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
       6 G2 u/ H& ]) ^
13210. ;;;   
       
13211. ;;;   At this point any of these filters may be removed by selecting the
       - U6 B1 c2 d3 l4 I
13212. ;;;   option keyword, then pressing RETURN.
       
13213. ;;;   
       2 u3 M) h) T/ e: D" g
13214. ;;;     >>Layer name to add/<RETURN to remove>: (RETURN)
       6 g. a; V- ?$ h- V7 c
13215. ;;;         
       
13216. ;;;     Filter: ((0 . "LINE") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
       - X; c: W8 q1 Q1 Y  d& M( C
13217. ;;;     >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
       
13218. ;;;   
       % ?1 m5 {0 Y( }; D+ F5 D2 Q
13219. ;;;   If an item exists in the filter list and you elect to add a new item,
       / U" N  L( I) O6 @5 |- P
13220. ;;;   the old value is overwritten by the new value, as you can have only
       
13221. ;;;   one of each type in a single (ssget "x") call.
       2 z$ y5 N' m7 P/ z  X7 t
13222. ;;;
       # b) J) ?3 H! H2 w
13223. ;;;--------------------------------------------------------------------------;
       4 w  K" Y0 P2 j, F' _; D. J9 V
13224. ;;;
       
13225. ;;; Find the dotted pairs that are valid filters for ssget
       
13226. ;;; in entity named "ent".
       
13227. ;;;
       
13228. ;;; ssx_fe == SSX_Find_Entity
       
13229. ;;;
       
13230. (defun ssx_fe (/ x data fltr ent)
       
13231.   (if (and (= flexvar 1)(/= t2 "Pick"))
       1 _0 T+ D  g, k( W; M2 W, d
13232.    (setq ent nil)
       0 U$ F1 q" T8 S5 ?6 |& O
13233.    (setq ent (car (entsel "\nSelect object/<None>: ")))
       
13234.   )
       : Z( e3 c5 g. `. f, J! S2 j
13235.   (if ent
       : b$ M5 e$ p! @6 `- B& ~& I
13236.     (progn
       ) R  b5 `" I6 L2 a
13237.       (setq data (entget ent))
       
13238.       (foreach x '(0 2 6 7 8 39 62 66 210) ; do not include 38
       
13239.         (if (assoc x data)
       0 s9 ^4 ^. b8 [; o) ~* r
13240.           (setq fltr
       . d9 V  c5 e. \  j! \
13241.             (cons (assoc x data) fltr)
       % f4 z0 P! F/ N0 U
13242.           )
       % V5 u( ]' g- i/ j1 a& p9 d
13243.         )
       
13244.       )   
       ) n  @2 w9 z4 u, i7 d
13245.       (reverse fltr)
       
13246.     )
       
13247.   )
       
13248. )
       
13249. ;;;
       
13250. ;;; Remove "element" from "alist".
       : C, ]2 S4 U: S7 Y
13251. ;;;
       
13252. ;;; ssx_re == SSX_Remove_Element
       
13253. ;;;
       ! J. {9 D/ y- c( k7 x
13254. (defun ssx_re (element alist)
       1 n, [! G% r4 X, f' R5 g3 h' V) y
13255.   (append
       / N) u) ?' `$ i6 i
13256.     (reverse (cdr (member element (reverse alist))))
       2 r" L, \* z/ X& `- B: b
13257.     (cdr (member element alist))   
       
13258.   )
       
13259. )
       
13260. ;;;
       . x% o8 u7 q& L! X
13261. ;;; INTERNAL ERROR HANDLER
       ( `. b  b7 P( M, o0 B
13262. ;;;
       
13263. (defun ssx_er (s)                     ; If an error (such as CTRL-C) occurs
       
13264.                                       ; while this command is active...
       
13265.   (if (/= s "Function cancelled")
       
13266.     (princ (strcat "\nError: " s))
       
13267.   )
       
13268.   (if olderr (setq *error* olderr))   ; Restore old *error* handler
       # u$ R7 d8 q# U1 h
13269.   (setq flexvar 0)
       ; y6 d- @/ m! R5 A, c
13270.   (princ)
       - i" S; V" a9 X, d( P9 l  l
13271. )
       5 ?) C5 l! Y! S" w/ u
13272. ;;;
       % s: j- ~7 r$ R  M  Y
13273. ;;; Flexicon call routine
       
13274. ;;;
       5 E: }; i* k1 P' q1 O. }
13275. (defun flexmnu (a)
       
13276. (if (= flexvar 1)
       
13277.   (command "FLEXICON" (strcat "FLEX" a))
       & h% m3 E7 F4 V" P( n. T& s
13278. )
       
13279. )
       ) D: O" k8 J# V* ~
13280. 
       # g8 p. V4 `9 O# t* Q/ N3 |' G
13281. ;;;   
       / b# b0 V2 Q+ O: m' L
13282. ;;; Get the filtered sel-set.
       
13283. ;;;
       $ n+ u& j. V% _: Q6 p5 P- b
13284. ;;;
       5 d$ j: z! I% c' i
13285. (defun ssx (/ olderr)
       2 O! Q6 B6 S2 F6 H1 ?2 b; M
13286.   (gc)                                ; close any sel-sets            
       
13287.   (setq olderr *error*
       
13288.         *error* ssx_er
       3 \. V# r4 M, R5 O2 w
13289.   )
       6 o' u9 M  }2 C' z% F+ Z8 s2 O
13290.   (setq fltr (ssx_fe))
       
13291.   (ssx_gf fltr)
       & I" z) \0 \9 F) u, i0 P8 Z
13292.   (if (= flexvar 1)
       
13293.    (progn
       
13294.     (prompt "\n \n \nNow select the required EDIT command and (P)revious.")
       
13295.     (flexmnu "EDIT")
       
13296.    )
       
13297.    (command "p")
       
13298.   )
       
13299.   (princ)
       
13300. )
       
13301. ;;;
       * U' L: E2 J2 ~# R* s4 F8 C! K
13302. ;;; Build the filter list up by picking, selecting an item to add,
       
13303. ;;; or remove an item from the list by selecting it and pressing RETURN.
       5 ]& y3 o; `" u9 ~: g7 k$ }$ \
13304. ;;;
       
13305. ;;; ssx_gf == SSX_Get_Filters
       $ ~- P% O0 k; y: C; k: i2 w
13306. ;;;
       
13307. (defun ssx_gf (f1 / t1 t2 t3 f1 f2)
       5 i: S+ c6 @! K! N% L/ H
13308.   (while
       
13309.     (progn
       
13310.       (flexmnu "SSX")
       - w! T5 a) p9 E7 F( G* c4 M% `
13311.       (cond (f1 (prompt "\nFilter: ") (prin1 f1)))
       
13312.       (initget
       ! k! g% R6 j( t7 ]
13313.         "Block Color Entity Flag LAyer LType Pick Style Thickness Vector")
       1 X( L2 M& c" V* g
13314.       (setq t1 (getkword (strcat
       " o5 q8 R- Z6 D- ?
13315.         "\n>>Block name/Color/Entity/Flag/"
       
13316.         "LAyer/LType/Pick/Style/Thickness/Vector: ")))
       
13317.     )
       
13318.     (setq t2
       
13319.       (cond
       
13320.         ((eq t1 "Block")      2)   ((eq t1 "Color")     62)
       
13321.         ((eq t1 "Entity")     0)   ((eq t1 "LAyer")      8)
       ' W( c% a' u: x0 d7 ~! f1 w$ h; E, Q) e
13322.         ((eq t1 "LType")      6)   ((eq t1 "Style")      7)
       
13323.         ((eq t1 "Thickness") 39)   ((eq t1 "Flag" )     66)
       
13324.         ((eq t1 "Vector")   210)
       
13325.         (T t1)
       
13326.       )
       
13327.     )
       
13328.     (setq t3
       
13329.       (cond
       * h! r  ~3 f  @$ z" L& L* s
13330.         ((= t2  2)
       9 F4 j- T. u( c4 i
13331.          (if (= flexvar gtads 1)
       
13332.           (progn
       
13333.            (prompt "\n>>Block name to add/<RETURN to remove>: ")
       
13334.            (gttable "BLOCK")
       
13335.           )
       
13336.           (getstring "\n>>Block name to add/<RETURN to remove>: ")
       2 p- @  q- t* S+ E: v% M
13337.          )
       , y) U( f0 U+ C: l
13338.         )
       
13339.         ((= t2 62)  (initget 4 "?")
       
13340.           (cond
       * y9 _: j  D$ [$ s
13341.             ((or (eq (setq t3 (getint
       6 {' `, w; I1 B. G( l. F- S- R
13342.               "\n>>Color number to add/?/<RETURN to remove>: ")) "?")
       
13343.               (> t3 256))
       
13344.               (ssx_pc)                ; Print color values.
       
13345.               nil
       
13346.             )
       
13347.             (T
       
13348.               t3                      ; Return t3.
       
13349.             )
       ! I& w; U# ~" Z8 U7 G
13350.           )
       ! Z8 c& o" y1 F. ?, n8 Q
13351.         )
       
13352.         ((= t2  0) (getstring "\n>>Entity type to add/<RETURN to remove>: "))
       
13353.         ((= t2  8)
       
13354.          (if (= flexvar gtads 1)
       " S+ [' \2 l3 f
13355.           (progn
       
13356.            (prompt "\n>>Layer name to add/<RETURN to remove>: ")
       7 c4 E: J3 K7 P$ T, I, f( ^# i+ `2 E6 E
13357.            (gttable "LAYER")
       
13358.           )
       ' y3 w7 z, ~2 U, T: U4 o
13359.           (getstring "\n>>Layer name to add/<RETURN to remove>: ")
       / }9 C' ~. Y% F! u3 L& Z
13360.          )
       
13361.         )
       9 c4 x) B* J2 {, F% J( E4 }. N  X
13362.         ((= t2  6)
       
13363.          (if (= flexvar gtads 1)
       ! Y7 P/ e+ ?! w' q( A
13364.           (progn
       8 a9 h( J" X9 M" e
13365.            (prompt "\n>>Linetype name to add/<RETURN to remove>: ")
       # O4 |7 ]2 K5 S3 q0 U
13366.            (gttable "LTYPE")
       . B5 T) c1 ]. H- ?" ]: R" Z6 T7 Y
13367.           )
       
13368.          (getstring "\n>>Linetype name to add/<RETURN to remove>: ")
       0 D& j% H# D% G4 o% ~4 q9 e
13369.          )
       8 f- M) f" g1 F. ^# V
13370.         )
       
13371.         ((= t2  7)
       
13372.          (if (= flexvar gtads 1)
       0 c( H' w- R# E- h) m& b
13373.           (progn
       6 H- C+ u  T# X
13374.            (prompt "\n>>Text style name to add/<RETURN to remove>: ")
       
13375.            (gttable "STYLE")
       ; F3 i! X# v; n, g
13376.           )
       
13377.           (getstring "\n>>Text style name to add/<RETURN to remove>: ")
         \% O: e- Q4 j" H& H5 _& @
13378.          )
       ! H' t" z& B* g
13379.         )
       
13380.         ((= t2 39)
       
13381.            (prompt "\n>>Thickness to add/<RETURN to remove>: ")
       ( O8 H+ `; N/ c7 v- _  d: J* l
13382.            (if(= flexvar gtads 1)(gtfnum"Thickness to add:")(getreal))
       4 }7 s6 d& z2 b6 o8 m
13383.         )
       
13384.         ((= t2 66)  (if (assoc 66 f1) nil 1))
       1 K9 [5 k; N* B( p! m" |4 ~
13385.         ((= t2 210)
       
13386.           (getpoint  "\n>>Extrusion Vector to add/<RETURN to remove>: ")
       
13387.         )
       
13388.         (T          nil)
       
13389.       )
       
13390.     )
       
13391.     (cond
       
13392.       ((= t2 "Pick") (setq f1 (ssx_fe) t2 nil)) ; get entity
       
13393.       ((and f1 (assoc t2 f1))         ; already in the list
       * o4 K2 v/ R: i( o  ^
13394.         (if (and t3 (/= t3 ""))
       # l- {2 U/ W+ {4 J% u8 s
13395.           ;; Replace with a new value...            
       
13396.           (setq f1 (subst (cons t2 t3) (assoc t2 f1) f1))
         A/ b! T9 q/ Y0 x
13397.           ;; Remove it from filter list...
       / G# V9 Z: D" c% P2 ~4 d+ R# Q
13398.           (setq f1 (ssx_re (assoc t2 f1) f1))
       
13399.         )  
       5 q6 O  F9 y& Q# k" b6 B/ ~
13400.       )
       1 i3 K" t& m2 I; r, W
13401.       ((and t3 (/= t3 ""))
       
13402.         (setq f1 (cons (cons t2 t3) f1))
       
13403.       )
       
13404.       (T nil)
       
13405.     )
       
13406.   )
       ) A4 {4 D. S% Q. S) X3 s; R" @
13407.   (if f1 (setq f2 (ssget "x" f1)))
       ( ^$ b3 ~, @1 K  X
13408.   (setq *error* olderr)
       / _4 l' c5 a# f3 a
13409.   (if (and f1 f2)
       
13410.     (progn
       : t' b2 q1 k+ R7 I9 H$ h
13411.       (princ (strcat "\n" (itoa (sslength f2)) " found. "))
       ; k( T3 _, W( y9 z
13412.       f2
       
13413.     )
       
13414.     (progn (princ "\n0 found.") (prin1))
       ) I% ~, B& j9 j0 v( l5 M
13415.   )
       
13416. )
       
13417. ;;;
       
13418. ;;; Print the standard color assignments.
       
13419. ;;;
       : G9 k/ c& p& y( M3 {
13420. ;;;
       
13421. (defun ssx_pc ()
       + b+ [* j4 V0 ]1 C
13422.   (if textpage (textpage) (textscr))
       % C+ M8 B2 K* c! @6 |9 Q
13423.   (princ "\n                                                     ")
       
13424.   (princ "\n                 Color number   |   Standard meaning ")
         ?. b9 C) U+ x0 v8 P9 o
13425.   (princ "\n                ________________|____________________")
       / n8 Y3 K) Z) g  D! c$ l
13426.   (princ "\n                                |                    ")
       
13427.   (princ "\n                       0        |      <BYBLOCK>     ")
       5 n2 i& W! r) P& N4 V
13428.   (princ "\n                       1        |      Red           ")
       , t, c% Q  r+ |+ Z
13429.   (princ "\n                       2        |      Yellow        ")
       ( j; P  t& _2 @' o; b
13430.   (princ "\n                       3        |      Green         ")
       
13431.   (princ "\n                       4        |      Cyan          ")
       0 V  I6 D3 O8 |) L4 a% ^, P
13432.   (princ "\n                       5        |      Blue          ")
       4 Q+ N2 N1 p6 E; {7 i8 j1 L+ `" E$ G
13433.   (princ "\n                       6        |      Magenta       ")
       
13434.   (princ "\n                       7        |      White         ")
       
13435.   (princ "\n                    8...255     |      -Varies-      ")
       0 F# C7 i" M1 h# k
13436.   (princ "\n                      256       |      <BYLAYER>     ")
       ) q+ B7 o4 w; p! X7 Y
13437.   (princ "\n                                               \n\n\n")
       
13438. )
       
13439. ;;;
       
13440. ;;; C: function definition.
       
13441. ;;;
       
13442. (defun c:ssx () (ssx)(princ))
       5 N. V/ L. i7 ]
13443. (princ "\n\tType \"ssx\" at a Command: prompt or ")
       ; J/ I8 ?& T: I2 ^
13444. (princ "\n\t(ssx) at any object selection prompt. ")
       / J1 F% L+ C) ^, J1 P7 h; a
13445. (princ)
       
13446. 
       
13447. ;;;--------------------------------------------------------------------------;
       
13448. ;;;--------------------------------------------------------------------------;
       
13449. ;;;--------------------------------------------------------------------------;
       4 V5 K% ^$ a, N7 q% l2 K# ?1 b
13450. (defun S::STARTUP ()
       
13451. (setvar "cmdecho" 0)
       
13452. (setvar "cmdecho" 1)
       
13453. (setvar "LTSCALE" 10)
       ; `/ p( Z; s5 c, Q- Q0 D
13454. 
       
13455. ;(command "_load" "chenKH.fas")
       
13456. ;(command "_load" "ctcot.fas")
       6 T' n) |2 z( x, `* q  i
13457. ;(command "_load" "damdoc.fas")
       $ H7 Y" |" d3 J  |# M5 [2 m
13458. ;(command "_load" "ghichu.fas")
       
13459. ;(command "_load" "hamtutao.lsp")
       
13460. ;(command "_load" "KHOITAO.fas")
       ' q/ U" P, ^7 z) s% ^
13461. ;(command "_load" "KHthep.fas")
       
13462. ;(command "_load" "mbmong.dcl")
       
13463. ;(command "_load" "mbmong.fas")
       ( B* ~# c9 o6 c2 f
13464. ;(command "_load" "mccot.fas")
       
13465. ;(command "_load" "mcdam.fas")
       - \! j4 r1 c9 X' D
13466. ;(command "_load" "mcmong1.dcl")
       
13467. ;(command "_load" "mcmong1.fas")
       
13468. ;(command "_load" "mcmong2.dcl")
         D2 f: g( R# l8 W# F/ h
13469. ;(command "_load" "mcmong2.fas")
       - x3 e, k. N1 [' J- N& N
13470. ;(command "_load" "mcmong3.dcl")
       
13471. ;(command "_load" "mcmong3.fas")
       ! w9 K5 p6 v0 j: a, L
13472. ;(command "_load" "mcsan.fas")
       ' U& i( n1 |* G# u
13473. ;(command "_load" "thepdai.fas")
       
13474. ;(command "_load" "thepdoc.fas")
       
13475. ;(command "_load" "thepmb.fas")
       ! d+ V: U# U! y1 s
13476. ;(command "_load" "thepphbo.fas")
       
13477. (command "_script" "thongso.scr")
       5 A/ d4 [; P/ Y2 a
13478. ;(command "_load" "thongso1.dcl")
       & y! b7 S, Y$ e4 O$ O
13479. ;(command "_load" "thongso1.fas")
       
13480. ;(command "_load" "thongso2.dcl")
       
13481. ;(command "_load" "thongso2.fas")
       : M1 S: M& H& q+ Y
13482. ;(command "_load" "tietdien.fas")
       1 l( {3 Q5 f6 U0 _
13483. ;(command "_load" "vehan.fas")
       
13484. (command "_load" "phamDuy782006_TKT.lsp")
       
13485. (command "_load" "phamduy782006ganhtd.lsp")
       
13486. (command "_load" "phamduy782006ganhtds.lsp")
       
13487. (command "_load" "phamduy782006htd.dcl")
       
13488. (princ)
       ) \  Y0 @# T) a$ H  u( Q
13489. )
       ; d- d: v1 U  d  L6 i& F( n* n
13490. 
       9 y, j& V5 N7 Z1 K& w* u! C8 v
13491. ;; Silent load.
       . K5 A" b/ s8 T! r0 f$ V# z
13492. (princ)
       ( a, g. H* J% B: s( ]
13493. 
       
13494. 
       - X! h6 {7 ?" ], Z0 q
13495. ;; Silent load for the Express Tools.
         m; D4 \" x, p6 n
13496. ;; Altering this line will affect Express Tools functionality
       ; u2 a) P% o- Z* p
13497. (load "acettest.fas" (princ))
       # m- l# D6 K; ?  C* \8 E- P  F* l) r9 Q
13498. �32

Sao chép mã

00st Cách Thêm Menu & Lisp Vẽ & Fonts Chữ mở Gõ Chữ Administrator để Gõ