没时间了。GRVEC和Grread 乐筑天下 - Powered by Discuz! Archiver

Lee Mac 发表于 2022-7-6 13:28:00

提供另一组眼睛：

(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)

gile 发表于 2022-7-6 13:33:21

你好

如果你真的想用grread画一个3点的弧，你可以启发以下例程。
但我同意李和艾伦的观点，司令部提供了更多的选择和全面的OSNAP。

;; 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)
)

alanjt 发表于 2022-7-6 13:36:47

非常好的gile！

顺便说一句，李！暂停=“\\”

很好地理解了“and”，但我们都忘记了使用osnap覆盖：
(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)
我以前没有注意到，但我也将（GETCNAME“\u ARC”）替换为“\u.ARC”，因为这是您真正需要的。

Lee Mac 发表于 2022-7-6 13:42:24

非常好的Gile！

谢谢Alan，是的，我也忘了快照。。。哦，好吧，看起来两只眼睛比一只好。。

alanjt 发表于 2022-7-6 13:44:30

大致情况。

Lee Mac 发表于 2022-7-6 13:49:07

尽管我很好奇。。。只需要解剖一下你的方法Gile。。。

这是我的图表，让其他人受益

Lee Mac 发表于 2022-7-6 13:50:59

稍微扭转一下：

;; 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)
)

页: 1 [2]

乐筑天下's Archiver