yaojing38 发表于 2023-5-19 20:41:01

grread的正交，功力不够，求大佬加持！！！

本帖最后由 yaojing38 于 2023-5-19 20:46 编辑

事情是，，想获得选取文字后面会拉出一条跟随的正交直线，，，但是不太熟悉grread的高深，，感觉获得了PT点，，线也画出来了但是，文字却移动了十万八千里，，，有点蒙，，请有空大家帮看看！谢谢！代码实现了画不是正交的斜线。。。。感觉就差一步。。。。但又感觉还好远。。。。无奈！
;;-------------------------------------------------
(defun c:tt ()
;(setq pt0 (getpoint))
(setvar 'orthomode 1)
(setq a(entsel))
(setq pt0 (cadr a))
(setq pt1 (cadr a))
(setq ty (car a) )
(setq enx (entget ty)
      txtpp (textbox enx)
    zg (cadr(cadr txtpp))
   
)
(command "line" pt0)
(setq e(vlax-ename->vla-object ty))
(setq loop t)
(while loop
    (setq gr (grread t 15 0))
    (setq pt (trans (cadr gr) 1 0))
   
    (cond
      
      ;((equal gr '(2 15))    ;F8切换正交开关
      ;      (if (= f8 0)
      ;      (progn (setq f8 1) (princ "\n <正交 开>"))
      ;      (progn (setq f8 0) (princ "\n <正交 关>"))
      ;      )
      ;      (setvar 'orthomode f8)
      ;      (redraw)
      ;    )
      ((= 5 (car gr))
      ;(vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))
      (vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))
      
      (redraw)
       (grdraw pt1 pt 255)
      (setq pt0 pt)
      )
      ((or (= 3 (car gr)) (= 32 (cadr gr)))
      (setq loop nil)
      (setq pt (polar pt1(angle pt1 pt) (- (distance pt1 pt) (/ zg 3))))
      (command pt "")
      (redraw)
      )
    )
)




)
;;-------------------------------------------------



Bao_lai 发表于 2023-5-19 23:23:07

第37行修改：(grdraw (list (car pt) (cadr pt1)) pt 1 8)
我测试文字没有飞，看你是否可能处在ucs下面，不是wcs需要坐标转换，不然文字会飞。

liuhe 发表于 2023-5-19 23:57:15

grread 没有捕捉功能

linzenghuo 发表于 2023-5-20 04:50:40

本帖最后由 linzenghuo 于 2023-5-20 22:10 编辑

http://www.mjtd.com/?fromuid=7301948过来看看

cghdy 发表于 2023-5-20 08:27:38

yaojing38 发表于 2023-5-20 13:00:47

谢谢1楼的帮助，写的有点乱总归实现了，，在前辈的代码基础上，给有需要的人。。。。

;;-------------------------------------------------
(defun c:tt ( / a ang ang1 ang3 e enx gr loop pt pt0 pt1 pt11 txtpp ty zg)
        (setvar 'orthomode 0)
        (setq a(entsel))
        (setq pt0 (cadr a))
        (setq pt1 (cadr a))
        (setq ty (car a) )
        (setq enx (entget ty)
                  txtpp (textbox enx)
                zg (cadr(cadr txtpp))
        )
(command "line" pt0)
        (setq e(vlax-ename->vla-object ty))
        (setq loop t)
(while loop
    (setq gr (grread t 15 0))
    (setq pt (trans (cadr gr) 1 0))
        (cond
                       
                        ;((equal gr '(2 15))    ;F8切换正交开关
                        ;                        (if (= f8 0)
                        ;                                (progn (setq f8 1) (princ "\n <正交 开>"))
                        ;                                (progn (setq f8 0) (princ "\n <正交 关>"))
                        ;                        )
                        ;                        (setvar 'orthomode f8)
                        ;                        (redraw)
                        ;                )
      ((= 5 (car gr))
                        (setq ang (atoi (angtos (angle pt1 pt))))
                        (if(> ang 315)(setq ang (- 360 ang)))
                        (cond ((and (< ang 45) (> ang -45))
                  (setq pt (list (car pt) (cadr pt1)))
                  )
                  ((and (< ang 135) (> ang 45))
                   (setq pt (list (car pt1) (cadr pt)))
                  )
                  ((and (< ang 225) (> ang 135))
                   (setq pt (list (car pt) (cadr pt1)))
                  )
                  ((and (< ang 315) (> ang 225))
                   (setq pt (list (car pt1) (cadr pt)))
                  )
          )
                                (vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))
                                (redraw)
                                (grdraw pt1 pt 255)
                                (setq pt0 pt)
      )
      ((or (= 3 (car gr)) (= 32 (cadr gr)))
      (setq loop nil)
                                (setq ang3 (rem (angle pt0 pt) (* 1 pi )))
                                (setq ang1 (rem (angle pt0 pt) (* 1 pi )))
                       
                                (cond
                                ((and (< (car pt0) (car pt1)) )
               
                                (setq ang1 (+ ang1 (* 0.5 pi)))
                                )
                                ((and (> (car pt0) (car pt1)) )
               
                                (setq ang1 (- ang1 (* 0.5 pi)))
                                )
                                ((and(> (cadr pt0) (cadr pt1)))
                               
                                (setq ang1 (+ ang1 (* 0.5 pi)))
                                )
                                ((and(< (cadr pt0) (cadr pt1)))
               
                                (setq ang1 (- ang1 (* 0.5 pi)))
                                )

                        )
                                (setq pt11 (polar pt1ang1 (- (distance pt1 pt) (/ zg 2))))
              (command pt11 "")
                                (redraw)
      )
    )
)
)
;;-------------------------------------------------

页: [1]
查看完整版本: grread的正交，功力不够，求大佬加持！！！