论坛 › A/VLISP › LISP动态拖动生成圆代码

marting 发表于 2017-5-5 22:37:30

LISP动态拖动生成圆代码

本帖最后由 newer 于 2017-5-6 08:10 编辑




(defun c:test2 ()

;;CAB version 1.2
;;Calling routine to pass a tangent point (p1) & offset distance (od)
;;Routine will allow user to stretch outer circle using diameter
;;Note if offset distance is a negative number the offset circle
;;will be on the outside
;;
;;Returns the 2nd pick point
   
    (setq rMin 0.001) ; Minimum Radius allowed
    (setq c1
         (entmakex (list (cons 0 "CIRCLE")
                           (cons 6 "BYLAYER")
                           (cons 8 "0")
                           (cons 10 p1)
                           (cons 39 0.0)
                           (cons 40 rMin) ; radius
                           (cons 62 256)
                           (cons 210 (list 0.0 0.0 1.0))
                     )
         )
    )
    (setq c2
         (entmakex (list (cons 0 "CIRCLE")
                           (cons 6 "BYLAYER")
                           (cons 8 "0")
                           (cons 10 p1)
                           (cons 39 0.0)
                           (cons 40 rMin) ; radius
                           (cons 62 256)
                           (cons 210 (list 0.0 0.0 1.0))
                     )
         )
    )
    (setq el1 (entget c1)
          el2 (entget c2)
    )
    ;;p1 is a tangent point
    ;;p2 is a tangent point with center at mid point of p1 p2
    (while (and (setq gr (grread 5)) (= (car gr) 5))
      (cond
      ((> (setq d1 (distance p1 (setq p2 (cadr gr)))) rMin)
         (setq el1 (subst (cons 40 (setq r1 (/ d1 2.))) (assoc 40 el1) el1))
         (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) r1)) (assoc 10 el1) el1)))
         (entupd (cdr (assoc -1 el1)))
         (cond
         ((< rMin (- d1 (* od 2.)))
            (setq el2 (subst (cons 40 (/ (- d1 (* od 2.)) 2.)) (assoc 40 el2) el2))
            (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
            (entupd (cdr (assoc -1 el2)))
         )
         (t ; minimize the inner circle
            (setq el2 (subst (cons 40 rMin) (assoc 40 el2) el2))
            (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
            (entupd (cdr (assoc -1 el2)))
         )
         )
      )
      (t ; minimize the outer circle
         (setq el1 (subst (cons 40 rMin) (assoc 40 el1) el1))
         (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) (/ rMin 2.))) (assoc 10 el1) el1)))
         (entupd (cdr (assoc -1 el1)))
      )
      )
    )
    ;(entdel c1) ; to remove the circle
    ;(entdel c2) ; to remove the circle
    p2
)


(setq pc (getpoint "\nPick center point."))
(princ "\n Select new radius")
(setq rad (ghostcircle pc 850.0))
(princ rad)
(princ)
)


ghostCircle函数：

**** Hidden Message *****

kqqt6236 发表于 2017-5-6 00:02:34

沙发，谢谢分享！

freefor5127 发表于 2017-5-6 00:17:46

谢谢楼主分享

Michael527 发表于 2017-5-6 06:47:50

可以学习动态拖动

Michael527 发表于 2017-5-6 06:52:40

代码不全吧？

HLCAD 发表于 2017-5-6 07:50:24

向大师学习程序！

434939575 发表于 2017-5-6 08:24:46

谢谢分享！

sh_h 发表于 2017-5-6 09:38:26

好程序，感谢楼主分享！
一看动态就想到grread函数，一想到grread函数就晕

winerfjy 发表于 2017-5-6 09:53:06

动态好视觉化好

lrd1861 发表于 2017-5-6 10:17:48

学习一下{:1_1:}

bonny123 发表于 2017-5-6 10:29:55

               赞一个

ynhh 发表于 2017-5-6 12:03:13

谢谢分享！
谢谢分享！

范建威 发表于 2017-5-24 13:58:25

向楼主学习

yufeng37 发表于 2017-6-6 14:33:34

向楼主学习，能做个动态云线的效果吗？类似与cad2018的云线效果。

819534890 发表于 2017-6-6 15:08:34

回复学习学习

查看完整版本: LISP动态拖动生成圆代码