大师们，如何让这个圈里，自动加一个汉字，还有圈的大小怎么调整

gaolei_gaolei

(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

试着改了一下，你看行不行。圆大小跟你当前的标注文字大小关联了。

2. (defun entmakecircle(pt rad)(entmakex (list '(0 . "circle") (cons 10 pt) (cons 40 rad))))
   
3. (defun entmakeline(p1 p2)(entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2))))
   
4. (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))))
   
5. (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))))
   
6. (vl-load-com)
   
7. (defun c:11(/ p1 p2 p3 p4 pt dd ang txt h)
   
8. (setq h (getvar "dimtxt"))
   
9.   (if(setq p1(getpoint "\n指定起点: "))
   
10.     (progn
    
11.          (entmaketext1 p1 "雨" h)
    
12.             (vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
    
13.       (entmakecircle p1 h)
    
14.       (while(setq p2 (getpoint p1 "\n指定下一点(空格退出): "))
    
15.       
    
16.            (setq p3(polar p1 (angle p1 p2) h)         p4(polar p2 (angle p2 p1) h)  )
    
17.         ;;文字中点
    
18.         (setq pt(mapcar '(lambda(x y)(*(+ x y) 0.5)) p1 p2))        
    
19.         (setq dd(distance p1 p2))
    
20.         (entmakeline p3 p4)
    
21.         (entmakecircle p2 h)
    
22.         (setq ang (angle p1 p2))
    
23.         ;;文字正向
    
24.         (if(and (> ang (* pi 0.5)) (< ang  (* pi 1.5)))(setq ang (angle p2 p1)))
    
25.         ;;文字偏移
    
26.         (setq pt (polar pt (+ ang (* 0.5 pi)) 2))
    
27.         ;;生成文字
    
28.         (entmaketext pt (rtos dd 2 2) h ang)
    
29.         (setq p1 p2)
    
30.                 (entmaketext1 p1 "雨" h)
    
31.         )
    
32.       (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
    
33.       )
    
34.     )
    
35.   (princ)  )

(defun entmakecircle(pt rad)(entmakex (list '(0 . "circle") (cons 10 pt) (cons 40 rad))))<br /> (defun entmakeline(p1 p2)(entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2))))<br /> (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))))<br /> (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))))<br /> (vl-load-com)<br /> (defun c:11(/ p1 p2 p3 p4 pt dd ang txt h) <br /> (setq h (getvar "dimtxt")) <br />   (if(setq p1(getpoint "\n指定起点: "))<br />     (progn<br />          (entmaketext1 p1 "雨" h)<br />             (vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))<br />       (entmakecircle p1 h)<br />       (while(setq p2 (getpoint p1 "\n指定下一点(空格退出): "))<br />        <br />            (setq p3(polar p1 (angle p1 p2) h)         p4(polar p2 (angle p2 p1) h)  )<br />         ;;文字中点<br />         (setq pt(mapcar '(lambda(x y)(*(+ x y) 0.5)) p1 p2))        <br />         (setq dd(distance p1 p2))<br />         (entmakeline p3 p4)<br />         (entmakecircle p2 h)<br />         (setq ang (angle p1 p2))<br />         ;;文字正向<br />         (if(and (> ang (* pi 0.5)) (< ang  (* pi 1.5)))(setq ang (angle p2 p1)))<br />         ;;文字偏移<br />         (setq pt (polar pt (+ ang (* 0.5 pi)) 2))<br />         ;;生成文字<br />         (entmaketext pt (rtos dd 2 2) h ang)<br />         (setq p1 p2)<br />                 (entmaketext1 p1 "雨" h)<br />         )<br />       (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))<br />       )<br />     )<br />   (princ)  )

qazxswk

如果圆圈里放固定的一个汉字，那还可以省一步。

gaolei_gaolei

qazxswk 发表于 2024-10-16 20:54
如果圆圈里放固定的一个汉字，那还可以省一步。

太强了大哥，就固定一下雨字就行，
删除哪段

qazxswk

上面的代码，我帮你修改好，加上雨字了。你重新复制一下就可以了。

gaolei_gaolei

qazxswk 发表于 2024-10-16 21:07
上面的代码，我帮你修改好，加上雨字了。你重新复制一下就可以了。

神奇呀，大哥在帮我最后一个忙，实在在不好意思了，圆形能不能改成这4种方块，分成4个文件也行，1个文件也行

xyp1964

1. (defun c:tt ()
   
2.   (defun Ecircle (p r)
   
3.     (entmakex (list '(0 . "circle") (cons 10 p) (cons 40 r)))
   
4.   )
   
5.   (defun Eline (a b)
   
6.     (entmakex (list '(0 . "line") (cons 10 a) (cons 11 b)))
   
7.   )
   
8.   (defun Etext (p tx h r)
   
9.     (entmakex (list '(0 . "text")
   
10.                     (cons 10 p)
    
11.                     (cons 11 p)
    
12.                     (cons 73 0)
    
13.                     (cons 72 1)
    
14.                     (cons 1 tx)
    
15.                     (cons 40 h)
    
16.                     (cons 50 r)
    
17.               )
    
18.     )
    
19.   )
    
20.   (or rr (setq rr 3))
    
21.   (or tx (setq tx "雨"))
    
22.   (setq rr (Udist 7 "" "圆圈半径<输入或鼠标直接量取>" rr nil))
    
23.   (setq tx (Ustr 1 "字符串" tx nil))
    
24.   (if (setq p1 (getpoint "\n起点<空格退出>: "))
    
25.     (progn
    
26.       (setq s1 (Ecircle p1 rr)
    
27.             s2 (Etext (polar p1 (* pi 1.5) (* rr 0.5)) tx rr 0)
    
28.       )
    
29.       (while (setq p2 (getpoint p1 "\n下一点<空格退出>: "))
    
30.         (setq p3  (polar p1 (angle p1 p2) rr)
    
31.               p4  (polar p2 (angle p2 p1) rr)
    
32.               pt  (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)
    
33.               s1  (Eline p3 p4)
    
34.               s2  (Ecircle p2 rr)
    
35.               s3  (Etext px (polar p2 (* pi 1.5) (* rr 0.5)) rr 0)
    
36.               ang (angle p1 p2)
    
37.               ang (if (and (> ang (* pi 0.5)) (< ang (* pi 1.5)))
    
38.                     (angle p2 p1)
    
39.                     ang
    
40.                   )
    
41.               pt  (polar pt (+ ang (* 0.5 pi)) 2)
    
42.               s4  (Etext pt (rtos (distance p1 p2) 2 2) 6 ang)
    
43.               p1  p2
    
44.         )
    
45.       )
    
46.     )
    
47.   )
    
48.   (princ)
    
49. )

(defun c:tt ()<br />   (defun Ecircle (p r)<br />     (entmakex (list '(0 . "circle") (cons 10 p) (cons 40 r)))<br />   )<br />   (defun Eline (a b)<br />     (entmakex (list '(0 . "line") (cons 10 a) (cons 11 b)))<br />   )<br />   (defun Etext (p tx h r)<br />     (entmakex (list '(0 . "text")<br />                     (cons 10 p)<br />                     (cons 11 p)<br />                     (cons 73 0)<br />                     (cons 72 1)<br />                     (cons 1 tx)<br />                     (cons 40 h)<br />                     (cons 50 r)<br />               )<br />     )<br />   )<br />   (or rr (setq rr 3))<br />   (or tx (setq tx "雨"))<br />   (setq rr (Udist 7 "" "圆圈半径<输入或鼠标直接量取>" rr nil))<br />   (setq tx (Ustr 1 "字符串" tx nil))<br />   (if (setq p1 (getpoint "\n起点<空格退出>: "))<br />     (progn<br />       (setq s1 (Ecircle p1 rr)<br />             s2 (Etext (polar p1 (* pi 1.5) (* rr 0.5)) tx rr 0)<br />       )<br />       (while (setq p2 (getpoint p1 "\n下一点<空格退出>: "))<br />         (setq p3  (polar p1 (angle p1 p2) rr)<br />               p4  (polar p2 (angle p2 p1) rr)<br />               pt  (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)<br />               s1  (Eline p3 p4)<br />               s2  (Ecircle p2 rr)<br />               s3  (Etext px (polar p2 (* pi 1.5) (* rr 0.5)) rr 0)<br />               ang (angle p1 p2)<br />               ang (if (and (> ang (* pi 0.5)) (< ang (* pi 1.5)))<br />                     (angle p2 p1)<br />                     ang<br />                   )<br />               pt  (polar pt (+ ang (* 0.5 pi)) 2)<br />               s4  (Etext pt (rtos (distance p1 p2) 2 2) 6 ang)<br />               p1  p2<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

gaolei_gaolei

xyp1964 发表于 2024-10-16 23:22

院长 画改成长方形怎么改，就跟这个画差不多大就行

gaolei_gaolei

xyp1964 发表于 2024-10-16 23:22

就是一个矩形，里面有4个格  有时候3个格子，最好是我自己能在LISP文件里能修改几个格子，还能控制矩形长宽

kozmosovia

为啥不用动态块