鼠标任意点击两点绘制水平中点的构造线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哩

这个厉害了啊

zhwc125

tigcat 发表于 2024-10-8 15:55
(defun c:tt(/ &tmp-pt)
  (progn(setq &tmp-pt(mapcar '* '(0.5 0.5)(mapcar '(lambda(x y)(+ x y))(getp ...

这个好用，超绘工具箱就用这个功能，两点之间生成中心构造线
好像只能水平方向生成，不能垂直方向和不同角度都可以就更好了

zhwc125

tigcat 发表于 2024-10-8 15:55
(defun c:tt(/ &tmp-pt)
  (progn(setq &tmp-pt(mapcar '* '(0.5 0.5)(mapcar '(lambda(x y)(+ x y))(getp ...

增加了垂直方向生成水平中心构造线
其他角度的不能生成构造线

(defun c:tt (/ pt1 pt2 mid dx dy)
  (setq pt1 (getpoint "\n选择第一个点："))
  (setq pt2 (getpoint pt1 "\n选择第二个点："))
  
  ;; 计算中点坐标
  (setq mid (mapcar '* '(0.5 0.5)
                  (mapcar '+ pt1 pt2)))
  
  ;; 计算两点在X和Y方向上的差值
  (setq dx (abs (- (car pt2) (car pt1))))
  (setq dy (abs (- (cadr pt2) (cadr pt1))))
  
  ;; 判断生成水平还是垂直构造线
  (if (> dx dy)
    ;; X方向差值大于Y方向，生成垂直线
    (command "xline" "v" "non" mid "")
    ;; Y方向差值大于X方向，生成水平线
    (command "xline" "h" "non" mid "")
  )
  (princ)
)

paulpipi

有点意思，下来试用一下，谢谢各位大佬