{"id":"8JHsQrMhzu","url":"https://pastebin.ca/8JHsQrMhzu","raw_url":"https://raw.anybin.ca/8JHsQrMhzu","visibility":"public","access":"public","created_at":1793601630897,"expires_at":1794206430897,"fetch_limit":null,"fetches_used":0,"reads_remaining":null,"size_bytes":4501,"syntax_hint":"plaintext","title":null,"filename":"JMKTJ","change_note":null,"cipher":null,"cipher_meta":null,"parent_id":null,"root_id":"8JHsQrMhzu","version":1,"owner_id":null,"recipient_id":null,"body":";;;===========================================================\n;;;  Multi-Region Circle Counter  v6.0\n;;;  Command: JMKTJ\n;;;  Output: CSV file (open with Excel)\n;;;===========================================================\n\n(defun c:JMKTJ (/ ss ssb ssc sst regs res i e et pts obj cen rad\n               dlist txt pt fname fp line)\n\n  (setvar \"cmdecho\" 0)\n\n  (princ \"\\nSelect all objects: \")\n  (setq ss (ssget))\n  (if (null ss) (progn (princ \"\\nNothing selected!\") (exit)))\n\n  (setq ssb (ssadd) ssc (ssadd) sst (ssadd))\n  (setq i 0)\n  (repeat (sslength ss)\n    (setq e (ssname ss i))\n    (setq et (cdr (assoc 0 (entget e))))\n    (cond\n      ((member et '(\"LINE\" \"LWPOLYLINE\" \"POLYLINE\" \"ELLIPSE\" \"SPLINE\" \"ARC\"))\n        (ssadd e ssb))\n      ((= et \"CIRCLE\")\n        (ssadd e ssb)\n        (ssadd e ssc))\n      ((member et '(\"TEXT\" \"MTEXT\"))\n        (ssadd e sst))\n    )\n    (setq i (1+ i))\n  )\n\n  (if (< (sslength ssb) 1) (progn (princ \"\\nNo boundary!\") (exit)))\n  (if (< (sslength ssc) 1) (progn (princ \"\\nNo circle!\") (exit)))\n  (if (< (sslength sst) 1) (progn (princ \"\\nNo text!\") (exit)))\n\n  ;; Build region point lists\n  (setq regs '())\n  (setq i 0)\n  (repeat (sslength ssb)\n    (setq e (ssname ssb i))\n    (setq et (cdr (assoc 0 (entget e))))\n    (setq pts '())\n\n    (cond\n      ((= et \"LINE\")\n        (setq pts (list (cdr (assoc 10 (entget e)))\n                        (cdr (assoc 11 (entget e))))))\n\n      ((or (= et \"LWPOLYLINE\") (= et \"POLYLINE\"))\n        (setq obj (vlax-ename->vla-object e))\n        (setq n (fix (vlax-curve-getEndParam obj)))\n        (setq j 0)\n        (while (<= j n)\n          (setq pt (vlax-curve-getPointAtParam obj j))\n          (if pt (setq pts (append pts (list pt))))\n          (setq j (1+ j))))\n\n      ((= et \"CIRCLE\")\n        (setq obj (vlax-ename->vla-object e))\n        (setq cen (vlax-get obj 'Center))\n        (setq rad (vlax-get obj 'Radius))\n        (setq j 0)\n        (while (< j 36)\n          (setq pt (list (+ (car cen) (* rad (cos (* j 0.1745))))\n                         (+ (cadr cen) (* rad (sin (* j 0.1745)))) 0))\n          (setq pts (append pts (list pt)))\n          (setq j (1+ j))))\n\n      ((= et \"ELLIPSE\")\n        (setq obj (vlax-ename->vla-object e))\n        (setq cen (vlax-get obj 'Center))\n        (setq ma (vlax-get obj 'MajorAxis))\n        (setq mi (vlax-get obj 'MinorAxis))\n        (setq ml (sqrt (+ (* (car ma) (car ma)) (* (cadr ma) (cadr ma)))))\n        (setq sl (sqrt (+ (* (car mi) (car mi)) (* (cadr mi) (cadr mi)))))\n        (setq j 0)\n        (while (< j 36)\n          (setq pt (list (+ (car cen) (* ml (cos (* j 0.1745))))\n                         (+ (cadr cen) (* sl (sin (* j 0.1745)))) 0))\n          (setq pts (append pts (list pt)))\n          (setq j (1+ j))))\n\n      ((= et \"SPLINE\")\n        (setq obj (vlax-ename->vla-object e))\n        (setq sp (vlax-curve-getStartParam obj))\n        (setq ep (vlax-curve-getEndParam obj))\n        (setq j 0)\n        (while (<= j 50)\n          (setq pt (vlax-curve-getPointAtParam obj (+ sp (* j (/ (- ep sp) 50)))))\n          (if pt (setq pts (append pts (list pt))))\n          (setq j (1+ j))))\n\n      ((= et \"ARC\")\n        (setq obj (vlax-ename->vla-object e))\n        (setq cen (vlax-get obj 'Center))\n        (setq rad (vlax-get obj 'Radius))\n        (setq sa (vlax-get obj 'StartAngle))\n        (setq ea (vlax-get obj 'EndAngle))\n        (setq j 0)\n        (while (<= j 20)\n          (setq pt (list (+ (car cen) (* rad (cos (+ sa (* j (/ (- ea sa) 20))))))\n                         (+ (cadr cen) (* rad (sin (+ sa (* j (/ (- ea sa) 20)))))) 0))\n          (setq pts (append pts (list pt)))\n          (setq j (1+ j))))\n    )\n\n    (if (> (length pts) 2)\n      (setq regs (append regs (list pts))))\n    (setq i (1+ i))\n  )\n\n  ;; Point in polygon\n  (defun pip (pt pts / in i j xi yi xj yj)\n    (setq in nil i 0 j (1- (length pts)))\n    (while (< i (length pts))\n      (setq xi (car (nth i pts)) yi (cadr (nth i pts)))\n      (setq xj (car (nth j pts)) yj (cadr (nth j pts)))\n      (if (and (or (> yi (cadr pt)) (> yj (cadr pt)))\n               (or (< yi (cadr pt)) (< yj (cadr pt)))\n               (or (< xi (car pt)) (< xj (car pt))))\n        (if (< xi (+ (* (- (car pt) xi) (/ (- yj yi) (- xj xi))) (car pt)))\n          (setq in (not in))))\n      (setq j i i (1+ i)))\n    in)\n\n  ;; Process each region\n  (setq res '())\n  (foreach rg regs\n    (setq dlist '() i 0)\n    (repeat (sslength ssc)\n      (setq e (ssname ssc i))\n      (setq cen (cdr (assoc 10 (entget e))))\n      (if (pip\n"}