画直线并鼠标跟随，捕捉定点

guosheyang

     针对这里的帖子的提问  创建直线并跟随鼠标 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - Powered by Discuz! (mjtd.com)
     将朗大师的捕捉函数和类似的动态画法代码组合了下，勉强达到目标，但是存在圆心不能捕捉，有时候会莫名其妙地不能点击定点的毛病，请朋友们继续优化下，谢谢！

朗大师的捕捉函数
;;; grread捕捉子函数  

;;; name为移动的图元名，pt为光标点
;;; 返回值：如果有捕捉点则返回捕捉点，无则返回光标点
(defun osnappt (name pt / color d h k lst nearpt nearpt2 osmo pt1 pt2 pt3 pt4 pt5 ptx pty x)
(if name (entdel name))
(redraw)
(if (< (getvar "osmode") 16384)
(progn
(setq color (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))))
h (/ (getvar "viewsize") (cadr (getvar "screensize"))) d (getvar "pickbox")
lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h)) k (* 1.5 d h))
(if (setq nearpt (osnap pt "_END,_CEN,_NOD,_QUA,_INS,_TAN,_EXT"))(setq osmo 1))
(if (and(setq nearpt2 (osnap pt "_NEA"))(not (equal nearpt nearpt2 k)))
(setq osmo 2 nearpt nearpt2))
(if (and(setq nearpt2 (osnap pt "_MID"))(equal nearpt nearpt2 k))
(setq osmo 3 nearpt nearpt2))
(if (and(setq nearpt2 (osnap pt "_INT"))(equal nearpt nearpt2 k))
(setq osmo 4 nearpt nearpt2))))
(if name(entdel name))
(if nearpt
(progn
(setq ptx (car nearpt)pty (cadr nearpt))
(foreach x lst
(setq pt1 (list (- ptx x) (- pty x)) pt2 (list (+ ptx x) (- pty x))
pt3 (list (+ ptx x) (+ pty x)) pt4 (list (- ptx x) (+ pty x))
pt5 (list ptx (+ pty x)))
(cond
((= osmo 1)(grvecs (list color pt1 pt2 pt2 pt3 pt3 pt4 pt4 pt1)))
((= osmo 2)(grvecs (list color pt1 pt2 pt2 pt4 pt3 pt4 pt3 pt1)))
((= osmo 3) (grvecs (list color pt1 pt2 pt2 pt5 pt5 pt1)))
((= osmo 4) (grvecs (list color pt1 pt3 color pt2 pt4)))))
(setq pt nearpt)))
pt
)
;以下为隐藏内容
;;;主函数开始  动态放置直线 ----------------------------------------------------------------------------------
(DEFUN C:hhh(/ ANG CD ED ELI IP LS P P0 PICK PT QD ZD)
      (setq qd(getpoint"\n请点击直线起点")
            zd (getpoint qd"\n请点击直线终点")  
            cd(distance qd zd)
            ang(angle zd qd))
  (defun mc()
     (setq eli
       (list '(0 . "line") (cons 10 zd) (cons 11 (polar zd ang cd )) )  
     )
     (entmake eli)
  )            
   (SETQ p0 qd)
   (while(= 0(distance (cadr(grread t 4 0)) p0)))
   (mc)
   (setq ls(entlast)
         ed (entget ls)  
         pick nil)
(while(/=(car(setq p(grread t 15 0)))3)(redraw)
    (setq p(grread t 4 0))
    (princ)
    (setq ip (car p)
          pt (osnappt ls (cadr p))
    )
   (if(= ip 5)
      (progn
        (setq ed (Subst (cons 10 pt) (assoc 10 ed) ed)
              ed (Subst (cons 11(polar pt ang cd))(assoc 11 ed)ed))
        (entmod ed)
      )
   )
   (setq pick (= 3 ip))
  )
  (princ)
)

菜卷鱼

不要搞得太复杂了！！！！



(defun c:tt nil
  (setq pt (getpoint "\n指定第一点:"))
  (command "_.line" pt)
  (while pt
    (initget "Close Up")
    (setq pt (getpoint pt "\n指定下一点或 [闭合(C)/放弃(U)]:"))
    (command pt)
  )
  (command "move" (entlast) "" (getvar 'lastpoint) "pause")
  (prin1)
)

liuhe

guosheyang 发表于 2022-11-27 11:46
针对种动态的代码才存在 捕捉的问题   其他lisp代码不存在这问题

lisp就没有动态捕捉，是因为动态grread函数不支持捕捉，大神只是根据那个不精准点去算周围的精准点而已。c##那个动态就没有这个问题，因为本身函数就是支持动态捕捉，不需要二次计算

guosheyang

liuhe 发表于 2022-11-27 13:46
lisp就没有动态捕捉，是因为动态grread函数不支持捕捉，大神只是根据那个不精准点去算周围的精准点而已。 ...

是的， 我们表达的是一个意思   c#  c++ 当然功能更强大些，那是必然的 ，lisp更大众化些，属于下里巴人

819534890

看看藏了啥东西

freedom_ice

优秀，学习一下。

行天下

看看藏了啥东西

lxl217114

有意思，期待大佬们出手。

bai2000

看看藏了啥东西

中国梦

看看藏了啥东西

没有昵称呀

看看藏了啥东西

d1742647821

换个语言就没这么多破事儿了

yoyoho

谢谢分享!回覆学习!!!!