（已解决）动态画坡度线，支持捕捉

sandyvs

好吧，自己想个笨方法解决了！


;;此程序为按坡比划线，之前发的不支持捕捉http://bbs.mjtd.com/thread-187017-1-1.html?_dsign=20b6630e

;;加入捕捉之后，想以捕捉点的x坐标或y坐标确定长度，但只能实现其中一种，如何可以选择以x坐标或y坐标确定长度？
;;请前辈指导下！


(defun c:tt (/ aa ang stp enp loop gr code ptx l0 ed str tj wz a b)
        (setvar "cmdecho" 0)
        (setvar "nomutt" 0)
        (setvar "osmode" 145)
        (setq scale (getvar "dimscale"))
        (or(setq aa (getreal "\n输入坡度(垂直“0”,水平“999”，二、四象限加“-”)："))
        (setq aa 999))
        (setq stp (getpoint "\n输入或拾取起点[指定线长(左、下加“-”)]："))
        (while aa
                (cond
                        ((= aa 0)
                                (setq ang (* pi 0.5))
                        )
                        ((= aa 999)
                                (setq ang 0)
                        )
                        (T
                                (setq ang (atan (/ 1 aa)))
                        )
                )
                                (setq enp (polar stp ang 0.001))
                                (entmakex (list '(0 . "line") (cons 10 stp) (cons 11 enp)))
                                (setq l0 (entlast))
                                (setq ed (entget l0))
                                (setq a 1)
                                (setq b 0)  
                                (setq loop t)                                ;grread
                                (while loop
                                        (and (setq gr (grread t 12 0)) (/= (car gr) 3) loop)
                                        (setq code (car gr))
                                        (setq ptx (cadr gr))
                                        (cond
                                                ((equal gr '(2 6))                ;;按下了f3
                                                        (if (< (getvar "osmode") 16384)
                                                                (setvar "osmode" (+ (getvar "osmode") 16384))
                                                                (setvar "osmode" (- (getvar "osmode") 16384))
                                                        )
                                                )
                                                ((equal gr '(2 15))                        ;;按下了f8
                                                        (if (= (getvar "orthomode") 0)
                                                                (setvar "orthomode" 1)
                                                                (setvar "orthomode" 0)
                                                        )
                                                )
                                                ((= code 3)                        ;; 鼠标单击
                                                (command "undo" "be")
                                                        (if (setq gr (get-ospoint ptx))
                                                                ;(print gr)
                                                                (setq ptx (car gr))
                                                        )
                                                (setq wz nil)
                                                (setq loop nil)
                                                )
                                                ((= code 5)                        ; 鼠标移动
                                                        (if (setq gr (get-ospoint ptx))
                                                                (progn
                                                                        ;(print gr)
                                                                        (setq ptx (car gr))
                                                                        (redraw)
                                                                        (apply 'draw-atpoint gr)
                                                                        t
                                                                )
                                                                (redraw)
                                                        )
                                                        (cond
                                                                ((= aa 999)
                                                                                (setq enp (polar stp ang (- (car ptx)(car stp))))
                                                                                (entmod (subst (cons 11 enp) (assoc 11 ed) ed ))
                                                                )
                                                                ((= aa 0)
                                                                                (setq enp (polar stp ang (- (cadr ptx)(cadr stp))))
                                                                                (entmod (subst (cons 11 enp) (assoc 11 ed) ed ))
                                                                )
                                                                (t
                                                                               (setq enp (polar stp ang (+(*(/ (- (car ptx)(car stp))(cos ang))a) (*(/ (- (cadr ptx)(cadr stp))(sin ang))b))));;更新x或y坐标
                                                                    
                                                                              (entmod (subst (cons 11 enp) (assoc 11 ed) ed ))               
                                                                )
                                                        )
                                                )
                                               ((MEMBER (CADR GR) '(83 115));s键
                                                        (setq a 1)
                                                        (setq b 0)
                                               ）
                                              ((MEMBER (CADR GR) '(67 99));c键
                                                        (setq a 0)
                                                        (setq b 1)
                                               ）

                                                ((= code 25);                鼠标右击
                                                        (if l0
                                                                (entdel l0)
                                                        )
                                                        (setq loop nil)
                                                        (setq aa nil)
                                                )
                                                
                                        )
                                )
                                (redraw)
                                (setq aa (getreal "\n继续输入坡度(垂直“0”,水平“999”,二四象限加“-”)："))
                                (setq stp enp)
        )
        (redraw)
        (princ)
)


;;;功能：支持对象捕捉的grread
;;;          代码源自fools
;;;日期：zml84 修改于 2009-05-20
(setq *LST*
         '((1
            "_end"
            ((-1 1) (-1 -1))
            ((-1 -1) (1 -1))
            ((1 -1) (1 1))
            ((1 1) (-1 1))
           )
           (2
            "_mid"
            ((0 1.414) (-1.225 -0.707))
            ((-1.225 -0.707) (1.225 -0.707))
            ((1.225 -0.707) (0 1.414))
           )
           (4
            "_cen"
            ((0 1) (-0.707 0.707))
            ((-0.707 0.707) (-1 0))
            ((-1 0) (-0.707 -0.707))
            ((-0.707 -0.707) (0 -1))
            ((0 -1) (0.707 -0.707))
            ((0.707 -0.707) (1 0))
            ((1 0) (0.707 0.707))
            ((0.707 0.707) (0 1))
           )
           (8
            "_nod"
            ((0 1) (-0.707 0.707))
            ((-0.707 0.707) (-1 0))
            ((-1 0) (-0.707 -0.707))
            ((-0.707 -0.707) (0 -1))
            ((0 -1) (0.707 -0.707))
            ((0.707 -0.707) (1 0))
            ((1 0) (0.707 0.707))
            ((0.707 0.707) (0 1))
            ((-1 1) (1 -1))
            ((-1 -1) (1 1))
           )
           (16
            "_qua"
            ((0 1.414) (-1.414 0))
            ((-1.414 0) (0 -1.414))
            ((0 -1.414) (1.414 0))
            ((1.414 0) (0 1.414))
           )
           (32
            "_int"
            ((-1 1) (1 -1))
            ((-1 -1) (1 1))
            ((1 0.859) (-0.859 -1))
            ((-1 0.859) (0.859 -1))
            ((0.859 1) (-1 -0.859))
            ((-0.859 1) (1 -0.859))
           )
           (64
            "_ins"
            ((-1 1) (-1 -0.1))
            ((-1 -0.1) (0 -0.1))
            ((0 -0.1) (0 -1.0))
            ((0 -1.0) (1 -1))
            ((1 -1) (1 0.1))
            ((1 0.1) (0 0.1))
            ((0 0.1) (0 1.0))
            ((0 1.0) (-1 1))
           )
           (128
            "_per"
            ((-1 1) (-1 -1))
            ((-1 -1) (1 -1))
            ((0 -1) (0 0))
            ((0 0) (-1 0))
           )
           (256
            "_tan"
            ((0 1) (-0.707 0.707))
            ((-0.707 0.707) (-1 0))
            ((-1 0) (-0.707 -0.707))
            ((-0.707 -0.707) (0 -1))
            ((0 -1) (0.707 -0.707))
            ((0.707 -0.707) (1 0))
            ((1 0) (0.707 0.707))
            ((0.707 0.707) (0 1))
            ((1 1) (-1 1))
           )
           (512
            "_nea"
            ((-1 1) (1 -1))
            ((1 -1) (-1 -1))
            ((-1 -1) (1 1))
            ((1 1) (-1 1))
           )
           (1024 "_qui")
           (2048
            "_app"
            ((-1 1) (-1 -1))
            ((-1 -1) (1 -1))
            ((1 -1) (1 1))
            ((1 1) (-1 1))
            ((-1 1) (1 -1))
            ((-1 -1) (1 1))
           )
           (4096
            "_ext"
            ((0.1 0) (0.13 0))
            ((0.2 0) (0.23 0))
            ((0.3 0) (0.33 0))
           )
           (8192
            "_par"
            ((0 1) (-1 -1))
            ((1 1) (0 -1))
           )
          )
)
;;;=================================================================*
;;;功能：计算在当前对象捕捉设置情况下，指定点的对象捕捉点位         *
;;;思路：获取当前的对象捕捉模式；*
;;;      逐个使用osnap来尝试获取点位；*
;;;      比较点位距离指定点的距离，最近的即为结果。*
;;;返回：(捕捉到的点位   捕捉模式)                                  *
;;;      捕捉模式为0表示，不捕捉。*
(defun GET-OSPOINT (PT / LST_JG OS N PT_NEW)
    (setq LST_JG '()
          OS         (getvar "osmode")
    )
    (if        (< 0 OS 16384)
        (foreach N (reverse *LST*)
            (if        (and (= (logand OS (car N)) (car N))
                     (setq PT_NEW (osnap PT (cadr N)))
                )
                (setq
                    LST_JG (cons (list (distance PT_NEW PT)
                                       PT_NEW
                                       (car N)
                                 )
                                 LST_JG
                           )
                )
            )
        )
        (setq LST_JG (list (list 0 PT 0)))
    )
    ;;根据距离大小排序
    (if        (> (length LST_JG) 1)
        (setq LST_JG (vl-sort LST_JG
                              (function        (lambda        (E1 E2)
                                            (< (car E1) (car E2))
                                        )
                              )
                     )
        )
    )
    ;;返回
;;;    (print LST_JG)
    (cdr (car LST_JG))
)

;;;=================================================================*
;;;功能：在指定点  绘制  指定的靶标                                 *
;;;参数：PT -----要绘制的位置                                       *
;;;      I  -----捕捉模式单项值。例如：1 or 2 or 4 ...              *
(defun DRAW-ATPOINT (PT I / SIZE COLOR MATRIX LST)
    (foreach REAL '(-0.5 0 0.5)
        (setq SIZE  (* (+ (read (getenv "AutoSnapSize")) REAL)
                       (/ (getvar "VIEWSIZE")
                          (cadr (getvar "SCREENSIZE"))
                       )
                    )
              COLOR (read (getenv "AutoSnapColor"))
        )
        (setq MATRIX (list (list SIZE 0.0 0.0 (car PT))
                           (list 0.0 SIZE 0.0 (cadr PT))
                           (list 0.0 0.0 1.0 0.0)
                           (list 0.0 0.0 0.0 1.0)
                     )
        )
        (and (setq LST (cddr (assoc I *LST*)))
             (setq LST
                      (mapcar (function (lambda (X) (cons COLOR X))) LST)
             )
             (setq LST (apply 'append LST))
             (grvecs LST MATRIX)
        )
    )
)
;;;=================================================================*

depgfdepgf

自动切换中英输入法不错

sandyvs

depgfdepgf 发表于 2023-5-4 12:06
自动切换中英输入法不错

用的KBLAutoSwitch，不过没设置cad，cad用的赫斯的输入法