gerenderter Paste-Inhalt;;;===========================================================;;; Multi-Region Circle Counter v6.0;;; Command: JMKTJ;;; Output: CSV file (open with Excel);;;===========================================================(defun c:JMKTJ (/ ss ssb ssc sst regs res i e et pts obj cen rad dlist txt pt fname fp line) (setvar "cmdecho" 0) (princ "\nSelect all objects: ") (setq ss (ssget)) (if (null ss) (progn (princ "\nNothing selected!") (exit))) (setq ssb (ssadd) ssc (ssadd) sst (ssadd)) (setq i 0) (repeat (sslength ss) (setq e (ssname ss i)) (setq et (cdr (assoc 0 (entget e)))) (cond ((member et '("LINE" "LWPOLYLINE" "POLYLINE" "ELLIPSE" "SPLINE" "ARC")) (ssadd e ssb)) ((= et "CIRCLE") (ssadd e ssb) (ssadd e ssc)) ((member et '("TEXT" "MTEXT")) (ssadd e sst)) ) (setq i (1+ i)) ) (if (< (sslength ssb) 1) (progn (princ "\nNo boundary!") (exit))) (if (< (sslength ssc) 1) (progn (princ "\nNo circle!") (exit))) (if (< (sslength sst) 1) (progn (princ "\nNo text!") (exit))) ;; Build region point lists (setq regs '()) (setq i 0) (repeat (sslength ssb) (setq e (ssname ssb i)) (setq et (cdr (assoc 0 (entget e)))) (setq pts '()) (cond ((= et "LINE") (setq pts (list (cdr (assoc 10 (entget e))) (cdr (assoc 11 (entget e)))))) ((or (= et "LWPOLYLINE") (= et "POLYLINE")) (setq obj (vlax-ename->vla-object e)) (setq n (fix (vlax-curve-getEndParam obj))) (setq j 0) (while (<= j n) (setq pt (vlax-curve-getPointAtParam obj j)) (if pt (setq pts (append pts (list pt)))) (setq j (1+ j)))) ((= et "CIRCLE") (setq obj (vlax-ename->vla-object e)) (setq cen (vlax-get obj 'Center)) (setq rad (vlax-get obj 'Radius)) (setq j 0) (while (< j 36) (setq pt (list (+ (car cen) (* rad (cos (* j 0.1745)))) (+ (cadr cen) (* rad (sin (* j 0.1745)))) 0)) (setq pts (append pts (list pt))) (setq j (1+ j)))) ((= et "ELLIPSE") (setq obj (vlax-ename->vla-object e)) (setq cen (vlax-get obj 'Center)) (setq ma (vlax-get obj 'MajorAxis)) (setq mi (vlax-get obj 'MinorAxis)) (setq ml (sqrt (+ (* (car ma) (car ma)) (* (cadr ma) (cadr ma))))) (setq sl (sqrt (+ (* (car mi) (car mi)) (* (cadr mi) (cadr mi))))) (setq j 0) (while (< j 36) (setq pt (list (+ (car cen) (* ml (cos (* j 0.1745)))) (+ (cadr cen) (* sl (sin (* j 0.1745)))) 0)) (setq pts (append pts (list pt))) (setq j (1+ j)))) ((= et "SPLINE") (setq obj (vlax-ename->vla-object e)) (setq sp (vlax-curve-getStartParam obj)) (setq ep (vlax-curve-getEndParam obj)) (setq j 0) (while (<= j 50) (setq pt (vlax-curve-getPointAtParam obj (+ sp (* j (/ (- ep sp) 50))))) (if pt (setq pts (append pts (list pt)))) (setq j (1+ j)))) ((= et "ARC") (setq obj (vlax-ename->vla-object e)) (setq cen (vlax-get obj 'Center)) (setq rad (vlax-get obj 'Radius)) (setq sa (vlax-get obj 'StartAngle)) (setq ea (vlax-get obj 'EndAngle)) (setq j 0) (while (<= j 20) (setq pt (list (+ (car cen) (* rad (cos (+ sa (* j (/ (- ea sa) 20)))))) (+ (cadr cen) (* rad (sin (+ sa (* j (/ (- ea sa) 20)))))) 0)) (setq pts (append pts (list pt))) (setq j (1+ j)))) ) (if (> (length pts) 2) (setq regs (append regs (list pts)))) (setq i (1+ i)) ) ;; Point in polygon (defun pip (pt pts / in i j xi yi xj yj) (setq in nil i 0 j (1- (length pts))) (while (< i (length pts)) (setq xi (car (nth i pts)) yi (cadr (nth i pts))) (setq xj (car (nth j pts)) yj (cadr (nth j pts))) (if (and (or (> yi (cadr pt)) (> yj (cadr pt))) (or (< yi (cadr pt)) (< yj (cadr pt))) (or (< xi (car pt)) (< xj (car pt)))) (if (< xi (+ (* (- (car pt) xi) (/ (- yj yi) (- xj xi))) (car pt))) (setq in (not in)))) (setq j i i (1+ i))) in) ;; Process each region (setq res '()) (foreach rg regs (setq dlist '() i 0) (repeat (sslength ssc) (setq e (ssname ssc i)) (setq cen (cdr (assoc 10 (entget e)))) (if (pip