[编程交流] 直线为pi时插入圆

(defun c:acir  (/ circle _moveblk aDoc ss e ang pts ln p1 p2 cir1 cir2 entm_ entm gr code cord)
     (if (not (member "geomcal.arx" (arx)))
           (arxload "geomcal")
           )
     (setvar 'osmode 0)
     (defun circle  (Doc p r)
           (vlax-invoke
                 (vlax-get (vla-get-ActiveLayout Doc) 'Block)
                 'AddCircle p  r
                 )
           )
     (defun _moveblk  (flg ent bp np)
           (if (not flg)
                 (vla-move
                       (setq flg (vla-copy ent))
                       (vlax-3d-point bp)
                       (vlax-3d-point np)
                       )
                 (progn (vla-delete flg) (setq flg nil))
                 )
           flg
           )
     (setq aDoc (vla-get-activedocument (vlax-get-acad-object)))
     (if
     (setq ss (ssget '((0 . "LINE"))))
     (repeat (setq i (sslength ss))
           (setq e (ssname ss (setq i (1- i))))
           (redraw e 3)
           (setq ang (apply 'angle
                            (setq pts  (mapcar
                                             '(lambda (d)
                                                    (cdr  (assoc
                                                                d
                                                                (entget e))))
                                             '(10 11))
                                  )))
           (if (> (setq ln (apply 'distance pts)) 12.0)
                 (progn
                       (redraw e 3)
                       (setq p1 (Car pts)
                             p2 (Cadr pts))
                       (setq cir1 (circle aDoc
                                          (setq uPt1 (polar (vlax-curve-getPointAtDist
                                                         e 6.0) (+ ang (/ pi 2.)) 0.375))
                                          0.1875))
                       (setq cir2 (circle aDoc
                                          (setq uPt2 (polar (vlax-curve-getPointAtDist
                                                         e (- ln 6.0)) (+ ang (/ pi  2.))  0.375))
                                          0.1875))
                       (prompt "\nDrag & Pick Location rebar location:")
                       (while
                             (progn
                                   (setq gr   (grread t 15 0)
                                         code (car gr)
                                         cord (cadr gr)
                                         )
                                   (cond
                                 ((and (= 5 code)(> (c:cal "ang(p1,p2,cord)") 180))
                                  (setq entm (_moveblk entm cir1 uPt1
                                                   (setq uPt1 (polar uPt1 (+ ang (* pi 1.5)) 0.75))))
                                  (setq entm_ (_moveblk entm_ cir2 uPt2
                                                    (setq uPt2 (polar uPt2 (+ ang (* pi 1.5)) 0.75)))) T
                                  )
                                 ((and (= 5 code)(< (c:cal "ang(p1,p2,cord)") 180))
                                  (setq entm (_moveblk entm cir1 uPt1
                                                   (setq uPt1 (polar uPt1 (+ ang (/ pi 2.)) 0))))
                                  (setq entm_ (_moveblk entm_  cir2  uPt2
                                                    (setq uPt2 (polar uPt2 (+ ang (/ pi 2.)) 0)))) T
                                  )
                                 )
                                   )
                             )
                       (vla-delete cir1)
                       (vla-delete cir2)
                       )
                 )(redraw e 4)(setq entm nil entm_ nil)
           )
      )(princ)
     )(vl-load-com)
(princ)