[编程交流] 没时间了。GRVEC和Grread

(DEFUN GETARCLASTPOINT (_pt1 _pt2 _msg`str / *error* *-ce _msg`str *-pt)
 
 (defun *error* (msg)
   (and *-ce (setvar "cmdecho" *-ce)))
 
 (SETQ *-ce (GETVAR "cmdecho"))
 (SETVAR "cmdecho" 0)
 (or _msg`str (setq _msg`str "Specify point: "))
 (PROMPT (strcat "\n" _msg`str))
 (and (VL-CMDF (GETCNAME "_ARC") _pt1 _pt2 pause)
      (SETQ *-pt (GETVAR "LASTPOINT"))
      (ENTDEL (ENTLAST)))
 (*error* nil)
 
 *-pt)

;; Make3PointsArc (gile)
;; Entmakes an arc
;; Returns the arc ename
;;
;; Arguments
;; p1, p2, p3: points (UCS coordinates)
(defun Make3PointsArc (p1 p2 p3 / m1 m2 a1 a2 pi/2 cen Xang norm cen rad)
 (setq m1   (midPoint p1 p2)
       m2   (midPoint p2 p3)
       a1   (angle p1 p2)
       a2   (angle p2 p3)
       pi/2 (/ pi 2)
       norm (trans '(0. 0. 1.) 1 0 T)
       Xang (angle '(0. 0. 0.) (trans (getvar 'ucsxdir) 0 norm))
       cen  (inters m1 (polar m1 (+ a1 pi/2) 1.0) m2 (polar m2 (+ a2 pi/2) 1.0) nil)
       rad  (distance cen p1)
 )
 (if (clockwise-p p1 p2 p3)
   (setq start (angle cen p3)
         end   (angle cen p1)
   )
   (setq start (angle cen p1)
         end   (angle cen p3)
   )
 )
 (entmakex
   (list
     '(0 . "ARC")
     (cons 10 (trans cen 1 norm))
     (cons 40 rad)
     (cons 50 (+ Xang start))
     (cons 51 (+ Xang end))
     (cons 210 norm)
   )
 )
)
;; MidPoint (gile)
;; Returns the middle point between p1 and p2
(defun MidPoint (p1 p2)
 (mapcar (function (lambda (x1 x2) (/ (+ x1 x2) 2.))) p1 p2)
)
;; Clockwise-p (gile)
;; evaluates if p1, p2, p3 are clockwise
(defun clockwise-p (p1 p2 p3)
 (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
)
;; STR2PT (gile)
;; Converts a string into a point (grread input)
;;
;; Argument: a string
;; Return: a 3d point or nil (if incorrect string)
(defun str2pt (str)
 (setq str (mapcar 'read (str2lst str ",")))
 (if (and (vl-every 'numberp str)
          (< 1 (length str) 4)
     )
   (trans str 0 0)
 )
)
;; STR2LST (gile)
;; Splits a string with separator into a list
;;
;; Arguments
;; str = string
;; sep = separator
(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
         (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)
;; gr-3PointsArc (gile)
;; grread using to create an arc by 3 points
;;
;; Arguments
;; p1 p2: the 2 first points (UCS coordinates)
(defun gr-3PointsArc (p1 p2 / *error* loop gr p3 arc str)
 (defun *error* (msg)
   (or (= msg "Function cancelled")
       (princ (strcat "Error: " msg))
   )
   (and arc (entdel arc) (setq arc nil))
   (princ)
 )
 (setq loop T)
 (while (and (setq gr (grread T 12 0)) loop)
   (and arc (entdel arc) (setq arc nil))
   (cond
     ((= 5 (car gr))
      (setq p3 (cadr gr))
      (setq arc (Make3PointsArc p1 p2 p3))
     )
     ((= 3 (car gr))
      (setq arc  (Make3PointsArc p1 p2 p3)
            loop nil
      )
     )
     ((equal gr '(2 13))
      (cond
        ((and str (setq pt (str->pt str)))
         (setq arc (Make3PointsArc p1 p2 p3))
         (setq loop nil)
         (grtext)
        )
        (T
         (setq str nil)
         (princ
           "\nIncorrect point.\nSpecify the third point: "
         )
        )
      )
     )
     (T
      (if (= (cadr gr)  ;_ backspace
        (or
          (and str
               (/= str "")
               (setq str (substr str 1 (1- (strlen str))))
               (princ (chr )
               (princ (chr 32))
          )
          (setq str nil)
        )
        (or
          (and str (setq str (strcat str (chr (cadr gr)))))
          (setq str (chr (cadr gr)))
        )
      )
      (and str (princ (chr (cadr gr))))
     )
   )
 )
)
(defun c:test (/ p1 p2)
 (if (and
       (setq p1 (getpoint "\nSpecify the first point: "))
       (setq p2 (getpoint p1 "\nSpecify the second point: "))
       (not (equal p1 p2))
       (princ "\nSpecify the third point: ")
     )
   (gr-3PointsArc p1 p2)
 )
 (princ)
)

(DEFUN GETARCLASTPOINT (_pt1 _pt2 _msg`str / *error* *-ce _msg`str *-pt)
 
 (defun *error* (msg)
   (and *-ce (setvar "cmdecho" *-ce)))
 
 (SETQ *-ce (GETVAR "cmdecho"))
 (SETVAR "cmdecho" 0)
 (or _msg`str (setq _msg`str "\nSpecify point: "))
 (PROMPT (strcat "\n" _msg`str))
 (and (VL-CMDF "_.ARC" "_non" _pt1 "_non" _pt2 pause)
      (SETQ *-pt (GETVAR "LASTPOINT"))
      (ENTDEL (ENTLAST)))
 (*error* nil)
 
 *-pt)

;; Make3PointsArc (gile)
;; Entmakes an arc
;; Returns the arc ename
;;
;; Arguments
;; p1, p2, p3: points (UCS coordinates)
(defun Make3PointsArc (p1 p2 p3 / m1 m2 a1 a2 pi/2 cen Xang norm cen rad)
 (setq m1   (midPoint p1 p2)
       m2   (midPoint p2 p3)
       a1   (angle p1 p2)
       a2   (angle p2 p3)
       pi/2 (/ pi 2)
       norm (trans '(0. 0. 1.) 1 0 T)
       Xang (angle '(0. 0. 0.) (trans (getvar 'ucsxdir) 0 norm))
       cen  (inters m1 (polar m1 (+ a1 pi/2) 1.0) m2 (polar m2 (+ a2 pi/2) 1.0) nil)
       rad  (distance cen p1)
 )
 (if (clockwise-p p1 p2 p3)
   (setq start (angle cen p3)
         end   (angle cen p1)
   )
   (setq start (angle cen p1)
         end   (angle cen p3)
   )
 )
 (entmakex
   (list
     '(0 . "ARC")
     (cons 10 (trans cen 1 norm))
     (cons 40 rad)
     (cons 50 (+ Xang start))
     (cons 51 (+ Xang end))
     (cons 210 norm)
   )
 )
)
;; MidPoint (gile)
;; Returns the middle point between p1 and p2
(defun MidPoint (p1 p2)
 (mapcar (function (lambda (x1 x2) (/ (+ x1 x2) 2.))) p1 p2)
)
;; Clockwise-p (gile)
;; evaluates if p1, p2, p3 are clockwise
(defun clockwise-p (p1 p2 p3)
 (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
)
;; STR2PT (gile)
;; Converts a string into a point (grread input)
;;
;; Argument: a string
;; Return: a 3d point or nil (if incorrect string)
(defun str2pt (str)
 (setq str (mapcar 'read (str2lst str ",")))
 (if (and (vl-every 'numberp str)
          (< 1 (length str) 4)
     )
   (trans str 0 0)
 )
)
;; STR2LST (gile)
;; Splits a string with separator into a list
;;
;; Arguments
;; str = string
;; sep = separator
(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
         (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)
;; gr-3PointsArc (gile)
;; grread using to create an arc by 3 points
;;
;; Arguments
;; p1 p2: the 2 first points (UCS coordinates)
(defun gr-3PointsArc (p1 p3 / *error* loop gr p3 arc str)
 (defun *error* (msg)
   (or (= msg "Function cancelled")
       (princ (strcat "Error: " msg))
   )
   (and arc (entdel arc) (setq arc nil))
   (princ)
 )
 (setq loop T)
 (while (and (setq gr (grread T 12 0)) loop)
   (and arc (entdel arc) (setq arc nil))
   (cond
     ((= 5 (car gr))
      (setq p2 (cadr gr))
      (setq arc (Make3PointsArc p1 p2 p3))
     )
     ((= 3 (car gr))
      (setq arc  (Make3PointsArc p1 p2 p3)
            loop nil
      )
     )
     ((equal gr '(2 13))
      (cond
        ((and str (setq pt (str->pt str)))
         (setq arc (Make3PointsArc p1 p2 p3))
         (setq loop nil)
         (grtext)
        )
        (T
         (setq str nil)
         (princ
           "\nIncorrect point.\nSpecify the third point: "
         )
        )
      )
     )
     (T
      (if (= (cadr gr)  ;_ backspace
        (or
          (and str
               (/= str "")
               (setq str (substr str 1 (1- (strlen str))))
               (princ (chr )
               (princ (chr 32))
          )
          (setq str nil)
        )
        (or
          (and str (setq str (strcat str (chr (cadr gr)))))
          (setq str (chr (cadr gr)))
        )
      )
      (and str (princ (chr (cadr gr))))
     )
   )
 )
)
(defun c:test (/ p1 p3)
 (if (and
       (setq p1 (getpoint "\nSpecify the first point: "))
       (setq p3 (getpoint p1 "\nSpecify the second point: "))
       (not (equal p1 p3))
       (princ "\nSpecify the third point: ")
     )
   (gr-3PointsArc p1 p3)
 )
 (princ)
)