大师们，如何让这个圈里，自动加一个汉字，还有圈的大小怎么调整
(defun entmakecircle(pt rad)(entmakex (list '(0 . "circle") (cons 10 pt) (cons 40 rad))))(defun entmakeline(p1 p2)(entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2))))
(defun entmaketext(pt str h ang)(entmakex (list '(0 . "TEXT") (cons 10 pt)(cons 11 pt)(cons 73 0)(cons 72 1) (cons 1 str) (cons 40 h)(cons 50 ang))))
(vl-load-com)
(defun c:tg12(/ p1 p2 p3 p4 pt dd ang)
(if(setq p1(getpoint "\n指定起点: "))
(progn
(vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
(entmakecircle p1 3)
(while(setq p2(getpoint p1 "\n指定下一点(空格退出): "))
(setq p3(polar p1 (angle p1 p2) 3)
p4(polar p2 (angle p2 p1) 3)
)
;;文字中点
(setq pt(mapcar '(lambda(x y)(*(+ x y) 0.5)) p1 p2))
(setq dd(distance p1 p2))
(entmakeline p3 p4)
(entmakecircle p2 3)
(setq ang (angle p1 p2))
;;文字正向
(if(and (> ang (* pi 0.5)) (< ang(* pi 1.5)))(setq ang (angle p2 p1)))
;;文字偏移
(setq pt (polar pt (+ ang (* 0.5 pi)) 2))
;;生成文字
(entmaketext pt (rtos dd 2 2) 6 ang)
(setq p1 p2)
)
(vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
)
)
(princ)
)
本帖最后由 qazxswk 于 2024-10-16 21:09 编辑
试着改了一下，你看行不行。圆大小跟你当前的标注文字大小关联了。
(defun entmakecircle(pt rad)(entmakex (list '(0 . "circle") (cons 10 pt) (cons 40 rad))))
(defun entmakeline(p1 p2)(entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2))))
(defun entmaketext(pt str h ang)(entmakex (list '(0 . "TEXT") (cons 10 pt)(cons 11 pt)(cons 73 0)(cons 72 1) (cons 1 str) (cons 40 h)(cons 50 ang))))
(defun entmaketext1(pt str h)(entmakex (list '(0 . "TEXT") (cons 10 pt)(cons 11 pt)(cons 73 2)(cons 72 1) (cons 1 str) (cons 40 h))))
(vl-load-com)
(defun c:11(/ p1 p2 p3 p4 pt dd ang txt h)
(setq h (getvar "dimtxt"))
(if(setq p1(getpoint "\n指定起点: "))
(progn
(entmaketext1 p1 "雨" h)
(vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
(entmakecircle p1 h)
(while(setq p2 (getpoint p1 "\n指定下一点(空格退出): "))
(setq p3(polar p1 (angle p1 p2) h) p4(polar p2 (angle p2 p1) h))
;;文字中点
(setq pt(mapcar '(lambda(x y)(*(+ x y) 0.5)) p1 p2))
(setq dd(distance p1 p2))
(entmakeline p3 p4)
(entmakecircle p2 h)
(setq ang (angle p1 p2))
;;文字正向
(if(and (> ang (* pi 0.5)) (< ang(* pi 1.5)))(setq ang (angle p2 p1)))
;;文字偏移
(setq pt (polar pt (+ ang (* 0.5 pi)) 2))
;;生成文字
(entmaketext pt (rtos dd 2 2) h ang)
(setq p1 p2)
(entmaketext1 p1 "雨" h)
)
(vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
)
)
(princ))
如果圆圈里放固定的一个汉字，那还可以省一步。 qazxswk 发表于 2024-10-16 20:54
如果圆圈里放固定的一个汉字，那还可以省一步。
太强了大哥，就固定一下雨字就行，
删除哪段 上面的代码，我帮你修改好，加上雨字了。你重新复制一下就可以了。 qazxswk 发表于 2024-10-16 21:07
上面的代码，我帮你修改好，加上雨字了。你重新复制一下就可以了。
神奇呀，大哥在帮我最后一个忙，实在在不好意思了，圆形能不能改成这4种方块，分成4个文件也行，1个文件也行 (defun c:tt ()
(defun Ecircle (p r)
(entmakex (list '(0 . "circle") (cons 10 p) (cons 40 r)))
)
(defun Eline (a b)
(entmakex (list '(0 . "line") (cons 10 a) (cons 11 b)))
)
(defun Etext (p tx h r)
(entmakex (list '(0 . "text")
(cons 10 p)
(cons 11 p)
(cons 73 0)
(cons 72 1)
(cons 1 tx)
(cons 40 h)
(cons 50 r)
)
)
)
(or rr (setq rr 3))
(or tx (setq tx "雨"))
(setq rr (Udist 7 "" "圆圈半径<输入或鼠标直接量取>" rr nil))
(setq tx (Ustr 1 "字符串" tx nil))
(if (setq p1 (getpoint "\n起点<空格退出>: "))
(progn
(setq s1 (Ecircle p1 rr)
s2 (Etext (polar p1 (* pi 1.5) (* rr 0.5)) tx rr 0)
)
(while (setq p2 (getpoint p1 "\n下一点<空格退出>: "))
(setq p3(polar p1 (angle p1 p2) rr)
p4(polar p2 (angle p2 p1) rr)
pt(mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)
s1(Eline p3 p4)
s2(Ecircle p2 rr)
s3(Etext px (polar p2 (* pi 1.5) (* rr 0.5)) rr 0)
ang (angle p1 p2)
ang (if (and (> ang (* pi 0.5)) (< ang (* pi 1.5)))
(angle p2 p1)
ang
)
pt(polar pt (+ ang (* 0.5 pi)) 2)
s4(Etext pt (rtos (distance p1 p2) 2 2) 6 ang)
p1p2
)
)
)
)
(princ)
) xyp1964 发表于 2024-10-16 23:22
院长 画改成长方形怎么改，就跟这个画差不多大就行 xyp1964 发表于 2024-10-16 23:22
就是一个矩形，里面有4个格有时候3个格子，最好是我自己能在LISP文件里能修改几个格子，还能控制矩形长宽
为啥不用动态块
页:
[1]
2