[编程交流] 带弧的GRRDRAW

(defun c:test (/ pt1 pt2 pt3 pt4 pt5 pt6 wid)
 (setq wid (getint "\Width? <10>"))
 (if (= wid nil) (setq wid 10))
   (if  
     (setq pt1 (getpoint "\nSelect 1st point"))
       (progn
         ;(command "circle" pt1 4.0)
         (while 
           (not (= (car (setq pt2 (grread t 15 0))) 3))
           (redraw) 
           (if
             (listp (setq pt2 (cadr pt2)))
             (progn
        (setq pt3 (polar pt1 (* pi 0.5) (* wid 0.5))
              pt4 (polar pt1 (* pi 1.5) (* wid 0.5))
              pt5 (polar pt2 (* pi 0.5) (* wid 0.5))
              pt6 (polar pt2 (* pi 1.5) (* wid 0.5)))
                   (grdraw pt3 pt4 1 3)
                   (grdraw pt3 pt5 1 3)
                   (grdraw pt4 pt6 1 3)
                   (grdraw pt5 pt6 1 3)
             )
           )
         )
       )
   )
 (command "_pline"
   (list (car pt3) (cadr pt3))
   (list (car pt4) (cadr pt4))
   (list (car pt6) (cadr pt6))
   (list (car pt5) (cadr pt5))
   (list (car pt3) (cadr pt3)) "C")
 (redraw)
 (princ)
)

;Stefan M. 15.02.2016
(defun C:SLOT ( / p1 w n h e p g r p o enter)
 (defun 2dp (p1 p2 d)
   (reverse (cdr (reverse (trans (polar p1 (+ (angle p1 p2) (/ pi 2)) d) 1 n))))
   )
 (if
   (and
     (setq w (/ (cond ((getdist "\nWidth <10>: ")) (10.0)) 2))
     (setq p1 (getpoint "\nStart point: "))
     )
   (progn
     (setq n (trans '(0 0 1) 1 0 T)
           h (caddr (trans p1 1 n))
           e (entmakex
               (list
                 '(0 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                 (cons 38 h)
                 '(90 . 4)
                 '(70 . 1)
                 (cons 10 (2dp p1 p1 (- w)))
                 '(42 . 0)
                 (cons 10 (2dp p1 p1 (- w)))
                 '(42 . 1)
                 (cons 10 (2dp p1 p1 w))
                 '(42 . 0)
                 (cons 10 (2dp p1 p1 w))
                 '(42 . 1)
                 (cons 210 n)
                 )
               )
           o (vlax-ename->vla-object e)
           )
   (grread T)
   (while (not enter)
     (setq g (grread t 15 0)
           r (car  g)
           p (cadr g)
           )
     (cond
       ((or (member r '(11 12 25)) (= p 13) (= p 32)) (entdel e) (setq enter T))
       ((= r 5)
        (vlax-put o 'coordinates
           (append
             (2dp p1 p (- w))
             (2dp p p1 w)
             (2dp p p1 (- w))
             (2dp p1 p w)
             )
           )
        )
       ((= r 3) (setq enter T))
       )
     )
   )
 )
 (princ)
 )