Author Topic: [XDrX-PlugIn(34)] Generate Circle statistics table  (Read 607 times)

0 Members and 1 Guest are viewing this topic.

xdcad

  • Bull Frog
  • Posts: 424
[XDrX-PlugIn(34)] Generate Circle statistics table
« on: December 04, 2023, 05:47:11 AM »
Circles of the same area are coded together



Code - Auto/Visual Lisp: [Select]
  1. (defun c:XDTB_TJCIR1 (/ ss a p lst v a p1 txt)
  2.   (if (not #xd-var-global-table-textheight)
  3.     (setq #xd-var-global-table-textheight 4.0)
  4.   )
  5.   (if (setq v (getreal (xdrx-prompt
  6.                          "\nText height<"
  7.                          #xd-var-global-table-textheight
  8.                          ">:"
  9.                          t
  10.                        )
  11.               )
  12.       )
  13.     (setq #xd-var-global-table-textheight v)
  14.   )
  15.   (if (not #xd-var-global-table-textpos)
  16.     (setq #xd-var-global-table-textpos 5)
  17.   )
  18.   (xdrx-initget "1 2 3 4 5 6 7 8 9")
  19.   (if (setq v
  20.              (getreal
  21.                (xdrx-prompt
  22.                  "\nText label position [BottomLeft(1)/BottoMiddle(2)/BottomRight(3)/MiddleLeft (4)/Middle(5)/MiddleRight(6)/UpperLeft(7)/UpperMiddle(8)/TopRight(9)]<"
  23.                  #xd-var-global-table-textpos
  24.                  ">:"
  25.                  t
  26.                )
  27.              )
  28.       )
  29.     (setq #xd-var-global-table-textpos v)
  30.   )
  31.   (if (not #xd-var-global-bits)
  32.     (setq #xd-var-global-bits 1)
  33.   )
  34.   (if (setq
  35.         v (getint
  36.             (xdrx-prompt
  37.               "\nNumber of decimal places<"
  38.               #xd-var-global-bits
  39.               ">:"
  40.               t
  41.             )
  42.           )
  43.       )
  44.     (setq #xd-var-global-bits v)
  45.   )
  46.   (if (and (xdrx-initssget
  47.              "\nSelect the circles to be counted <Exit>:"
  48.            )
  49.            (setq ss (xdrx_ssget '((0 . "circle"))))
  50.       )
  51.     (progn
  52.       (xdrx-begin)
  53.       (xdrx_sysvar_push '("dimzin" 0))
  54.       (setq lst (mapcar '(lambda (x)
  55.                            (list (xdrx_getpropertyvalue x "radius")
  56.                                  (xdrx-getpropertyvalue x "center")
  57.                                  x
  58.                            )
  59.                          )
  60.                         (xdrx_pickset->ents ss)
  61.                 )
  62.             lst (xd::list:groupbyindex lst 1e-3)
  63.             lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
  64.             a   65
  65.       )
  66.       (xd::text:init 1)
  67.       (setq lst
  68.              (mapcar
  69.                '(lambda (x / i)
  70.                   (setq i 1)
  71.                   (mapcar
  72.                     '(lambda (b / p p1 txt)
  73.                        (setq p   (xdrx_getpropertyvalue b "center")
  74.                              txt (xdrx_text_make
  75.                                    p1
  76.                                    (strcat (chr a) (itoa i))
  77.                                    #xd-var-global-table-textheight
  78.                                    0.0
  79.                                  )
  80.                              p1  (cond
  81.                                    ((= #xd-var-global-table-textpos 1)
  82.                                     (setq pos 9)
  83.                                     (polar p (* 5 (/ pi 4)) (* (car x) 1.2))
  84.                                    )
  85.                                    ((= #xd-var-global-table-textpos 2)
  86.                                     (setq pos 8)
  87.                                     (polar p (- (/ pi 2)) (* (car x) 1.2))
  88.                                    )
  89.                                    ((= #xd-var-global-table-textpos 3)
  90.                                     (setq pos 7)
  91.                                     (polar p (- (/ pi 4)) (* (car x) 1.2))
  92.                                    )
  93.                                    ((= #xd-var-global-table-textpos 4)
  94.                                     (setq pos 6)
  95.                                     (polar p (- pi) (* (car x) 1.2))
  96.                                    )
  97.                                    ((= #xd-var-global-table-textpos 5)
  98.                                     (setq pos 5)
  99.                                     p
  100.                                    )
  101.                                    ((= #xd-var-global-table-textpos 6)
  102.                                     (setq pos 4)
  103.                                     (polar p 0.0 (* (car x) 1.2))
  104.                                    )
  105.                                    ((= #xd-var-global-table-textpos 7)
  106.                                     (setq pos 3)
  107.                                     (polar p (* 3 (/ pi 4)) (* (car x) 1.2))
  108.                                    )
  109.                                    ((= #xd-var-global-table-textpos 8)
  110.                                     (setq pos 2)
  111.                                     (polar p (/ pi 2) (* (car x) 1.2))
  112.                                    )
  113.                                    ((= #xd-var-global-table-textpos 9)
  114.                                     (setq pos 1)
  115.                                     (polar p (/ pi 4) (* (car x) 1.2))
  116.                                    )
  117.                                    (t
  118.                                     p
  119.                                    )
  120.                                  )
  121.                              txt (xdrx_text_make
  122.                                    p1
  123.                                    (strcat (chr a) (itoa i))
  124.                                    #xd-var-global-table-textheight
  125.                                    0.0
  126.                                  )
  127.                              i   (1+ i)
  128.                        )
  129.                        (xdrx_text_setvermode txt 3)
  130.                        (setq lxd txt)
  131.                        (xdrx-entity-move txt (xd::geom:get9pt txt pos) p1)
  132.                      )
  133.                     (mapcar 'last
  134.                             (vl-sort (cdr x)
  135.                                      '(lambda (x y) (< (caar x) (caar y)))
  136.                             )
  137.                     )
  138.                   )
  139.                   (setq a (1+ a))
  140.                   (list (chr (1- a)) (car x) (car x) (length (cdr x)))
  141.                 )
  142.                lst
  143.              )
  144.       )
  145.       (setq i 0)
  146.       (setq lst
  147.              (mapcar
  148.                '(lambda (x)
  149.                   (list
  150.                     (setq i (1+ i))
  151.                     (car x)
  152.                     (strcat "%%c" (rtos (cadr x) 2 #xd-var-global-bits))
  153.                     (strcat "&#934;"
  154.                             (rtos (* 2 (cadr x)) 2 #xd-var-global-bits)
  155.                     )
  156.                     (rtos (* 2 pi (cadr x)) 2 #xd-var-global-bits)
  157.                     (rtos (* pi (cadr x) (cadr x)) 2 #xd-var-global-bits)
  158.                     (last x)
  159.                   )
  160.                 )
  161.                lst
  162.              )
  163.       )
  164.       (setq
  165.         lst (append
  166.               lst
  167.               (list
  168.                 (list
  169.                   "Sum"
  170.                   nil
  171.                   nil
  172.                   ""
  173.                   (rtos
  174.                     (apply '+
  175.                            (mapcar '(lambda (x) (atof (nth 4 x))) lst)
  176.                     )
  177.                     2
  178.                     #xd-var-global-bits
  179.                   )
  180.                   (rtos
  181.                     (apply '+
  182.                            (mapcar '(lambda (x) (atof (nth 5 x))) lst)
  183.                     )
  184.                     2
  185.                     #xd-var-global-bits
  186.                   )
  187.                   (apply '+ (mapcar '(lambda (x) (nth 6 x)) lst))
  188.                 )
  189.               )
  190.             )
  191.       )
  192.       (setq tb
  193.              (XD::Table:MakeFromList
  194.                (append
  195.                  (list
  196.                    '("Circle Statistics Table" nil nil nil nil nil nil)
  197.                    '("Number" "Coding"       "Radius"
  198.                      "Diameter"      "Perimeter"     "Area"
  199.                      "Quantity"
  200.                     )
  201.                  )
  202.                  lst
  203.                )
  204.                '(0 0 0)
  205.                #xd-var-global-table-textheight
  206.                (/ #xd-var-global-table-textheight 3.0)
  207.              )
  208.       )
  209.       (xdrx_setpropertyvalue tb "color" 7)
  210.       (xd::drag:simplemove
  211.         (entlast)
  212.         "\n>>Table insertion point:"
  213.         8
  214.         t
  215.       )
  216.       (xdrx-sysvar-pop)
  217.       (xdrx-end)
  218.     )
  219.   )
  220.   (princ)
  221. )
  222.  
The code I wrote uses XDRX-API,which can be downloaded from github.com and is updated at any time.
===================================
[XDrx-Sub Forum]
https://www.theswamp.org/index.php?board=78.0
https://github.com/xdcad/XDrx-API
http://bbs.xdcad.net