0 Members and 1 Guest are viewing this topic.
(defun c:esc (/ TK1 TK2 KD A R SS N E IntersLineCircle gxl-Ax:2DPoint gxl-clock ) (vl-load-com) (defun IntersLineCircle (p q c r / a d n s) (setq n (mapcar '- q p) p (trans p 0 n) c (trans c 0 n) a (list (car p) (cadr p) (caddr c)) ) (cond ((equal r (setq d (distance c a))) (list (trans a n 0)) ) ((< d r) (setq s (sqrt (- (* r r) (* d d)))) (list (trans (list (car p) (cadr p) (- (caddr c) s)) n 0) (trans (list (car p) (cadr p) (+ (caddr c) s)) n 0) ) ) ) ) (defun gxl-Ax:2DPoint (pt) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 1)) (list (car pt) (cadr pt)) ) ) ) (defun gxl-clock (PLIST / LW MINP MAXP LST) (cond ((= 'LIST (type plist)) (not (minusp (apply '+ (mapcar (function (lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b))) ) ) plist (cons (last plist) plist) ) ) ) ) ) (t (if (= 'ename (type plist)) (setq lw (vlax-ename->vla-object plist)) (if (= 'VLA-OBJECT (type plist)) (setq lw plist) ) ) (vla-GetBoundingBox lw 'MinP 'MaxP) (setq minp (vlax-safearray->list minp) MaxP (vlax-safearray->list MaxP) lst (mapcar (function (lambda (x) (vlax-curve-getParamAtPoint lw (vlax-curve-getClosestPointTo lw x) ) ) ) (list minp (list (car MaxP) (cadr minp)) MaxP (list (car minp) (cadr MaxP)) ) ) ) (if (or (<= (car lst) (cadr lst) (caddr lst) (cadddr lst)) (<= (cadr lst) (caddr lst) (cadddr lst) (car lst)) (<= (caddr lst) (cadddr lst) (car lst) (cadr lst)) (<= (cadddr lst) (car lst) (cadr lst) (caddr lst)) ) t ) ) ) ) (defun tk1 (E A R / N EL I P1 P2 P3 CLOCKWISEP MIDANG CP MRP STP ENP MP BULGE ARCDATA OBJ A1 A2 ) (setq obj (vlax-ename->vla-object e)) (vla-put-Closed obj :vlax-true) (setq n (fix (vlax-curve-getEndParam obj))) ;(if (/= 1 (logand (cdr (assoc 70 el)) 1)) (setq n (- n 2))) (setq i 0) (repeat n (setq p1 (vlax-curve-getPointAtParam e i) p2 (vlax-curve-getPointAtParam e (setq i (1+ i))) p3 (vlax-curve-getPointAtParam e (1+ i)) ) (if (null p3) (setq p3 (vlax-curve-getPointAtParam e 1)) ) (setq a1 (angle p2 p1) a2 (angle p2 p3) ) (setq clockwisep (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1))) ) ) (if (< a1 a2) (setq a1 (+ a1 pi pi)) ) (setq midang (* 0.5 (+ a1 a2))) (if clockwisep (setq cp (polar p2 midang (- a r)) mrp (polar p2 midang a) ) (setq cp (polar p2 midang (- r a)) mrp (polar p2 midang (- a)) ) ) (setq stp (car (vl-remove-if-not '(lambda (x) (equal (+ (distance p1 x) (distance p2 x)) (distance p1 p2) 1e-6 ) ) (IntersLineCircle p2 p1 cp r) ) ) ) (setq enp (car (vl-remove-if-not '(lambda (x) (equal (+ (distance p3 x) (distance p2 x)) (distance p3 p2) 1e-6 ) ) (IntersLineCircle p2 p3 cp r) ) ) ) (setq mp (mapcar '* '(0.5 0.5 0.5) (MAPCAR '+ stp enp))) (setq bulge (/ (distance mrp mp) (distance mp stp))) (if clockwisep (setq bulge (- bulge)) ) (setq arcdata (cons (list stp enp bulge) arcdata)) ) (setq arcdata (reverse arcdata)) (foreach data arcdata (setq stp (car data) enp (cadr data) bulge (caddr data) ) (setq n (fix (vlax-curve-getParamAtPoint obj (vlax-curve-getclosestpointto obj enp) ) ) ) (vla-put-coordinate obj n (GXL-AX:2DPOINT stp)) (if (vlax-curve-getPointAtParam obj (1+ n)) (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT enp)) (vla-AddVertex obj 1 (GXL-AX:2DPOINT enp)) ) (vla-SetBulge obj n bulge) ) ) (defun tk2 (E R CLOCK / OBJ POLYCLOCK I P1 P2 P3 ARCDATA PT BULGE FLAG N) (setq obj (vlax-ename->vla-object e)) (vla-put-Closed obj :vlax-true) (setq polyClock (not (gxl-clock e))) (setq i 0) (repeat (fix (vlax-curve-getEndParam obj)) (setq p1 (vlax-curve-getPointAtParam obj i) p2 (vlax-curve-getPointAtParam obj (setq i (1+ i))) p3 (vlax-curve-getPointAtParam obj (1+ i)) ) (if (null p3) (setq p3 (vlax-curve-getPointAtParam obj 1)) ) (cond (polyClock (cond (clock (setq arcdata (cons (list (polar p2 (angle p2 p3) r) -1 nil) arcdata ) ) ) (t (setq arcdata (cons (list (polar p2 (angle p2 p1) r) -1 t) arcdata ) ) ) ) ) (t (cond (clock (setq arcdata (cons (list (polar p2 (angle p2 p1) r) 1 t) arcdata ) ) ) (t (setq arcdata (cons (list (polar p2 (angle p2 p3) r) 1 nil) arcdata ) ) ) ) ) ) ) (setq arcdata (reverse arcdata)) (foreach data arcdata (setq pt (car data) bulge (cadr data) flag (caddr data) ) (setq n (fix (vlax-curve-getParamAtPoint obj (vlax-curve-getclosestpointto obj pt) ) ) ) (if (vlax-curve-getPointAtParam obj (1+ n)) (progn (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT pt)) (if flag (vla-SetBulge obj (1+ n) bulge) (vla-SetBulge obj n bulge) ) ) (progn (vla-AddVertex obj 1 (GXL-AX:2DPOINT pt)) (if flag (vla-SetBulge obj 1 bulge) (vla-SetBulge obj 0 bulge) ) ) ) ) ) (initget "1 2 3") (if (null (setq kd (getkword "\n[Standard(1)/ClockWise(2)/CounterClockWise(3)] <1> : " ) ) ) (setq kd "1") ) (cond ((= "1" kd) (if (null (setq a (getreal "\nEscape Deep <0.1> : "))) (setq a 0.1) ) (if (null (setq r (getreal "\nEscape Radius <0.4> : "))) (setq r 0.4) ) (while (not ss) (setq ss (ssget '((0 . "LWPOLYLINE")))) (repeat (setq n (sslength ss)) (setq e (ssname ss (setq n (1- n)))) (tk1 e a r) ) ) ) (t (if (null (setq r (getreal "\nEscape Radius <0.4> : "))) (setq r 0.4) ) (while (not ss) (setq ss (ssget '((0 . "LWPOLYLINE")))) (repeat (setq n (sslength ss)) (setq e (ssname ss (setq n (1- n)))) (tk2 e r (= "2" kd)) ) ) ) ) (princ))
It does seem strange though that arc are converted to straight segments.
;; Author:Gu_xl 2013.05.08;;update: 2014.01.06 (defun c:tt (/ TK1 TK2 KD A R SS N E) ;;standard calculate (defun tk1 (E A R / N EL I P1 P2 P3 CLOCKWISEP MIDANG CP MRP STP ENP MP BULGE ARCDATA OBJ A1 A2 k ) (setq obj (vlax-ename->vla-object e)) (if (vlax-curve-isClosed obj) (progn (setq i 0) (setq n (fix (vlax-curve-getEndParam obj))) ) (progn (setq i 0) (setq n (1- (fix (vlax-curve-getEndParam obj)) )) ) ) (repeat n (setq p1 (vlax-curve-getPointAtParam e i) p2 (vlax-curve-getPointAtParam e (setq i (1+ i))) p3 (vlax-curve-getPointAtParam e (1+ i)) ) (if (and (vlax-curve-isClosed obj) (equal i (vlax-curve-getEndParam obj) 1e-6) ) (setq k 0) (setq k i) ) (if (and (equal 0 (vla-GetBulge obj (1- i)) 1e-6) (equal 0 (vla-GetBulge obj k) 1e-6) ) (progn (if (null p3) (setq p3 (vlax-curve-getPointAtParam e 1))) (setq a1 (angle p2 p1) a2 (angle p2 p3) ) (setq clockwisep (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1))) ) ) (if (< a1 a2) (setq a1 (+ a1 pi pi))) (setq midang (* 0.5 (+ a1 a2))) (if clockwisep (setq cp (polar p2 midang (- a r)) mrp (polar p2 midang a) ) (setq cp (polar p2 midang (- r a)) mrp (polar p2 midang (- a)) ) ) (setq stp (car (vl-remove-if-not '(lambda (x) (equal (+ (distance p1 x) (distance p2 x)) (distance p1 p2) 1e-6 ) ) (IntersLineCircle p2 p1 cp r) ) ) ) ;_ Arc start (setq enp (car (vl-remove-if-not '(lambda (x) (equal (+ (distance p3 x) (distance p2 x)) (distance p3 p2) 1e-6 ) ) (IntersLineCircle p2 p3 cp r) ) ) ) ;_ Arc end (setq mp (mapcar '* '(0.5 0.5 0.5) (MAPCAR '+ stp enp))) (setq bulge (/ (distance mrp mp) (distance mp stp))) ;_ Bowstring ratio (if clockwisep (setq bulge (- bulge))) (setq arcdata (cons (list stp enp bulge) arcdata)) ) ) ) (setq arcdata (reverse arcdata)) (foreach data arcdata (setq stp (car data) enp (cadr data) bulge (caddr data) ) (setq n (fix (vlax-curve-getParamAtPoint obj (vlax-curve-getclosestpointto obj enp) ) ) ) (vla-put-coordinate obj n (GXL-AX:2DPOINT stp)) (if (vlax-curve-getPointAtParam obj (1+ n)) (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT enp)) (vla-AddVertex obj 1 (GXL-AX:2DPOINT enp)) ) (vla-SetBulge obj n bulge) ) ) ;;clockwise (defun tk2 (E R CLOCK / OBJ POLYCLOCK I P1 P2 P3 ARCDATA PT BULGE FLAG N k) (setq obj (vlax-ename->vla-object e)) (setq polyClock (not (gxl-clock e))) (setq i 0) (if (vlax-curve-isClosed obj) (progn (setq i 0) (setq n (fix (vlax-curve-getEndParam obj))) ) (progn (setq i 0) (setq n (1- (fix (vlax-curve-getEndParam obj)))) ) ) (repeat n (setq p1 (vlax-curve-getPointAtParam obj i) p2 (vlax-curve-getPointAtParam obj (setq i (1+ i))) p3 (vlax-curve-getPointAtParam obj (1+ i)) ) (if (and (vlax-curve-isClosed obj) (equal i (vlax-curve-getEndParam obj) 1e-6) ) (setq k 0) (setq k i) ) (if (and (equal 0 (vla-GetBulge obj (1- i)) 1e-6) (equal 0 (vla-GetBulge obj k) 1e-6) ) (progn (if (null p3) (setq p3 (vlax-curve-getPointAtParam obj 1))) (cond (polyClock ;_ Curve clockwise (cond (clock ;_ (setq arcdata (cons (list (polar p2 (angle p2 p3) r) -1 nil) arcdata)) ) (t ;_ (setq arcdata (cons (list (polar p2 (angle p2 p1) r) -1 t) arcdata)) ) ) ) (t ;_ Curve counterclockwise (cond (clock ;_ (setq arcdata (cons (list (polar p2 (angle p2 p1) r) 1 t) arcdata)) ) (t ;_ (setq arcdata (cons (list (polar p2 (angle p2 p3) r) 1 nil) arcdata)) ) ) ) ) ) ) ) (setq arcdata (reverse arcdata)) (foreach data arcdata (setq pt (car data) bulge (cadr data) flag (caddr data) ) (setq n (fix (vlax-curve-getParamAtPoint obj (vlax-curve-getclosestpointto obj pt) ) ) ) (if (vlax-curve-getPointAtParam obj (1+ n)) (progn (vla-AddVertex obj (1+ n) (GXL-AX:2DPOINT pt)) (if flag (vla-SetBulge obj (1+ n) bulge) (vla-SetBulge obj n bulge) ) ) (progn (vla-AddVertex obj 1 (GXL-AX:2DPOINT pt)) (if flag (vla-SetBulge obj 1 bulge) (vla-SetBulge obj 0 bulge) ) ) ) ) ) (initget "1 2 3") (if (null (setq kd (getkword "\n[standard(1)/clockwise(2)/counterclockwise(3)]<1>")) ) (setq kd "1") ) (cond ((= "1" kd) (if (null (setq a (getreal "\nMagnitude<5.0>:"))) (setq a 5.0) ) (if (null (setq r (getreal "\nAperture radius<10.0>:"))) (setq r 10.0) ) (while (setq ss (ssget '((0 . "lwpolyline")))) (repeat (setq n (sslength ss)) (setq e (ssname ss (setq n (1- n)))) (tk1 e a r) ;_ trim ) ) ) (t (if (null (setq r (getreal "\nAperture radius<10.0>:"))) (setq r 10.0) ) (while (setq ss (ssget '((0 . "*polyline")))) (repeat (setq n (sslength ss)) (setq e (ssname ss (setq n (1- n)))) (tk2 e r (= "2" kd)) ;_ trim ) ) ) ) (princ) );;*******************A custom function****************************;; Line-Circle Intersection - Lee Mac(defun IntersLineCircle ( p q c r / a d n s ) (setq n (mapcar '- q p) p (trans p 0 n) c (trans c 0 n) a (list (car p) (cadr p) (caddr c)) ) (cond ( (equal r (setq d (distance c a))) (list (trans a n 0)) ) ( (< d r) (setq s (sqrt (- (* r r) (* d d)))) (list (trans (list (car p) (cadr p) (- (caddr c) s)) n 0) (trans (list (car p) (cadr p) (+ (caddr c) s)) n 0) ) ) ));;(defun gxl-Ax:2DPoint (pt) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 1)) (list (car pt) (cadr pt)) ) ));;(defun gxl-clock (PLIST / LW MINP MAXP LST) (cond ((= 'LIST (type plist)) (not (minusp (apply '+ (mapcar (function (lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b))) ) ) plist (cons (last plist) plist) ) ) ) ) ) (t (if (= 'ename (type plist)) (setq lw (vlax-ename->vla-object plist)) (if (= 'VLA-OBJECT (type plist)) (setq lw plist) ) ) (vla-GetBoundingBox lw 'MinP 'MaxP) (setq minp (vlax-safearray->list minp) MaxP (vlax-safearray->list MaxP) lst (mapcar (function (lambda (x) (vlax-curve-getParamAtPoint lw (vlax-curve-getClosestPointTo lw x) ) ) ) (list minp (list (car MaxP) (cadr minp)) MaxP (list (car minp) (cadr MaxP)) ) ) ) (if (or (<= (car lst) (cadr lst) (caddr lst) (cadddr lst)) (<= (cadr lst) (caddr lst) (cadddr lst) (car lst)) (<= (caddr lst) (cadddr lst) (car lst) (cadr lst)) (<= (cadddr lst) (car lst) (cadr lst) (caddr lst)) ) t ) ) ) )