[建议]：有这样得lisp么？同时缩放圆和里面得字。

封剑忆江南

呵呵，各位高手，小弟再此求一个lisp程序。


要求：圆内字符，如轴线标号，圆和字体同时缩放。单个或者多个都能处理。省得每次都用缩放命令。


请高手编写一个吧，感觉这东西常要用得。

zxq0220

[php]
(DEFUN C:SCC ()
(SETVAR "CMDECHO" 0)
(COMMAND ".UNDO" "BE")
(SETQ SC (GETDIST "\nEnter Scale 输入放大比例 : "))
(WHILE
  (PROGN
   (PRINC "\nSelect Circle(s) 选择圆 : ")
   (SETQ SS (SSGET '((0 . "CIRCLE"))))
  )
  (SETQ I -1)
  (REPEAT (SSLENGTH SS)
   (SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
         PC (CDR (ASSOC 10 ENT))
         R (CDR (ASSOC 40 ENT))
         P1 (POLAR (POLAR PC PI R) (/ PI -2) R)
         P2 (POLAR (POLAR PC 0 R) (/ PI 2) R))
   (COMMAND "SCALE" "W" P1 P2 "" PC SC)
  )
)
(COMMAND ".UNDO" "E")
(SETVAR "CMDECHO" 1)
(PRINC)
)
[/php]

ynjzlzd

我也正需要这样的东东,但不知道怎样加载,请说明下.

aeo

2. 
   
3. ;;;By Aeo @xdcad.net
   
4. ;;;定义点缩放实体
   
5. ;;;文字为中心点缩放
   
6. (defun c:sc ( / __mm a b e j ss dxf)
   
7. (defun dxf(a b)(cdr(assoc a(entget b))))
   
8. (or   $_scale (setq  $_scale 0.5))
   
9. (initget 6)
   
10. (if (setq __mm (getreal (strcat "\n当前比例(" (rtos $_scale 2 3) "):")))
    
11.      (setq $_scale __mm)
    
12. )
    
13. (setq j -1)
    
14. (if(setq ss (ssget))
    
15.   (progn(command "UNDO" "group")
    
16.          (repeat (sslength ss)
    
17.            (setq e(ssname ss(setq j(1+ j))))
    
18.            (if(wcmatch (dxf 0 e)"TEXT,ATT*")
    
19.               (command "scaletext" e "" "m""s" $_scale)
    
20.               (command "scale" e """none"(trans(dxf 10 e)e 1)$_scale)
    
21.            )
    
22.           )
    
23.           (command "undo" "end")
    
24.        )
    
25.    )
    
26.   (princ)
    
27. )
    

<br /> ;;;By Aeo @xdcad.net<br /> ;;;定义点缩放实体<br /> ;;;文字为中心点缩放<br /> (defun c:sc ( / __mm a b e j ss dxf)<br /> (defun dxf(a b)(cdr(assoc a(entget b))))<br /> (or   $_scale (setq  $_scale 0.5))<br /> (initget 6)<br /> (if (setq __mm (getreal (strcat "\n当前比例(" (rtos $_scale 2 3) "):")))<br />      (setq $_scale __mm)<br /> )<br /> (setq j -1)<br /> (if(setq ss (ssget))<br />   (progn(command "UNDO" "group")<br />          (repeat (sslength ss)<br />            (setq e(ssname ss(setq j(1+ j))))<br />            (if(wcmatch (dxf 0 e)"TEXT,ATT*")<br />               (command "scaletext" e "" "m""s" $_scale)<br />               (command "scale" e """none"(trans(dxf 10 e)e 1)$_scale)<br />            )<br />           )<br />           (command "undo" "end")<br />        )<br />    )<br />   (princ)<br /> )<br />

教父

请教斑竹$_scale 是不是就等于 (getvar .....)

WHGF

纯LISP做的，有参考价值。

coolzhb

我用xd工具箱中的自身缩放命令，更好用！

封剑忆江南

2楼的的朋友，谢谢你的lisp，不过我在使用中，发现不能选定对象。我用的是CAD2005。版主提供的lisp，命令是SC么？和CAD原有命令重了吧？我改了一下你的lisp调用命令，我发现在使用中，虽然基点是默认的，但是圆和字的基点不一样，导致产生字偏移到圆内的一侧。

仅仅是同时缩放字和圆的话，用CAD的SC命令就可以。关键是有多个字和圆要改变比例，该如何处理？如果用复制那还要删除原来的。

我想了一下，如果用一种刷子，同时刷字和圆的比例会好些。或者是，同时选中多个字和圆，同时缩放比例，但是注意，要求字和圆的基点位置不变。引申出这个问题，那还括了多段线组成的字符，比如三角形里面一个字符，六边形里面一个字符。要求多个三角形和字同时缩放但是图形和字的基点位置不遍。


请高手赐教。

雨箭风刀

正打算搞一个这样的程序

xyp1964

所谓相对位置不太好界定：

2. [FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20060422
   
3. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
   
4. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
5. ★1·在acad.lsp中增加(load"xyp_lib.vlx")
   
6. ■2·在每个程序内增加(load"xyp_lib.vlx")
   
7. ■3·在command下，输入(load"xyp_lib.vlx")
   
8. ■4·在菜单.mnl中增加(load"xyp_lib.vlx")
   
9. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
   
10. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
11. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
12. [url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]
    
13. [url]http://free.ys168.com/?xyp1964[/url]
    
14. |;
    
15. 
    
16. ;;; 同时缩放圆和里面的字
    
17. (defun c:test ()
    
18.   (CMDLA0)
    
19.   (if(null real)(setq real 1.0))
    
20.   (setq        REAL (UREAL 7 "" "\n缩放比例" REAL)
    
21.         ss   (ssget '((0 . "TEXT,CIRCLE")))
    
22.         i    -1
    
23.   )
    
24.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
25.     (setq pt0 (xyp-get-MinMaxPoint s1 5))
    
26.     (command "scale" s1 "" pt0 real)
    
27.   )
    
28.   (CMDLA1)
    
29. )[/FONT]

[FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20060422<br /> ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib.vlx")<br /> ■2·在每个程序内增加(load"xyp_lib.vlx")<br /> ■3·在command下，输入(load"xyp_lib.vlx")<br /> ■4·在菜单.mnl中增加(load"xyp_lib.vlx")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> [url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]<br /> [url]http://free.ys168.com/?xyp1964[/url]<br /> |;<br /> <br /> ;;; 同时缩放圆和里面的字<br /> (defun c:test ()<br />   (CMDLA0)<br />   (if(null real)(setq real 1.0))<br />   (setq        REAL (UREAL 7 "" "\n缩放比例" REAL)<br />         ss   (ssget '((0 . "TEXT,CIRCLE")))<br />         i    -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq pt0 (xyp-get-MinMaxPoint s1 5))<br />     (command "scale" s1 "" pt0 real)<br />   )<br />   (CMDLA1)<br /> )[/FONT]

橄榄滋味

将圆和字做成属性块

aeo

最初由 封剑忆江南 发布
[B]2楼的的朋友，谢谢你的lisp，不过我在使用中，发现不能选定对象。我用的是CAD2005。版主提供的lisp，命令是SC么？和CAD原有命令重了吧？我改了一下你的lisp调用命令，我发现在使用中，虽然基点是默认的，但是圆和字?.. [/B]

(if(wcmatch (dxf 0 e)"TEXT,ATT*")
              (command "scaletext" e "" "m""s" $_scale)
              (command "scale" e """none"(trans(dxf 10 e)e 1)$_scale)
           )


直接改为

(command "scale" e """none"(trans(dxf 10 e)e 1)$_scale)

就可以

如果文字在圆中间
按我上面的方法,应该还在中间的.不知道你是怎么操作的,
或者贴个图?!

雨箭风刀

10楼是思路应该是比较好的
只是用box的两个角点，可能会把别的东西弄近选集
建议在circle里面提取ssget的wp边界（如36等分点）。。。

zh_6531394

10楼的朋友,用了以后,什么反应都没有?

xyp1964

最初由 zh_6531394 发布
[B]10楼的朋友,用了以后,什么反应都没有? [/B]

2. [FONT=courier new]
   
3. ;;; 同时缩放圆及里面的字
   
4. ;;; yzsf(圆字缩放)
   
5. (defun c:yzsf (/ ss i s1 pt ptn ss0)
   
6.   (CMDLA0)
   
7.   (setvar "osmode" 0)
   
8.   (if (null REAL)
   
9.     (setq REAL 1.0)
   
10.   )
    
11.   (setq REAL (UREAL 7 "" "\n缩放比例" REAL))
    
12.   (if (/= REAL 1.0)
    
13.     (progn
    
14.       (setq ss (ssget '((0 . "CIRCLE")))
    
15.             i  -1
    
16.       )
    
17.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
18.         (setq pt  (xyp-get-dxf 10 s1)
    
19.               ptn (xyp-get-CurveDivPtlst
    
20.                     s1
    
21.                     (/ (xyp-get-CurveLength s1) 36.0)
    
22.                   )
    
23.               ss0 (ssget "WP" ptn '((0 . "TEXT")))
    
24.         )
    
25.         (if ss0
    
26.           (command "scale" s1 ss0 "" pt REAL)
    
27.         )
    
28.       )
    
29.     )
    
30.   )
    
31.   (CMDLA1)
    
32. )
    
33. (pxyp "yzsf  (圆字缩放)")
    
34. (princ)
    
35. [/FONT]

[FONT=courier new]<br /> ;;; 同时缩放圆及里面的字<br /> ;;; yzsf(圆字缩放)<br /> (defun c:yzsf (/ ss i s1 pt ptn ss0)<br />   (CMDLA0)<br />   (setvar "osmode" 0)<br />   (if (null REAL)<br />     (setq REAL 1.0)<br />   )<br />   (setq REAL (UREAL 7 "" "\n缩放比例" REAL))<br />   (if (/= REAL 1.0)<br />     (progn<br />       (setq ss (ssget '((0 . "CIRCLE")))<br />             i  -1<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq pt  (xyp-get-dxf 10 s1)<br />               ptn (xyp-get-CurveDivPtlst<br />                     s1<br />                     (/ (xyp-get-CurveLength s1) 36.0)<br />                   )<br />               ss0 (ssget "WP" ptn '((0 . "TEXT")))<br />         )<br />         (if ss0<br />           (command "scale" s1 ss0 "" pt REAL)<br />         )<br />       )<br />     )<br />   )<br />   (CMDLA1)<br /> )<br /> (pxyp "yzsf  (圆字缩放)")<br /> (princ)<br /> [/FONT]