乐筑天下

帖子
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 59|回复: 3

[编程交流] Vba问题

[复制链接]

1

主题

1

帖子

0

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-6 22:29:23 | 显示全部楼层 |阅读模式
私有子GetPlais\u Click()
Dim tmpnt1作为变体,tmpnt2作为变体,tmpPnt1作为变体
Dim lole(0到2)为双精度,upri(0到2)为双精度
Dim returnobj作为AcadObject
FrmGrid3.隐藏
关于错误转到Eline
此图纸。公用事业GetEntity returnobj,tmpPnt1,“ðÝëëëëëëëëëëëëëëëëëëëëëë
如果returnobj的类型为IAcadPViewport,则
设置viewportObj=returnobj
视口对象。UCSIconOn=真
视口对象。UCSIconAtOrigin=True
视口对象。显示真实
Scal=1000/viewportObj。CustomScale’=1000/CDbl(cbScale.Text)
 
其他的
MsgBox“ViewPort!!!”,vbOKOnly,“Ó÷åäßççèèè
FrmGrid3.Show
出口接头
如果结束
lole(0)=视口对象。居中(0)-视口对象。宽度/2
lole(1)=视口对象。居中(1)-视口对象。高度/2
upri(0)=视口对象。居中(0)+视口对象。宽度/2
upri(1)=视口对象。居中(1)+视口对象。高度/2
PntUpLPap(0)=lole(0):PntDoLPap(0)=lole(0):PntUpRPap(0)=upri(0):PntDoRPap(0)=upri(0)
PntUpLPap(1)=upri(1):PntDoLPap(1)=lole(1):PntUpRPap(1)=upri(1):PntDoRPap(1)=lole(1)
tmpnt1=此图纸。公用事业平移坐标(lole、acPaperSpaceDCS、acDisplayDCS、False)
tmpnt1=此图纸。公用事业平移坐标(tmpnt1、acDisplayDCS、acWorld、False)
TxtDoLX。文本=格式(tmpnt1(0),“0.##0”):PntDoLmod(0)=tmpnt1(0)
TxtDoLY。文本=格式(tmpnt1(1),“0.##0”):PntDoLmod(1)=tmpnt1(1)
tmpnt1=此图纸。公用事业平移坐标(upri、acPaperSpaceDCS、acDisplayDCS、False)
tmpnt1=此图纸。公用事业平移坐标(tmpnt1、acDisplayDCS、acWorld、False)
TxTPRx。文本=格式(tmpnt1(0),“0.##0”):PntUpRmod(0)=tmpnt1(0)
TxtUpRY。文本=格式(tmpnt1(1),“0.##0”):PntUpRmod(1)=tmpnt1(1)
tmpnt1(0)=lole(0)
tmpnt1(1)=upri(1)
tmpnt1=此图纸。公用事业平移坐标(tmpnt1、acPaperSpaceDCS、acDisplayDCS、False)
tmpnt1=此图纸。公用事业平移坐标(tmpnt1、acDisplayDCS、acWorld、False)
TxTPLx。文本=格式(tmpnt1(0),“0.##0”):PntUpLmod(0)=tmpnt1(0)
TxtUpLY。文本=格式(tmpnt1(1),“0.##0”):PntUpLmod(1)=tmpnt1(1)
tmpnt1(0)=upri(0)
tmpnt1(1)=lole(1)
tmpnt1=此图纸。公用事业平移坐标(tmpnt1、acPaperSpaceDCS、acDisplayDCS、False)
tmpnt1=此图纸。公用事业平移坐标(tmpnt1、acDisplayDCS、acWorld、False)
TxtDoRX。文本=格式(tmpnt1(0),“0.##0”):PntDoRmod(1)=tmpnt1(0)
TxtDoRY。文本=格式(tmpnt1(1),“0.##0”):PntDoRmod(1)=tmpnt1(1)
 
Eline:
FrmGrid3.Show
末端接头
我无法理解这个问题!!!!
回复

使用道具 举报

4

主题

2143

帖子

2197

银币

限制会员

铜币
-24
发表于 2022-7-6 23:02:13 | 显示全部楼层
齐马罗斯,
 
请阅读代码发布指南并编辑您的帖子。
回复

举报

11

主题

46

帖子

36

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
55
发表于 2022-7-6 23:16:18 | 显示全部楼层
你应该重做你的项目或给所有的模块代码。。。
 
  1. Private Sub GetPlais_Click()
  2.    'you have to dim these as open arrays, SEE OPEN ARRAY below
  3.    Dim tmpnt1() As Variant
  4.   ' where is this one??
  5.    Dim tmpPnt1 As Variant
  6.    ' YOUR NOT USING THIS ONE AT ALL
  7.    tmpnt2 As Variant
  8.    
  9.    Dim lole(0 To 2) As Double, upri(0 To 2) As Double
  10.    Dim returnobj As AcadObject
  11.    FrmGrid3.Hide
  12.    On Error GoTo Eline
  13.    ThisDrawing.Utility.GetEntity returnobj, tmpPnt1, "ÅðÝëåîå ôï ViewPort ðïõ èá äçìéïõñãçèåß ï êÜíáâïò!"
  14.    If TypeOf returnobj Is IAcadPViewport Then
  15.        Set viewportObj = returnobj
  16.        viewportObj.UCSIconOn = True
  17.        viewportObj.UCSIconAtOrigin = True
  18.        viewportObj.Display True
  19.        Scal = 1000 / viewportObj.CustomScale '= 1000 / CDbl(cbScale.Text)
  20.    Else
  21.        MsgBox "ÄÝí åðÝëåîåò ViewPort!!!", vbOKOnly, "Ó÷åäßáóç êáíÜâïõ"
  22.        FrmGrid3.Show
  23.        Exit Sub
  24.    End If
  25.    
  26.    lole(0) = viewportObj.Center(0) - viewportObj.Width / 2
  27.    lole(1) = viewportObj.Center(1) - viewportObj.Height / 2
  28.    
  29.    upri(0) = viewportObj.Center(0) + viewportObj.Width / 2
  30.    upri(1) = viewportObj.Center(1) + viewportObj.Height / 2
  31.    
  32.    ' ARE THESE GLOBAL?
  33.    PntUpLPap(0) = lole(0): PntDoLPap(0) = lole(0): PntUpRPap(0) = upri(0): PntDoRPap(0) = upri(0)
  34.    PntUpLPap(1) = upri(1): PntDoLPap(1) = lole(1): PntUpRPap(1) = upri(1): PntDoRPap(1) = lole(1)
  35.    
  36.    tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(lole, acPaperSpaceDCS, acDisplayDCS, False)
  37.    tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)
  38.    
  39.    TxtDoLX.Text = Format(tmpnt1(0), "0.##0"): PntDoLmod(0) = tmpnt1(0)
  40.    TxtDoLY.Text = Format(tmpnt1(1), "0.##0"): PntDoLmod(1) = tmpnt1(1)
  41.    
  42.    tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(upri, acPaperSpaceDCS, acDisplayDCS, False)
  43.    tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)
  44.    
  45.    TxtUpRX.Text = Format(tmpnt1(0), "0.##0"): PntUpRmod(0) = tmpnt1(0)
  46.    TxtUpRY.Text = Format(tmpnt1(1), "0.##0"): PntUpRmod(1) = tmpnt1(1)
  47.    
  48.    ' OPEN ARRAY:
  49.    tmpnt1(0) = lole(0)
  50.    tmpnt1(1) = upri(1)
  51.    
  52.    tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acPaperSpaceDCS, acDisplayDCS, False)
  53.    tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)
  54.    
  55.    TxtUpLX.Text = Format(tmpnt1(0), "0.##0"): PntUpLmod(0) = tmpnt1(0)
  56.    TxtUpLY.Text = Format(tmpnt1(1), "0.##0"): PntUpLmod(1) = tmpnt1(1)
  57.    
  58.    tmpnt1(0) = upri(0)
  59.    tmpnt1(1) = lole(1)
  60.    
  61.    tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acPaperSpaceDCS, acDisplayDCS, False)
  62.    tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)
  63.    
  64.    TxtDoRX.Text = Format(tmpnt1(0), "0.##0"): PntDoRmod(1) = tmpnt1(0)
  65.    TxtDoRY.Text = Format(tmpnt1(1), "0.##0"): PntDoRmod(1) = tmpnt1(1)
  66. Eline:
  67. FrmGrid3.Show
  68. End Sub
  69. I can 't understand the problem!!!!
回复

举报

106

主题

1万

帖子

101

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1299
发表于 2022-7-6 23:46:44 | 显示全部楼层
有什么问题?请描述一下
 
  1. Dim tmpPnt1 As Variant, tmpnt2 As Variant
  2.    ' YOUR NOT USING THIS ONE AT ALL
  3.   
回复

举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁體中文

GMT+8, 2025-2-28 14:29 , Processed in 0.296114 second(s), 60 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表