之前用过楼主的代码，特此感谢
好像还是不能捕捉圆心和几何中心
本帖最后由 gzcsun 于 2024-8-10 00:08 编辑
228378553 发表于 2024-7-24 11:03
好像还是不能捕捉圆心和几何中心
自己加上。圆心 ,几何中心,图元中心 都可以有。
我是不用几何中心的,图元中心用得多。
cad原捕捉限显示6个；而且面域不能显示几何中心。
所以圆心限显示4个，
图元中心限显示2个，面域，块，多段线的都能显示，其它的要按一下按键才显示。
gzcsun 发表于 2024-7-24 11:32
自己加上。圆心 ,几何中心,图元中心 都可以有。
我是不用几何中心的,图元中心用得多。
不知道怎么加:(
gzcsun 发表于 2024-7-24 11:32
自己加上。圆心 ,几何中心,图元中心 都可以有。
我是不用几何中心的,图元中心用得多。
我不会加想求代码，你发个帖子 我给明经币:lol
正是我想要 的..感谢楼主..............
很好很强大的功能，谢谢分享
本帖最后由 逗亦斗霸 于 2025-5-25 15:47 编辑
llsheng_73 发表于 2020-8-11 10:33
建议 (osnap pt "_END,_CEN,_NOD,_QUA,_INS,_TAN,_EXT")根据当前的捕捉设置来
我把G版那个按我的习惯修改 ...
请问一下，这段代码还有其他的范例吗？我尝试使用这段加到我动态引线捕捉里去只显示方框，靠近中点时不能正常显示三角形，在另一个拉线标注里倒是可以在靠近中点时正常显示三角形，谢谢~
(defun dectobin(n m / c f);;十进制转二进制
(setq f(if(< n 0)1 0)n(abs n))
(while(>(setq c(cons(rem n 2)c)n(/ n 2))0))
(while(<(length c)(1- m))(setq c(cons 0 c)))
(cons f c))
(DEFUN DrawVecs(pt Vecs Size Color / xdir);;;G版函数绘制矢量
(setq xdir(getvar'ucsxdir)
Vecs(mapcar'(lambda(x)(mapcar'(lambda(a)(mapcar'+ pt(mapcar'*(setq a(trans a 0 xdir)a(list(caddr a)(car a)))(List size size))))x))Vecs))
(GRVECS(APPLY 'APPEND(MAPCAR 'CONS(MAPCAR(FUNCTION (LAMBDA (x)Color))Vecs)Vecs))))
(defun myosnap(pt / xpt mode osmod osmode Draftobj Size);;;修改G版函数带捕捉grread
(redraw)
(if(setq Draftobj(VLA-GET-DRAFTING(VLA-GET-PREFERENCES(VLAX-GET-ACAD-OBJECT)))
osmod'("_END," "_MID," "_CEN," "_NOD," "_QUA," "_INT," "_INS," "_PER," "_TAN," "_NEA," "_NON," "_APP," "_EXT," "_PAR")
osmode(reverse(DECTOBIN (getvar'osmode) 1))
size(*(/(getvar "viewsize")(cadr(getvar "screensize")))(VLA-GET-AUTOSNAPMARKERSIZE Draftobj))
xpt(osnap pt(apply'strcat(mapcar'(lambda(x y)(if(zerop x)""y))osmode osmod)))
mode(CDR(ASSOC
(if xpt(vl-some'(lambda(x)(if(equal xpt(cdr x)1e-8)(car x)))
(vl-remove'nil(mapcar'(lambda(x y / xpt)(if(zerop x)nil(if(setq xpt(osnap pt y))(cons y xpt))))osmode osmod)))"_NON,")
'(("_END,"((-1 1)(-1 -1))((-1 -1)(1 -1))((1 -1) (1 1))((1 1) (-1 1)))
("_MID,"((0 1.414) (-1.225 -0.707)) ((-1.225 -0.707)(1.225 -0.707))((1.225 -0.707) (0 1.414)))
("_CEN,"((0 1) (-0.707 0.707))((-0.707 0.707)(-1 0))((-1 0) (-0.707 -0.707))((-0.707 -0.707)(0 -1))
((0 -1)(0.707 -0.707))((0.707 -0.707)(1 0)) ((1 0) (0.707 0.707))((0.707 0.707) (0 1)))
("_NOD,"((0 1) (-0.707 0.707))((-0.707 0.707)(-1 0))((-1 0)(-0.707 -0.707))((-0.707 -0.707)(0 -1))((0 -1)(0.707 -0.707))
((0.707 -0.707)(1 0))((1 0)(0.707 0.707))((0.707 0.707)(0 1))((-1 1)(1 -1))((-1 -1)(1 1)))
("_QUA,"((0 1.414)(-1.414 0))((-1.414 0)(0 -1.414))((0 -1.414)(1.414 0))((1.414 0)(0 1.414)))
("_INT,"((-1 1)(1 -1))((-1 -1)(1 1))((1 0.859)(-0.859 -1))((-1 0.859)(0.859 -1))((0.859 1)(-1 -0.859))((-0.859 1)(1 -0.859)))
("_INS,"((-1 1)(-1 -0.1))((-1 -0.1)(0 -0.1))((0 -0.1)(0 -1.0))((0 -1.0)(1 -1))
((1 -1)(1 0.1))((1 0.1)(0 0.1))((0 0.1) (0 1.0))((0 1.0)(-1 1)))
("_PER,"((-1 1)(-1 -1))((-1 -1)(1 -1))((0 -1)(0 0))((0 0)(-1 0)))
("_TAN,"((0 1)(-0.707 0.707))((-0.707 0.707)(-1 0))((-1 0)(-0.707 -0.707))((-0.707 -0.707)(0 -1))
((0 -1)(0.707 -0.707))((0.707 -0.707)(1 0))((1 0)(0.707 0.707))((0.707 0.707)(0 1))((1 1)(-1 1)))
("_NEA,"((-1 1)(1 -1))((1 -1)(-1 -1))((-1 -1)(1 1))((1 1)(-1 1)))
("_NON,")
("_APP,"((-1 1)(-1 -1))((-1 -1)(1 -1))((1 -1)(1 1))((1 1)(-1 1))((-1 1)(1 -1))((-1 -1)(1 1)))
("_EXT,"((0.1 0)(0.13 0))((0.2 0)(0.23 0))((0.3 0)(0.33 0)))
("_PAR"((0 1)(-1 -1))((1 1)(0 -1)))))))
(DrawVecs(setq xpt(if xpt xpt pt))mode size(VLA-GET-AUTOSNAPMARKERCOLOR Draftobj)))
(if xpt xpt pt))
(defun c:tvvt(/ e xpt) ;;选择一个圆进行移动
(while(setq e(ssget":E:S"'((0 . "circle"))))
(setq e(entget(ssname e 0)))
(while(/=(car(setq xpt(grread t 15 0)))3)(redraw)
(if(=(car xpt)5)(entmod(append e(list(cons 10(myosnap(cadr xpt)))))))
))
)
(defun bz (/ *error* name1 name2 name3)
(defun *error* (msg) ;将描述错误的字符串存入变量msg
(entdel name1)
(entdel name2)
(if name3
(entdel name3)
)
(princ "错误: ")
(princ msg)
) ;打印错误信息
(setq ty (getvar "TEXTSTYLE"))
(setq ht (atof txtht))
(if (= ht 0)
(progn
(prompt "字高为0!")
(terpri)
);progn
);if
(setq Scale (/ ht 2.5));
(setq kd1 (caadr (textbox (list '(0 . "text")
(cons 1 txt1)
(cons 40 ht)
(cons 41 1)
(cons 7 ty)
(cons 62 7)
)
)
)
)
;字高ht，字宽高比1，可以自己设置，字体为当前字体
(setq kd2 (caadr (textbox (list '(0 . "text")
(cons 1 txt2)
(cons 40 ht)
(cons 41 1)
(cons 7 ty)
(cons 62 7)
)
)
)
)
;字高ht，字宽高比1，可以自己设置，字体为当前字体
(setq kd (max kd1 kd2)
kd (+ kd (* 0.50 Scale))
)
(setq p (getpoint "\n输入基点:"))
(setq pd t)
(while pd
(setq gr (grread t 4 1)
mode (car gr)
pt (myosnap (cadr gr))
)
(if (= kd3 0)
(setq kd kd1)
)
(if (and (listp pt) (>= (car pt) (car p)))
(progn
(setq p0 (polar pt 0 kd))
(setq p1 (polar pt 0 (/ (- kd kd1) 2))
p1 (polar p1 (angtof "90") (* 0.70 Scale))
)
(setq p2 (polar pt 0 (/ (- kd kd2) 2))
p2 (polar p2 (angtof "270") (* 3.20 Scale))
)
)
)
(if (and (listp pt) (< (car pt) (car p)))
(progn
(setq p0 (polar pt pi kd))
(setq p1 (polar p0 0 (/ (- kd kd1) 2))
p1 (polar p1 (angtof "90") (* 0.70 Scale))
)
(setq p2 (polar p0 0 (/ (- kd kd2) 2))
p2 (polar p2 (angtof "270") (* 3.20 Scale))
)
)
)
(if (= mode 5)
(progn
(if name1
(entdel name1)
)
(entmake (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 3)
(cons 10 p)
(cons 10 pt)
(cons 10 p0)
(cons 62 3)
)
)
(setq name1 (entlast))
(if name2
(entdel name2)
)
(entmake (list '(0 . "text")
(cons 1 txt1)
(cons 40 ht)
(cons 41 1)
(cons 10 p1)
(cons 7 ty)(cons 62 7)
)
)
;字高ht，字宽高比1，可以自己设置，字体为当前字体
(setq name2 (entlast))
(if name3
(entdel name3)
)
(if (= kd3 1)
(entmake (list '(0 . "text")
(cons 1 txt2)
(cons 40 ht)
(cons 41 1)
(cons 10 p2)
(cons 7 ty)(cons 62 7)
)
)
)
;字高ht，字宽高比1，可以自己设置，字体为当前字体
(if (= kd3 1)
(setq name3 (entlast))
)
)
(redraw)
)
(if (= mode 3)
(setq pd nil)
)
(if (or (= mode 2) (= mode 25))
(progn (setq pd nil)
(entdel name1)
(entdel name2)
(if name3
(entdel name3)
)
)
)
)
(princ)
)
(defun getdata ()
(setq txt1 (get_tile "a1"))
(setq txt2 (get_tile "a2"))
(if(= (get_tile "a3") "0")
(setq kd3 0)
(setq kd3 1)
)
(setq txtht(get_tile "a4"))
)
(defun c:bz ()
;(步骤1)建立临时对话框
(setq tempname (vl-filename-mktemp "temp.dcl")
filen (open tempname "w")
)
(foreach stream
'("bz:dialog{"
"\nlabel = "
动态引线标注
";"
"\n:edit_box {key = \"a1\"; label = \"线上文字:\"; width = 40 ;}"
"\n:toggle {key = \"a3\"; label = \"增加线下文字\"; value = "
0
";}"
"\n:edit_box {key = \"a2\"; label = \"线下文字:\"; width = 40; is_enabled = false;}"
"\n:edit_box {key = \"a4\"; label = \"文字高度:\"; width = 20; }"
"\nok_cancel;}"
)
(princ stream filen)
)
(close filen)
(setq dclname tempname)
;(步骤2)加载并显示对话框
(setq dcl_re (load_dialog dclname))
(if(not (new_dialog "bz" dcl_re))
(exit)
)
;(步骤3)定义对话框控件（运用set_tile、action_tile、mode_tile、get_tile等函数）
(iftxt1
(set_tile "a1" txt1)
(set_tile "a1" "动态标注")
)
(iftxt2
(set_tile "a2" txt2)
(set_tile "a2" "动态标注")
)
(ifkd3
(set_tile "a3" (rtos kd3))
) ;注意set_tile函数中赋值均为字符串（带双引号），就连关键词也要加上双引号。
(if(= kd3 0)
(mode_tile "a2" 1)
)
(if(= kd3 1)
(mode_tile "a2" 0)
)
(iftxtht
(set_tile "a4" txtht)
(set_tile "a4" "150")
)
(action_tile
"a3"
"(if (= (get_tile \"a3\") \"0\") (mode_tile \"a2\" 1) (mode_tile \"a2\" 0))"
) ;点击时才起作用
(action_tile "accept" "(getdata)(done_dialog 1)")
(action_tile "cancel" "(done_dialog)")
;(步骤4)激活并卸载对话框，并进行对话框隐藏后的操作。
(setq std (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
(if(= std 1)
(bz)
)
(princ)
)
逗亦斗霸 发表于 2025-5-24 21:56
请问一下，这段代码还有其他的范例吗？我尝试使用这段加到我动态引线捕捉里去只显示方框，靠近中点时不能 ...
("_MID,"((0 1.414) (-1.225 -0.707)) ((-1.225 -0.707)(1.225 -0.707))((1.225 -0.707) (0 1.414)))
应该是要修改这个后边的坐标表，空了收拾它一下
llsheng_73 发表于 2025-5-26 11:50
("_MID,"((0 1.414) (-1.225 -0.707)) ((-1.225 -0.707)(1.225 -0.707))((1.225 -0.707) (0 1.414)))
应 ...
好的，那就静候大佬的更新，谢谢啦~