（已解决）动态画坡度线，支持捕捉
本帖最后由 sandyvs 于 2023-5-15 17:58 编辑好吧，自己想个笨方法解决了！
;;此程序为按坡比划线，之前发的不支持捕捉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)
)
)
)
;;;=================================================================*
自动切换中英输入法不错{:1_1:} depgfdepgf 发表于 2023-5-4 12:06
自动切换中英输入法不错
用的KBLAutoSwitch，不过没设置cad，cad用的赫斯的输入法
页:
[1]