Topic: [XDrX-PlugIn(36)] Hole (circle) statistical details table

[xdcad]

Code - Auto/Visual Lisp: [Select]

1. ;|
2. Plug-in name: Circle statistics table
3. Author: XDSoft
4. Running environment: XDRX API / XD Toolbox
5. Release time: 2016-10-15
6. Plug-in introduction: Count circles and group numbers to generate tables
7. Command name: XDTB_TJCir
8. |;
9. (defun c:XDTB_TJCir (/      #height       class1 class2 ents   lst
10.                      pt     ss     str1   str2   tlst2  val    x
11.                      y
12.                     )
13.   (defun _maketable (lst)
14.     (if (setq pt (getpoint "\nTable Insert Postion<Exit>:"))
15.       (progn
16.         (setq lst (xd::table:celltile
17.                     (list "Number" "Coding" "Aperture" "Coord X" "Coord Y")
18.                     1
19.                     lst
20.                   )
21.               lst (cons (list "Hole Number Table" nil nil nil nil) lst)
22.         )
23.         (XD::Table:MakeFromList
24.           lst
25.           (trans pt 1 0)
26.           #xd_var_text_height
27.           (/ #xd_var_text_height 2.0)
28.         )
29.         (xdrx-setpropertyvalue (entlast) "color" 7)
30.       )
31.     )
32.     (princ)
33.   )
34.   (defun _format (val)
35.     (xdrx_string_regexpr "(?<=\\.[0-9]+)0{1,}$" val "")
36.   )
37.   (defun _write (lst)
38.     (setq tlst2 nil)
39.     (setq class1 "A")
40.     (mapcar
41.       '(lambda (x)
42.          (setq class2 "0")
43.          (mapcar
44.            '(lambda (y /)
45.               (setq
46.                 str1 (strcat class1
47.                              (setq class2 (itoa (1+ (atoi class2))))
48.                      )
49.               )
50.               (xdrx_text_make
51.                 (cadr y)
52.                 str1
53.                 #xd_var_text_height
54.                 (xd::ucs:angle)
55.               )
56.               (XD::Text:AdjustAlignMent (entlast) 1 2)
57.               (xdrx_entity_move
58.                 (entlast)
59.                 (trans (xd::geom:get9pt (entlast) 5) 1 0)
60.                 (cadr y)
61.               )
62.               (setq str2 (strcat "&#934;"
63.                                  (rtos (* 2 (last y)) 2 #xd_var_text_bits)
64.                          )
65.                     y    (trans (cadr y) 0 1)
66.               )
67.               (setq tlst2 (cons (list str1
68.                                       str2
69.                                       (_format (rtos (car y) 2 4))
70.                                       (_format (rtos (cadr y) 2 4))
71.                                 )
72.                                 tlst2
73.                           )
74.               )
75.             )
76.            x
77.          )
78.          (setq class1 (chr (1+ (ascii class1))))
79.        )
80.       lst
81.     )
82.     (_maketable (reverse tlst2))
83.   )
84.   (if (not #xd_var_text_height)
85.     (setq #xd_var_text_height 3.5)
86.   )
87.   (if (setq
88.         val (getreal
89.               (xdrx_prompt "\nText Height<" #xd_var_text_height ">:" t)
90.             )
91.       )
92.     (setq #xd_var_text_height val)
93.   )
94.   (if (not #xd_var_text_bits)
95.     (setq #xd_var_text_bits 1)
96.   )
97.   (if (setq val (getint
98.                   (xdrx_prompt
99.                     "\nEnter the number of decimal places<"
100.                     #xd_var_text_bits
101.                     ">:"
102.                     t
103.                   )
104.                 )
105.       )
106.     (setq #xd_var_text_bits val)
107.   )
108.   (if (setq ss (xd::ssget "\nSelect the circle of statistics <Exit>"
109.                           '(((0 . "circle")))
110.                )
111.       )
112.     (progn
113.       (xdrx_begin)
114.       (xdrx_sysvar_push '("dimzin" 0))
115.       (setq ents
116.              (mapcar
117.                '(lambda (x)
118.                   (list
119.                     (xdrx_getpropertyvalue x "area")
120.                     (cons x (xdrx_getpropertyvalue x "center" "radius"))
121.                   )
122.                 )
123.                (xdrx_pickset->ents ss)
124.              )
125.       )
126.       (setq ents (xd::list:groupbyindex ents 0.0))
127.       (setq ents (vl-sort ents '(lambda (x y) (< (car x) (car y)))))
128.       (setq ents
129.              (mapcar
130.                '(lambda (x)
131.                   (setq y (cdr x))
132.                   (vl-sort
133.                     y
134.                     '(lambda (x1 y1)
135.                        (< (car (xdrx_getpropertyvalue (car x1) "center"))
136.                           (car (xdrx_getpropertyvalue (car y1) "center"))
137.                        )
138.                      )
139.                   )
140.                 )
141.                ents
142.              )
143.       )
144.       (xd::text:init 1)
145.       (_write ents)
146.       (xdrx_end)
147.     )
148.   )
149.   (princ)
150. )
151.