[编程申请]：申请批量scale的程序，请高手帮忙！

zzstar · 发表于 2004-5-4 18:18:58

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

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

×

那位兄弟能帮忙编一个程序，满足以下效果：
1.执行命令后所选物体直接放大1.5倍，不提示基点和比例因子
2.执行命令后若选择多个块物体，这些块物体以各自的基点缩放1.5倍，不提示基点和比例因子

先谢了！

自由的鱼 · 发表于 2004-5-4 21:33:23

各自基点是以块中心吗？

zzstar · 发表于 2004-5-5 14:23:34

最初由自由的鱼发布
[B]各自基点是以块中心吗？ [/B]

是啊！老兄你会啊！能否帮忙编一个程序啊？

自由的鱼 · 发表于 2004-5-6 12:08:42

你传个图上来，我看看都是什么图元

zzstar · 发表于 2004-5-6 22:21:34

图来了

自由的鱼 · 发表于 2004-5-7 17:58:24

这个程序用在你这张图上正好，：）
第一个是全选，第二个是屏选

Option Explicit

Sub allscale()
Dim ent As AcadEntity
Dim sset As AcadSelectionSet
Dim Ftype(0) As Integer
Dim Fdata(0) As Variant
Dim i As Integer
For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next

Ftype(0) = 0
Fdata(0) = "INSERT"

Dim minpnt As Variant
Dim maxpnt As Variant
Dim cpnt(0 To 2) As Double

Set sset = ThisDrawing.SelectionSets.Add("TKsel")
sset.Select acSelectionSetAll, , , Ftype, Fdata
For Each ent In sset
ent.GetBoundingBox minpnt, maxpnt
cpnt(0) = (minpnt(0) + maxpnt(0)) / 2
cpnt(1) = (minpnt(1) + maxpnt(1)) / 2
cpnt(2) = 0
ent.ScaleEntity cpnt, 1.5
Next

End Sub

Sub choosescale()
Dim ent As AcadEntity
Dim sset As AcadSelectionSet
Dim Ftype(0) As Integer
Dim Fdata(0) As Variant
Dim i As Integer
For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next

Ftype(0) = 0
Fdata(0) = "INSERT"

Dim minpnt As Variant
Dim maxpnt As Variant
Dim cpnt(0 To 2) As Double

Set sset = ThisDrawing.SelectionSets.Add("TKsel")
sset.SelectOnScreen Ftype, Fdata
For Each ent In sset
ent.GetBoundingBox minpnt, maxpnt
cpnt(0) = (minpnt(0) + maxpnt(0)) / 2
cpnt(1) = (minpnt(1) + maxpnt(1)) / 2
cpnt(2) = 0
ent.ScaleEntity cpnt, 1.5
Next

End Sub

zzstar · 发表于 2004-5-11 12:59:07

我是低手，不知道你的这个程序怎么用。好像只是子程序，不知道怎么加载啊！大哥能不能说得明白些?

自由的鱼 · 发表于 2004-5-11 21:29:50

在CAD的命令行中输入vbaide,把我上面的代码帖进去，然后在命令行输入VBARUN，选择需要执行的过程就可以了！

zzstar · 发表于 2004-5-12 12:59:46

长老真是个好人啊！多谢多谢！
请问长老：想学cad编程和二次开发需要从哪里开始学起？有什么好方法没有？

自由的鱼 · 发表于 2004-5-12 21:17:49

先买一本入门的书，按照上面的例子练，入门之后就在论坛多看看别人的程序，慢慢来！

陌生人 · 发表于 2004-5-12 23:13:08

wcs下使用
[php]
(defun c:test ()
  (vl-cmdf ".undo" "be")
  (setq ss (ssget) sc (getdist "\n缩放比例:") i -1)
  (repeat (sslength ss)
(vl-cmdf ".scale" (setq e(ssname ss (setq i(1+ i)))) "" (trans (cdr (assoc 10 (entget e))) 0 1) )
(vl-cmdf ".undo" "e")
)[/php]

daiping888 · 发表于 2008-4-1 16:52:19

想问能不能随意设置比例呀！特别期盼中

zml84 · 发表于 2008-4-14 00:37:18

(defun C:TT ( / ss sc i e)
(while (setq SS (ssget))
(if (setq SC (getdist "\n缩放比例:"))
(progn
(setq I 0)
(repeat (sslength SS)
(command "_.scale"
(setq e(ssname SS I))
""
(trans (cdr (assoc 10 (entget E))) 0 1)
SC
)
(setq I (1+ I))
)
)
)
)
(princ)
)

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

[编程申请]：申请批量scale的程序，请高手帮忙！

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

相关帖子