(vl-load-com)
(defun swq(notifier-object reactor-object parameter-list / pt1 pt2 pt3 d1 d2 d3 a b c x y dd)
(setq cen (handent (vlr-data reactor-object) ) )
(setq len (vlax-vla-object->ename notifier-object)
le1 (entget len)
enn (cddddr (reverse le1))
pt1 (cdr (car enn))
pt2 (cdr (car (cddddr enn)))
pt3 (cdr (car (cddddr (cddddr enn))))
)
(setq d1 (distance (list 0 0) pt1))
(setq d2 (distance (list 0 0) pt2))
(setq d3 (distance (list 0 0) pt3))
(setq a (- (car pt2) (car pt1)))
(setq b (- (cadr pt2) (cadr pt1)))
(setq c (- (car pt3) (car pt2)))
(setq d (- (cadr pt3) (cadr pt2)))
(setq x (/ (- (+ (* d d2 d2) (* b d2 d2)) (+ (* d d1 d1) (* b d3 d3))) (- (* a d) (* b c)) 2))
(setq y (/ (- (+ (* a d3 d3) (* c d1 d1)) (+ (* a d2 d2) (* c d2 d2))) (- (* a d) (* b c)) 2))
(setq dd (distance (list x y) pt1))
(setq cel (entget cen)
cel (subst (vl-list* 10 (list x y)) (assoc 10 cel) cel)
cel (subst (vl-list* 40 dd) (assoc 40 cel) cel)
)
(entmod cel)
)
(defun c:tbb ()
(setq pt1 (getpoint)
pt2 (getpoint)
pt3 (getpoint)
)
(setq d1 (distance (list 0 0) pt1))
(setq d2 (distance (list 0 0) pt2))
(setq d3 (distance (list 0 0) pt3))
(setq a (- (car pt2) (car pt1)))
(setq b (- (cadr pt2) (cadr pt1)))
(setq c (- (car pt3) (car pt2)))
(setq d (- (cadr pt3) (cadr pt2)))
(setq x (/ (- (+ (* d d2 d2) (* b d2 d2)) (+ (* d d1 d1) (* b d3 d3))) (- (* a d) (* b c)) 2))
(setq y (/ (- (+ (* a d3 d3) (* c d1 d1)) (+ (* a d2 d2) (* c d2 d2))) (- (* a d) (* b c)) 2))
(setq dd (distance (list x y) pt1))
(command "pline" pt1 pt2 pt3 "c")
(setq len (entlast))
(command "circle" (list x y) dd)
(setq chl (cdr (assoc 5 (entget (entlast)))))
(setq rlt (cons (vlax-ename->vla-object len) '()))
(setq vrl (vlr-pers (vlr-object-reactor rlt chl '((:vlr-modified . swq))) ))
(princ "\n已建立的反应器有:") (princ (vlr-reactors))
(princ)
)