[编程交流] 绘制刀具退刀槽

(vl-load-com)
(defun C:test ( / a b c d e ang p1 cp dp o)
(if
 (and
   (setq a (getdist "\nEnter distance or pick points for "A":")
      b (getdist "\nEnter distance or pick points for "B":")
          c (entsel "\nPick first line:")
          d (entsel "\nPick second line:")
          e (car (entsel "\nPick endline line:"))
          cp (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car c)) (cadr c) nil)
         dp (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car d)) (cadr d) nil)
         ang (angle (vlax-curve-getClosestPointTo (vlax-ename->vla-object  e) cp nil) cp) 
         cp (vlax-curve-getClosestPointTo         (vlax-ename->vla-object  e) cp)         
         dp (vlax-curve-getClosestPointTo         (vlax-ename->vla-object  e) dp)                          
   )
 )
 (progn
   
(entmake 
  (list 
   (cons 0 "LINE") 
   (cons 10 (setq p1 (polar dp (angle dp cp) b)))
   (cons 11 (polar p1 ang a))
  )
)
(entmake 
  (list 
   (cons 0 "LINE") 
   (cons 10 (setq p1 (polar cp (angle cp dp) b)))
   (cons 11 (polar p1 ang a))
  )
)
(entmake
  (list
    (cons 0 "LINE")
        (cons 10 (polar cp ang a))
        (cons 11 (polar dp ang a))
  )
)
(setq o (entlast) )
 (setvar 'filletrad 0)         
 (command ".fillet" (car c) o )
 (command ".fillet" (car d) o )
(princ)  
)
))

(defun C:test ( / a b l d ang e1 e2 e3 a1 a2 a3 p p1 p2 p3 p4 select_e makeline)
;; JDiala 07-01-14
;; Cadtutor.net
(defun select_e ( x msg / e sel)
 (while
   (not e)
     (progn 
       (setq sel (entsel msg))
       (cond
         ( (= nul sel)
           (princ "\nMissed! ")
         )
         ( (/= x (cdr (assoc 0 (entget (car sel)))))
           (princ "\nInvalid selection. " )
         )        
         ( (= x (cdr (assoc 0 (entget (car sel)))))
           (setq e sel))
         (t nil)
       ) 
     )
 )
)
(defun makeline (a b)
(entmake (list (cons 0 "LINE") (cons 10 a)(cons 11 b)))
)
 (setq a2 nil )
 (if
   (setq a (getdist "\nEnter value for A: ")
         b (getdist "\nEnter value for B: ")
         l (getdist "\nEnter value for L: ")
   )
   (if
     (setq e1 (select_e "LINE" "\nSelect first line : ")) 
     (progn
       (setq a1 (angle (setq p1 (cdr (assoc 10 (entget (car e1)))))
                       (setq p2 (cdr (assoc 11 (entget (car e1)))))
                )
             d  (distance p1 p2)   
       )
       (while (not a2)
         (setq e2 (select_e "LINE" "\nSelect second line :"))
           (cond
             ( (equal (car e1) (car e2))
               (princ "\nPicked the same line. Try again!")
             )
             ( (and 
                 (not 
                   (equal 
                     (setq a3 
                       (angle 
                         (cdr (assoc 10 (entget (car e2))))
                         (cdr (assoc 11 (entget (car e2))))
                       )
                     ) a1 1e-6
                   )
                 )
                 (not (equal (- a3 pi) a1 1e-6))
                 (not (equal (+ a3 pi) a1 1e-6))                
               )
               (princ "\nLines are not parallel. Try again")
             )
             (t (setq a2 a1))
           )
       )
       (setq e3 (select_e "LINE" "\nSelect third line : ")) 
     )
   )
 )
 (setq ang 
   (angle  
     (setq p 
       (vlax-curve-getClosestPointTo 
         (setq e 
           (vlax-ename->vla-object 
             (car e1)
           )
         )
         (cadr e1)
       )
     ) 
     (setq p1 
       (vlax-curve-getClosestPointTo 
         (vlax-ename->vla-object 
           (car e3)
         ) p
       )
     )
   )
 )
 
 (makeline
   (setq p1  (polar (cdr (assoc 10 (entget (car e3)))) (+ pi ang) l))
   (setq p2  (polar (cdr (assoc 11 (entget (car e3)))) (+ pi ang) l))
 )
 (makeline
   (setq p3  (polar (cdr (assoc 10 (entget (car e3)))) (+ pi ang) (+ l a)))
   (setq p4  (polar (cdr (assoc 11 (entget (car e3)))) (+ pi ang) (+ l a)))
 )
 (makeline 
   (polar p3 (angle p3 p4) b)
   (polar (polar p3 (angle p3 p4) b) ang a)
   
 )
 (makeline 
   (polar p4 (angle p4 p3) b)
   (polar (polar p4 (angle p4 p3) b) ang a)
 )
 
 (makeline 
   p1 
   (polar p1 ang l)
 )
 (makeline 
   p2 
   (polar p2 ang l)
 )
 (makeline 
  p3 (polar p3 (+ ang pi) (- d l a))
 )
 (makeline 
  p4 (polar p4 (+ ang pi) (- d l a))
 )
 (entdel (car e1))(entdel (car e2))
 (princ)
)