明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1292|回复: 2

求助直线加长的问题

[复制链接]
发表于 2004-12-2 18:18:00 | 显示全部楼层 |阅读模式
我想让图中的某些直线长度加长,当我编不来VBA,请高手帮忙一下,帮我编一个,谢谢了



附件中A是原来的,B是运行VBA后的
 楼主| 发表于 2004-12-2 18:20:00 | 显示全部楼层

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2004-12-2 21:22:00 | 显示全部楼层
Sub n()
On Error Resume Next
Dim sset As AcadSelectionSet
Dim entry As AcadLine
Dim insertpoint As Variant
Dim insertpoint1 As Variant
Set sset = ThisDrawing.ModelSpace.SelectionSets.Add("ss1")
If Err Then
Err.Clear
ThisDrawing.SelectionSets("ss1").Delete
Set sset = ThisDrawing.SelectionSets.Add("ss1")
End If
sset.SelectOnScreen
For Each entry In sset
insertpoint = entry.StartPoint
insertpoint1 = entry.EndPoint
If insertpoint(1) > insertpoint1(1) Then
insertpoint(1) = insertpoint(1) + 100
insertpoint1(1) = insertpoint1(1) - 100
entry.StartPoint = insertpoint
entry.EndPoint = insertpoint1
Else
insertpoint(1) = insertpoint(1) - 100
insertpoint1(1) = insertpoint1(1) + 100
entry.StartPoint = insertpoint
entry.EndPoint = insertpoint1
End If
Next entry
End Sub
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-27 23:53 , Processed in 0.170687 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表