[编程交流] 再次绘制圆

(defun c:Test (/ _line _screw s1 s2 l a p)
 ;;        Author: Tharwat                ;;
 ;;        Date: 09.09.2014        ;;
 (defun _line (p q)
   (entmakex (list '(0 . "LINE") (cons 8 "cen") (cons 62 4) (cons 10 p) (cons 11 q)))
 )
 (defun _screw (pt r)
   (mapcar '(lambda (p)
              (entmakex (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))
              (_line (polar p 0. (* r 1.2)) (polar p pi (* r 1.2)))
              (_line (polar p (* pi 1.5) (* r 1.2)) (polar p (* pi 0.5) (* r 1.2)))
            )
           (list pt)
   )
 )
 (while (and (setq s1 (entsel "\n Pick Left side line :"))
             (wcmatch (cdr (assoc 0 (entget (car s1)))) "LINE,LWPOLYLINE")
             (setq s2 (entsel "\n Pick Right side line :"))
             (wcmatch (cdr (assoc 0 (entget (car s2)))) "LINE,LWPOLYLINE")
             (setq p (getpoint "\n Specify Corner point of the two side [intersection] :"))
             (setq *dist1* (cond ((getdist (strcat "\n Specify Left distance < "
                                                   (rtos (if *dist1*
                                                           *dist1*
                                                           (setq *dist1* 1.0)
                                                         )
                                                         2
                                                         2
                                                   )
                                                   " > :"
                                           )
                                  )
                                 )
                                 (*dist1*)
                           )
             )
             (setq *dist2* (cond ((getdist (strcat "\n Specify Right distance < "
                                                   (rtos (if *dist2*
                                                           *dist2*
                                                           (setq *dist2* 1.0)
                                                         )
                                                         2
                                                         2
                                                   )
                                                   " > :"
                                           )
                                  )
                                 )
                                 (*dist2*)
                           )
             )
             (setq *rad* (cond ((getdist (strcat "\n Diameter of Circle < "
                                                 (rtos (if *rad*
                                                         *rad*
                                                         (setq *rad* 1.0)
                                                       )
                                                       2
                                                       2
                                                 )
                                                 " > :"
                                         )
                                )
                               )
                               (*rad*)
                         )
             )
        )
   (progn (setq l (mapcar 'vlax-curve-getclosestpointto (list (car s1) (car s2)) (list (cadr s1) (cadr s2)))
                a (mapcar 'angle (list p p) (list (car l) (cadr l)))
          )
          (_screw (polar (polar p (car a) *dist2*) (cadr a) *dist1*) (/ *rad* 2.))
   )
 )
 (princ)
)(vl-load-com)