鼠标任意点击两点绘制水平中点的构造线xline

qinhengda

ssyfeng 发表于 2024-10-8 15:48
是不是这样：

谢谢大佬，离我预期的接近了，但是我想要的是鼠标输入两点之后绘制中点的构造线，不是点击实体。

黄翔

2. (defun c:11()
   
3. (vl-load-com)
   
4. (if
   
5.   (and
   
6.     (setq _pt1(getpoint "\n第一点"))
   
7.     (setq _pt2(getpoint _pt1 "\n第二点"))
   
8.   )
   
9.   (progn
   
10.     (setq _mspace (vla-get-modelspace  (vla-get-activedocument(vlax-get-acad-object))))
    
11.     (setq _pt3 (list (car _pt2) (cadr _pt1)))   
    
12.     (setq _pt4 (list (* 0.5 (+ (car _pt1)(car _pt2))) (cadr _pt1)))   
    
13.     (vla-addline _mspace (vlax-3d-point _pt1) (vlax-3d-point _pt3))
    
14.     (vla-addline _mspace (vlax-3d-point _pt3) (vlax-3d-point _pt2))
    
15.     (setq _pt5 (polar _pt4 (* 0.5 pi) 10))   
    
16.     (setq _myxline (vla-addXline _mspace (vlax-3d-point _pt5)(vlax-3d-point _pt4)))
    
17.   )
    
18. )
    
19. (princ)     
    
20. )

(defun c:11()<br /> (vl-load-com)<br /> (if<br />   (and<br />     (setq _pt1(getpoint "\n第一点"))<br />     (setq _pt2(getpoint _pt1 "\n第二点"))<br />   )<br />   (progn<br />     (setq _mspace (vla-get-modelspace  (vla-get-activedocument(vlax-get-acad-object))))<br />     (setq _pt3 (list (car _pt2) (cadr _pt1)))    <br />     (setq _pt4 (list (* 0.5 (+ (car _pt1)(car _pt2))) (cadr _pt1)))    <br />     (vla-addline _mspace (vlax-3d-point _pt1) (vlax-3d-point _pt3))<br />     (vla-addline _mspace (vlax-3d-point _pt3) (vlax-3d-point _pt2))<br />     (setq _pt5 (polar _pt4 (* 0.5 pi) 10))    <br />     (setq _myxline (vla-addXline _mspace (vlax-3d-point _pt5)(vlax-3d-point _pt4)))<br />   )<br /> )<br /> (princ)     <br /> )

qinhengda

黄翔 发表于 2024-10-9 10:49

哇大佬，这个可以的了，但，那个辅助的线可以删除吗，即点完两个点，仅保留构造线

黄翔

(vla-addline _mspace (vlax-3d-point _pt1) (vlax-3d-point _pt3))
    (vla-addline _mspace (vlax-3d-point _pt3) (vlax-3d-point _pt2))
这两句删掉就可以了啊.

xyp1964

1. (defun c:tt ()
   
2.   (while (and (setq p1 (getpoint "\n第1点<退出>: "))
   
3.               (setq p2 (getpoint p1 "\n第2点<退出>: "))
   
4.          )
   
5.     (setq p3 (list (car p2) (cadr p1))
   
6.           pt (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p3)
   
7.     )
   
8.     (command "Xline" "v" "non" pt "")
   
9.   )
   
10.   (princ)
    
11. )

(defun c:tt ()<br />   (while (and (setq p1 (getpoint "\n第1点<退出>: "))<br />               (setq p2 (getpoint p1 "\n第2点<退出>: "))<br />          )<br />     (setq p3 (list (car p2) (cadr p1))<br />           pt (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p3) <br />     )<br />     (command "Xline" "v" "non" pt "")<br />   )<br />   (princ)<br /> )

C哩C哩

这个厉害了啊