caiqs 发表于 2019-12-18 12:38
恩明白你的意思了，晚上给你改一下吧
嗯 好的 拜托了，我说的捕捉不是你那个a切换捕捉中点，是根据需要捕捉到自己想要放的任何位置，先谢了！
xyp1964 发表于 2019-12-18 00:54
谢谢版主，您给的关联函数，已经可以用了，已经满足了大部分情况的需要了，可不可以执行命令后能开启捕捉模式啊，现在如果想放到一个特定位置只能模糊放置，再手动移动一下，最好是可以自动捕捉需要放置的点，现在打开命令后鼠标就变成一个小矩形，我试着改了改代码，但是不会换成+可以捕捉的模式，麻烦您稍加修改可以吗，谢谢了
caiqs 发表于 2019-12-18 19:51
;;;师兄QQ361865648，只是单纯的把你两个函数合并了
;;作了优化，原命令保留
;;用右键或回车切换中垂线和 ...
您好我试了一下不行呢可出现切换但是画不出线（确认一下 全部加载，命令是test是吧）
caiqs 发表于 2019-12-18 19:51
;;;师兄QQ361865648，只是单纯的把你两个函数合并了
;;作了优化，原命令保留
;;用右键或回车切换中垂线和 ...
您好这样切换确实挺得劲，就用现在这个模式吧，现在连普通直线的垂线都画不出来，您看看哪个代码环节出问题了啊，你代码问的为什么要用四个点， 这代码不是我写的，我也不懂，不过我也觉得没啥意义，您顺道给改了吧，我不知道怎么改，两个点定一条直线就好，麻烦了！！
xj6019 发表于 2019-12-18 20:06
您好这样切换确实挺得劲，就用现在这个模式吧，现在连普通直线的垂线都画不出来，您看看哪个代码环节出 ...
我只是给你合并了，其它原函数没动
caiqs 发表于 2019-12-18 21:04
我只是给你合并了，其它原函数没动
也就是说对块，多段线，尺寸线等还是不行的是吧，运行不了，我也不知道效果哦，不过你这个切换模式非常好，期待您能在这个切换模式下完善一下呗
本帖最后由 caiqs 于 2019-12-18 22:01 编辑
;;试试这个吧，应该可以用了只要是曲线就行
;;圆椭圆多段线样条构造线射线都可以,按A可以锁定中点;;块可以了
(vl-load-com)
;;求两点之中点
(defun getmidpt (p1 p2)
(mapcar '(lambda (x)
(* 0.5 x)
)
(mapcar '+ p1 p2)
)
)
(defun getprep (spt ept p3 / tmppt intpt)
(setq tmppt (polar p3 (+ (angle spt ept) (* 0.5 pi)) 10))
(setq intpt (inters tmppt p3 spt ept nil))
)
;;;用A键切换中垂线和智能捕捉中点垂线
(defun c:ts2 (/ ang ang1 endpt ent entdatentpick
etype intpt len midpt mode p1 p2
pickptpt ret startpt tmppt
)
(while (and
(setq entpick (vl-catch-all-apply 'entsel '("\n選取直線 :")))
(not (VL-CATCH-ALL-ERROR-P entpick))
)
(setq ent (car entpick))
(setq entdat (entget ent)
etype (cdr (assoc 0 entdat))
)
(setq pickpt (cadr entpick)) ;_点取的点
(cond
((member etype
'("CIRCLE" "ELLIPSE" "RAY" "LINE" "XLINE" "SPLINE"
"LWPOLYLINE")
)
(setq intpt (vlax-curve-getClosestPointTo ent pickpt)) ;_最近点
)
(t (setq intpt (osnap pickpt "_nea")))
)
(setq ang1 (angle pickpt intpt))
(setq
;;startpt (cdr (assoc 10 entdat))
startpt (polar intpt (+ ang1 (* 0.5 PI)) 10)
endpt (polar intpt (- ang1 (* 0.5 PI)) 10)
;;endpt (cdr (assoc 11 entdat))
;;midpt (getmidpt startpt endpt)
midpt (osnap intpt "_mid")
;;len (DISTANCE startpt endpt)
len 1000.0
ang (angle startpt endpt)
mode nil
)
(while (and
(setq ret (grread t 12))
(member (car ret) '(2 5))
)
(redraw)
(cond
((= (car ret) 2) (setq mode (not mode)))
(mode
(cond
((member etype '("CIRCLE" "ELLIPSE" "RAY"))
(setq intpt (cdr (assoc 10 entdat)))
)
(t
(if midpt
(setq intpt midpt)
(setq intpt (osnap pt "_mid"))
)
)
)
)
((= (car ret) 5)
(setq pt (cadr ret))
;;; (setq intpt (getprep startpt endpt pt))
(setq intpt (osnap pt "_nea,_int,End,_mid,_cen,_qua,_tan"))
)
)
(if (null intpt)
(progn
(setq tmppt (polar pt ang1 10))
(setq intpt (INTERS pt tmppt startpt endpt nil))
)
)
(setq p1 (polar intpt (+ ang (* 0.5 PI)) (* 0.5 len))
p2 (polar intpt (- ang (* 0.5 pi)) (* 0.5 len))
)
(grdraw p1 p2 3 1)
)
(redraw)
(if (= (car ret) 3)
(entmake (list '(0 . "LINE")
(cons 10 P1)
(cons 11 P2)
)
)
)
)
)
caiqs 发表于 2019-12-18 21:11
;;试试这个吧，应该可以用了只要是曲线就行
;;圆椭圆多段线样条构造线射线都可以,按A可以锁定中点
(vl-lo ...
试了，可是还是不是我想要的结果，谢谢您的再次回复。
你试试加载版主回复的那个函数，我要的基本就是那个效果的，对尺寸线，块内的线，构造线都要起作用，那个函数也是不能指定垂足，如果可以指定垂足就完美了
caiqs 发表于 2019-12-18 19:51
;;;师兄QQ361865648
;;;好人做到底，送佛送到西，好吧，现在块可以使用了，尺寸也可以了，不过要多响应一 ...
修改之后无比完美，请收下我的膝盖，太感谢了！！
好贴标记一下。