[分享]：给大家写了“自由缩放”命令...

XDSoft · 发表于 2002-9-23 03:44:54

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[FONT=courier new]
;|
命令：XDTB_XScale
功能：自由缩放,用于2002版本
|;
(defun c:XDTB_XScale(/ ss box pj scl ss1 mMat)
($XDLSP_CheckA2K+)
(prompt "\n请选取要缩放的实体<退出>:")
(if (setq ss (ssget))
(progn
(xdrx_begin)
(setq box (xdrx_entity_box ss))
(xdrx_setmark)
(apply 'command (cons "._pline" box))
(command "c")
(command "._line" (car box)(nth 2 box) "")
(command "._line" (cadr box)(last box) "")
(setq ss1 (xdrx_getss))
(command "._chprop" ss1 "" "c" 9 "")
(xdrx_sysvar_push "osmode")
(setvar "osmode" 565)
(if (setq pj (getpoint "\n请输入缩放基点<退出>:"))
(progn
(setq scl (- (caadr box) (caar box)))
($xdlsp_pickset_visible ss nil)
(xdrx_drag_initget 1)
(xdrx_drag_setmode "SCALE" (/ scl 2.0))
(if (not (setq mMat (xdrx_PickSet_dragGen "\n拾取点<输入比例>:" ss pj 2)))
(progn
(if (not $XDTB_XSCALE_VAL)
(setq $XDTB_XSCALE_VAL 1)
)
(initget 6)
(setq $XDTB_XSCALE_VAL (getreal (strcat "\n缩放比例<" (rtos $XDTB_XSCALE_VAL 2 1) ">:")))
(setq mMat (xdrx_matrix_SetScale (xdrx_matrix_identity) $XDTB_XSCALE_VAL (trans pj 1 0)))
)
)
($XDLSP_PickSet_TransForm ss mMat)
($xdlsp_pickset_visible ss t)
)
)
(command "._erase" ss1 "")
(xdrx_sysvar_pop)
(xdrx_end)
)
)
(princ)
)[/FONT]

[FONT=courier new] 
;| 
  命令：XDTB_XScale 
  功能：自由缩放,用于2002版本 
|; 
(defun c:XDTB_XScale(/ ss box pj scl ss1 mMat) 
   ($XDLSP_CheckA2K+) 
   (prompt "\n请选取要缩放的实体<退出>:") 
   (if (setq ss (ssget)) 
     (progn 
        (xdrx_begin) 
        (setq box (xdrx_entity_box ss)) 
        (xdrx_setmark) 
        (apply 'command (cons "._pline" box)) 
        (command "c") 
        (command "._line" (car box)(nth 2 box) "") 
        (command "._line" (cadr box)(last box) "") 
        (setq ss1 (xdrx_getss)) 
        (command "._chprop" ss1 "" "c" 9 "") 
        (xdrx_sysvar_push "osmode") 
        (setvar "osmode" 565) 
        (if (setq pj (getpoint "\n请输入缩放基点<退出>:")) 
          (progn 
             (setq scl (- (caadr box) (caar box))) 
             ($xdlsp_pickset_visible ss nil) 
             (xdrx_drag_initget 1) 
             (xdrx_drag_setmode "SCALE" (/ scl 2.0)) 
             (if (not (setq mMat (xdrx_PickSet_dragGen "\n拾取点<输入比例>:" ss pj 2))) 
                (progn 
                   (if (not $XDTB_XSCALE_VAL) 
                     (setq $XDTB_XSCALE_VAL 1) 
                   ) 
                   (initget 6) 
                   (setq $XDTB_XSCALE_VAL (getreal (strcat "\n缩放比例<" (rtos $XDTB_XSCALE_VAL 2 1) ">:"))) 
                   (setq mMat (xdrx_matrix_SetScale (xdrx_matrix_identity) $XDTB_XSCALE_VAL (trans pj 1 0))) 
                ) 
             ) 
             ($XDLSP_PickSet_TransForm ss mMat) 
             ($xdlsp_pickset_visible ss t) 
          ) 
        ) 
        (command "._erase" ss1 "") 
        (xdrx_sysvar_pop) 
        (xdrx_end) 
     ) 
   ) 
   (princ) 
)[/FONT]

下载下面附件，拷贝到工具箱LISP目录，用XDTB_XScale 执行

azcon · 发表于 2002-9-23 09:25:47

谢谢XDSoft,你辛苦了

XDSoft · 发表于 2002-9-23 19:04:09

下载地址：http://www.xdcad.net/tech/XDTB_XSCALE.swf

<embed src=http://www.xdcad.net/tech/XDTB_XSCALE.swf quality=high width=532 height=482 loop=true type="application/x-shockwave-flash">
</embed>

caibaobao · 发表于 2002-9-24 19:03:23

晓东，能不能把他加入你的工具箱？

XDSoft · 发表于 2002-9-24 20:10:32

最初由 caibaobao 发布
[B]晓东，能不能把他加入你的工具箱？ [/B]

工具箱0.26里面有，就快提供给大家了。

你也可以先加载这个LISP，然后调用上面的命令名。

wqmzy · 发表于 2002-9-26 12:37:07

最初由 XDSoft 发布
[B]

工具箱0.26里面有，就快提供给大家了。

你也可以先加载这个LISP，然后调用上面的命令名。 [/B]

:6 :4 :1

XDSoft · 发表于 2002-9-26 17:03:53

最初由 wqmzy 发布
[B]

:6 :4 :1 [/B]

屏幕菜单在“工具一”里面，下拉菜单和图标菜单上都有。

如果长宽都缩，那么实体就变形了，如果你想要这些，可以把他们做成块，两个方向不同比例插入，插入后，炸开就不方便了。提供这个命令，主要是给大家布图的时候，对一些实体非常方便的稍微缩放些，能放进图中。

wqmzy · 发表于 2002-9-27 16:49:26

最初由 XDSoft 发布
[B]

屏幕菜单在“工具一”里面，下拉菜单和图标菜单上都有。

如果长宽都缩，那么实体就变形了，如果你想要这些，可以把他们做成块，两个方向不?.. [/B]

在晓东工具栏中没有自由缩放命令.
我正是想要让它变形,用作块的方法变形有点麻烦.
:4 :1 :c

XDSoft · 发表于 2002-9-27 16:58:02

最初由 wqmzy 发布
[B]

在晓?.. [/B]

屏幕菜单，POP菜单，工具条都有，下面图是工具栏图标：

登录/注册后可看大图

su69 · 发表于 2006-4-11 16:47:17

请问斑竹大人,这个工具在2004下使用,选择完基点cad2004就死机了

是怎么回事情? 望斑竹大人在百忙之中能把这个工具升下级.

li809 · 发表于 2006-4-12 00:09:23

还有其它的吗？

su69 · 发表于 2006-4-12 15:46:32

其它的还好使在cad2004下,
就是这个自由缩放的命令失效了, 希望斑竹们能把核心的函数改改
让它能够兼容cad 2004

zxyz · 发表于 2006-4-13 06:53:10

请问vba for cad 怎么入门哪？

su69 · 发表于 2006-4-13 11:46:42

高手能否给我提供点晓东自由缩放的工具能在cad2004下正常运行的信息

xyp1964 · 发表于 2006-4-13 13:52:30

最初由 su69 发布
[B]高手能否给我提供点晓东自由缩放的工具能在cad2004下正常运行的信息 [/B]

试试：http://p4.xdcad.net/forum/showth ... 2693972#post2693972

账号		自动登录	找回密码
密码			立即注册

[分享]：给大家写了“自由缩放”命令...

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

自由缩放演示

自由缩放命令在文字菜单中没有,并且只能长宽同比缩放,能否改进.

Re: 自由缩放命令在文字菜单中没有,并且只能长宽同比缩放,能否改进.

Re: Re: 自由缩放命令在文字菜单中没有,并且只能长宽同比缩放,能否改进.

Re: Re: Re: 自由缩放命令在文字菜单中没有,并且只能长宽同比缩放,能否改进.