Topic: [XDrX-PlugIn(35)] Polyline coordinate point information statistics table

[xdcad]

Code - Auto/Visual Lisp: [Select]

1. (defun c:XDTB_PLSegList (/ #xd_table_res_z _lengths _format _writebulges _mergecell bulge bulges
2.                          verts i j c val lens lst r gl g
3.                         )
4.   (defun _lengths ()
5.     (setq g  (xdge::constructor e)
6.           gl (xdge::getpropertyvalue g "getcurvelist")
7.     )
8.     (setq lens (mapcar '(lambda (x) (xdge::getpropertyvalue x "length"))
9.                        gl
10.                )
11.     )
12.     (xdge::free g gl)
13.     lens
14.   )
15.   (defun _writebulges (tb)
16.     (setq rows (xdrx_table_numrows tb))
17.     (setq i 3
18.           j 0
19.     )
20.     (while (< i (1- rows))
21.       (setq bulge (_format (nth j bulges) 4))
22.       (if (= bulge "0.0")
23.         (setq bulge "")
24.       )
25.       (xdrx_setpropertyvalue
26.         tb
27.         "textstring"
28.         (list (list i 4 bulge) (list i 5 (_format (nth j lens) #xd_table_txt_bits)))
29.         "textheight"
30.         (list (list i 4 #xd_table_txt_height)
31.               (list i 5 #xd_table_txt_height)
32.         )
33.       )
34.       (setq j (1+ j)
35.             i (+ i 2)
36.       )
37.     )
38.   )
39.   (defun _format (str bit)
40.     (if (equal str 0.0 1e-3)
41.       "0.0"
42.       (rtos str 2 bit)
43.     )
44.   )
45.   (defun _mergecell (tb startCol endCol startRow)
46.     (setq rows (xdrx_table_numrows tb))
47.     (setq c startCol)
48.     (while (<= startCol c endCol)
49.       (setq r startRow)
50.       (while (< r (1- rows))
51.         (xdrx_table_mergecells tb r (1+ r) c c)
52.         (setq r (+ 2 r))
53.       )
54.       (setq c (1+ c))
55.     )
56.   )
57.   (xdrx_begin)
58.   (xdrx_sysvar_push '("dimzin" 0))
59.   (if (= 1 (xdrx_yesorno "\nKeep Z Coordinate" 0))
60.     (setq #xd_table_res_z t)
61.   )
62.   (if (not #xd_table_txt_height)
63.     (setq #xd_table_txt_height 3.5)
64.   )
65.   (if (setq val (getreal (xdrx_prompt "\nText Height<" #xd_table_txt_height ">:" t)
66.                 )
67.       )
68.     (setq #xd_table_txt_height val)
69.   )
70.   (if (not #xd_table_txt_bits)
71.     (setq #xd_table_txt_bits 1)
72.   )
73.   (if (setq val (getint
74.                   (xdrx_prompt "\nKeep the number of decimal places for lengths<" #xd_table_txt_bits ">:" t)
75.                 )
76.       )
77.     (setq #xd_table_txt_bits val)
78.   )
79.   (if (setq e (car (xdrx_entsel
80.                      "\nPick a Polyline<Exit>:"
81.                      '((0 . "LWPOLYLINE"))
82.                    )
83.               )
84.       )
85.     (progn (setq verts  (xdrx_getpropertyvalue e "vertices" "bulges")
86.                  lens   (_lengths)
87.                  bulges (cadr verts)
88.                  verts  (car verts)
89.            )
90.            (setq lst (mapcar '(lambda (x)
91.                                 (list (_format (car x) 4)
92.                                       (_format (cadr x) 4)
93.                                       (_format (caddr x) 4)
94.                                       ""
95.                                       ""
96.                                 )
97.                               )
98.                              verts
99.                      )
100.            )
101.            (setq lst (xd::table:celltile
102.                        '("Number" "Coord X" "Coord Y" "Coord Z" "Bulge" "Length")
103.                        1
104.                        lst
105.                      )
106.            )
107.            (setq i   0
108.                  lst (mapcar '(lambda (x)
109.                                 (if (= i 0)
110.                                   (progn (setq i (1+ i)) (list x))
111.                                   (list x x)
112.                                 )
113.                               )
114.                              lst
115.                      )
116.                  lst (cons (list "Polyline Coordinate information table" nil nil nil nil nil)
117.                            (apply 'append lst)
118.                      )
119.            )
120.            (xd::text:init 1)
121.            (setq tb
122.                   (xd::table:makefromlist lst pt #xd_table_txt_height 0.0)
123.            )
124.            (xd::table:begin tb)
125.            (_mergecell tb 0 3 2)
126.            (_mergecell tb 4 5 3)
127.            (_writebulges tb)
128.            (if (not #xd_table_res_z)
129.              (xdrx_table_deletecolumns tb 3 1)
130.            )
131.            (xdrx_table_setrowheight tb 0 (* 2.0 #xd_table_txt_height))
132.            (xdrx_table_setrowheight tb 1 (* 2.0 #xd_table_txt_height))
133.            (xdrx_setpropertyvalue
134.              tb
135.              "color"
136.              7
137.              "HorzCellMargin"
138.              (/ #xd_table_txt_height 2.0)
139.              "autosize"
140.              t
141.            )
142.            (xd::table:end tb)
143.            (xd::drag:simplemove (entlast) "\nTable Insert:" 8 t)
144.     )
145.   )
146.   (xdrx_sysvar_pop)
147.   (xdrx_end)
148.   (princ)
149. )
150.