qinhengda 发表于 2024-10-8 14:31:42

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

大佬们，求助想要实现这个功能：

我想到的思路是：用两个pause得到辅助线，将辅助线存储，然后再得到辅助线的中点，在中点处画一条垂直的构造线xline，其中xline所在的图层可以是当前图层或者新建一个图层都可以。
新人，就不知道该怎么写，求助各位老师不吝指教，万分感谢。

xyp1964 发表于 2024-10-9 13:52:20

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

vitalgg 发表于 2024-10-8 14:59:55

本帖最后由 vitalgg 于 2024-10-8 15:54 编辑

(defun c:dynxl (/ pt-base ents flag gr)
"两点间的竖向xline"
(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
(and
(setq pt-base (getpoint "first point:"))
(setq ents (list (entity:make-xline pt-base
                                    '(0.0 1.0 0.0)))))
(setq flag t)
(while flag (setq gr (grread t 16))
         (cond ((= 3 (car gr))
                "按下鼠标左键"
                (setq flag nil))
               ((or (= 25 (car gr))
                  (= 11 (car gr)))
                "按下鼠标右键"
                (mapcar (quote entdel)
                  ents)
                (setq ents nil)
                (setq flag nil))
               ((= 5 (car gr))
                "移动鼠标"
                (mapcar (function (lambda (x)
                        (vla-move (e2o x)
                                    (point:to-ax pt-base)
                                    (point:to-ax (point:mid pt-base (cadr gr)
                                                            )))))
                        ents)
                (setq pt-base (cadr gr)))
               (t "其它情况"
                  (princ gr))))
ents)

http://s3.atlisp.cn/static/videos/dynxl.mp4


扫码查看每个函数的功能和用法。
http://bbs.mjtd.com/data/attachment/forum/202409/24/214927kize9bamimb4c40v.png

黄翔 发表于 2024-10-8 15:09:48

(defun c:11()
(vl-load-com)
(if
(and
    (setq _pt1(getpoint "\n第一点"))
    (setq _pt2(getpoint _pt1 "\n第二点"))
)
(progn
    (setq _midPt (mapcar '(lambda (x y) (* 0.5 (+ x y))) _pt1 _pt2))
    (setq _xlinePt (polar _midPt (+ (angle _pt1 _pt2) (* 0.5 pi)) 10))

(setq _mspace (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))))
(setq _myxline (vla-addXline _mspace
                      (vlax-3d-point _midPt)
                        (vlax-3d-point _xlinePt)))

)
)
(princ)   
)

自贡黄明儒 发表于 2024-10-8 15:37:58

可以用计算器,执行command的过程中，调用‘cal

ssyfeng 发表于 2024-10-8 15:48:39

是不是这样：



tigcat 发表于 2024-10-8 15:55:05

(defun c:tt(/ &tmp-pt)
(progn(setq &tmp-pt(mapcar '* '(0.5 0.5)(mapcar '(lambda(x y)(+ x y))(getpoint "\n选择水平第一个点：")(getpoint "\n选择水平第二个点："))))(command "xline" "v" "non" &tmp-pt ""))
)

xyp1964 发表于 2024-10-8 22:46:25


juliana207 发表于 2024-10-8 23:06:55

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

挺好用的, 能帮忙改成水平的构造线么?:lol

qinhengda 发表于 2024-10-9 09:57:41

哇 谢谢大佬，这个动态的牛

qinhengda 发表于 2024-10-9 10:02:58

本帖最后由 qinhengda 于 2024-10-9 10:06 编辑

黄翔 发表于 2024-10-8 15:09

谢谢大佬，这个基本实现我想要的效果了。但是当两点不是水平线时，构造线仍是以两点的连线做垂直线，我想要是是当两点的不在同一水平线时，仍是做两点水平方向的y轴垂直线。
页: [1] 2
查看完整版本: 鼠标任意点击两点绘制水平中点的构造线xline