注册 登录
明经CAD社区 返回首页

mahuan1279的个人空间 http://bbs.mjtd.com/?7303115 [收藏] [复制] [分享] [RSS]

日志

三角形外接圆反应器

已有 741 次阅读2014-10-11 02:59 |个人分类:LISP|系统分类:插件| 反应器, 三角形, 外接圆

(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)
)

路过

雷人

握手

鲜花

鸡蛋

评论 (0 个评论)

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 01:05 , Processed in 0.136752 second(s), 16 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

返回顶部