乐筑天下

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

阻止不镜像

[复制链接]
jjs

6

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
73
发表于 2006-12-21 18:08:59 | 显示全部楼层 |阅读模式
于是我通过808 \/\/4 # R
http://www . theswamp . org/index . PHP找到了这个帖子?topic = 6791 . msg 83800 # msg 83800
我在一张图纸上尝试了它,我在这张图纸上测试了不同的例程。大多数积木都可以用,但有些不行。奇怪。我还需要添加一个旋转属性旋转到0代码部分。我遇到困难时会寻求帮助。
当然,除非808在最初发布后进行了整理。
808井?

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

16

主题

168

帖子

39

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
197
发表于 2006-12-21 19:13:04 | 显示全部楼层
嗨,杰瑞米,
鲍勃已经有一段时间没有了
回复

使用道具 举报

jjs

6

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
73
发表于 2006-12-21 19:26:47 | 显示全部楼层
我发完帖子后,回去重读了他的帖子,注意到他的名字下面写着客人。如果一个人连自己都看不到,那么让他难堪就没什么意思了。
我会尝试通过其他方式联系他,看看能不能把他拖回来。
谢谢提醒。
回复

使用道具 举报

16

主题

168

帖子

39

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
197
发表于 2006-12-21 19:33:15 | 显示全部楼层
很高兴见到你,圣诞快乐!
回复

使用道具 举报

jjs

6

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
73
发表于 2006-12-21 22:04:46 | 显示全部楼层
好吧,我采取了808的良好开端,并使其变得更好。现在的属性是正确的旋转角度和正确的位置。我花了一段时间才弄清楚,因为插入点属性不用于没有为其对齐属性留下、适合或对齐的属性。
希望这有助于其他人。最终需要做unmirY。哦,我从来没有更新过纸空间部分。但是谁在纸空间中绘制和镜像?
  1. Option Explicit
  2. Public Sub UnMirror()
  3. On Error GoTo ErrorControl
  4.   
  5.   Dim strSet As String
  6.   Dim intGroup() As Integer
  7.   Dim varGroup() As Variant
  8.   Dim varAtts As Variant
  9.   Dim objSelSet As AcadSelectionSet
  10.   Dim objSelSets As AcadSelectionSets
  11.   Dim strBlkName As String
  12.   Dim PI As Double
  13.   Dim strSetName As String
  14.   Dim objBlkRef As AcadBlockReference
  15.   Dim objEnt As AcadEntity
  16.   Dim intCnt As Integer
  17.   
  18.   PI = (Atn(1) * 4)
  19.   Set objSelSets = ThisDrawing.SelectionSets
  20.   strSetName = 1
  21.   ReDim intGroup(0)
  22.   ReDim varGroup(0)
  23.   intGroup(0) = 0
  24.   varGroup(0) = "insert"
  25. BlockName:
  26.   strBlkName = ThisDrawing.Utility.GetString(True, "Block to unmirror [All, Select, ]:")
  27.   If strBlkName = "" Or Left(strBlkName, 1) = " " Then
  28.     ReDim Preserve intGroup(0 To 1)
  29.     ReDim Preserve varGroup(0 To 1)
  30.     intGroup(1) = 2
  31.     varGroup(1) = "defaultblockname"
  32.   ElseIf StrComp(strBlkName, "a", vbTextCompare) = 0 Or StrComp(strBlkName, "all", vbTextCompare) = 0 Then
  33.     ReDim Preserve intGroup(0 To 1)
  34.     ReDim Preserve varGroup(0 To 1)
  35.     intGroup(1) = 2
  36.     varGroup(1) = "*"
  37.   ElseIf StrComp(strBlkName, "s", vbTextCompare) = 0 Or StrComp(strBlkName, "sel", vbTextCompare) = 0 Or StrComp(strBlkName, "select", vbTextCompare) = 0 Then
  38.     KillSet strSetName
  39.     Set objSelSet = objSelSets.Add(strSetName)
  40.     objSelSet.SelectOnScreen intGroup, varGroup
  41.     ReDim intGroup(0 To (objSelSet.Count) + 1)
  42.     ReDim varGroup(0 To (objSelSet.Count) + 1)
  43.     intGroup(0) = -4
  44.     varGroup(0) = ""
  45.    
  46.     For intCnt = 1 To objSelSet.Count
  47.       If TypeOf objSelSet.Item(intCnt - 1) Is AcadBlockReference Then
  48.         Set objBlkRef = objSelSet.Item(intCnt - 1)
  49.         intGroup(intCnt) = 2
  50.         varGroup(intCnt) = objBlkRef.Name
  51.       End If
  52.     Next intCnt
  53.   Else
  54.     ReDim Preserve intGroup(0 To 1)
  55.     ReDim Preserve varGroup(0 To 1)
  56.     intGroup(1) = 2
  57.     varGroup(1) = strBlkName
  58.   End If
  59.   
  60.   KillSet strSetName
  61.   Set objSelSet = objSelSets.Add(strSetName)
  62.   objSelSet.Select acSelectionSetAll, , , intGroup, varGroup
  63.   
  64.   If objSelSet.Count > 0 Then
  65.     GoTo FollowTheRabbit
  66.   Else
  67.     ThisDrawing.Utility.Prompt vbCrLf & "**No Blocks Selected**" & vbCrLf
  68.     GoTo ExitHere
  69.   End If
  70.    
  71. FollowTheRabbit:
  72.   Dim dblMSpc As Double
  73.   Dim dblPSpc As Double
  74.   Dim dblRotRad As Double
  75.   Dim dblrotrad180 As Double
  76.   Dim dblRotDeg As Double
  77.   Dim dblScale(0 To 2) As Double
  78.   Dim dblInsPt(0 To 2) As Double
  79.   Dim objNewRef As AcadBlockReference
  80.   Dim varOldAtt As Variant
  81.   Dim varNewAtt As Variant
  82.   
  83.   dblMSpc = ThisDrawing.ModelSpace.ObjectID
  84.   dblPSpc = ThisDrawing.PaperSpace.ObjectID
  85.   
  86.     For Each objEnt In objSelSet
  87.       If TypeOf objEnt Is AcadBlockReference Then
  88.         Set objBlkRef = objEnt
  89.         If objBlkRef.XScaleFactor  90 Then MsgBox "dblrotdeg above 90 radians = " & dblRotRad
  90.           Debug.Print "dblRotRad " & dblRotRad
  91.           'Select Case dblRotRad
  92.           'Case 0 To (PI * 120) / 180
  93.           '  Debug.Print "dblRotRad between 0 and 90 =" & dblRotRad
  94.               dblrotrad180 = (PI * 180) / 180
  95.               dblRotRad = dblRotRad + dblrotrad180
  96.           'Case (PI * 120) / 180 To (PI * 360) / 180
  97.           '  Debug.Print "dblRotRad between 120 and 330 =" & dblRotRad
  98.           '    dblrotrad180 = (PI * 180) / 180
  99.           '    dblRotRad = dblRotRad + dblrotrad180
  100.           'Case Else
  101.          
  102.          '   Debug.Print "dblRotRad NOT BETWEEN 0 AND 90 =" & dblRotRad
  103.           'End Select
  104.          
  105.           '*******************************
  106. '          dblRotDeg = (dblRotRad * 180) / PI
  107. '          Debug.Print "dblRotDeg " & dblRotDeg
  108. '          If dblRotDeg > 120 And dblRotDeg  360 Then
  109. '              dblRotDeg = dblRotDeg - 360
  110. '            End If
  111. '            dblRotRad = (PI * dblRotDeg) / 180
  112. '          End If
  113.           If objBlkRef.OwnerID = dblMSpc Then
  114.             Set objNewRef = ThisDrawing.ModelSpace.InsertBlock(dblInsPt, objBlkRef.Name, dblScale(0), dblScale(1), dblScale(2), dblRotRad)
  115.             If objNewRef.HasAttributes Then
  116.               varOldAtt = objBlkRef.GetAttributes
  117.               varNewAtt = objNewRef.GetAttributes
  118.               For intCnt = 0 To UBound(varOldAtt)
  119.                 varNewAtt(intCnt).TextString = varOldAtt(intCnt).TextString
  120.                 objNewRef.Update
  121.                 varNewAtt(intCnt).InsertionPoint = varOldAtt(intCnt).InsertionPoint
  122.                 If varNewAtt(intCnt).Alignment  acAlignmentLeft And varNewAtt(intCnt).Alignment  acAlignmentFit And varNewAtt(intCnt).Alignment  acAlignmentAligned Then
  123.                 varNewAtt(intCnt).TextAlignmentPoint = varOldAtt(intCnt).TextAlignmentPoint
  124.                 End If
  125. '               Debug.Print "NEWATT INSX= " & CStr(varNewAtt(intCnt).InsertionPoint(0))
  126. '                Debug.Print "NEWATT INSY= " & varNewAtt(intCnt).InsertionPoint(1)
  127. '                Debug.Print "OLDATT INSX= " & varOldAtt(intCnt).InsertionPoint(0)
  128. '                Debug.Print "OLDATT INSY= " & varOldAtt(intCnt).InsertionPoint(1)
  129. '                Debug.Print "***********************************"
  130.                
  131.                 varNewAtt(intCnt).Rotation = varOldAtt(intCnt).Rotation
  132.               Next intCnt
  133.             End If
  134.             objNewRef.Layer = objBlkRef.Layer
  135.             objNewRef.Linetype = objBlkRef.Linetype
  136.             objNewRef.LinetypeScale = objBlkRef.LinetypeScale
  137.             objNewRef.Lineweight = objBlkRef.Lineweight
  138.             If Left(ThisDrawing.GetVariable("acadver"), 2) = "16" Then
  139.               objNewRef.TrueColor = objBlkRef.TrueColor
  140.             Else
  141.               objNewRef.color = objBlkRef.color
  142.             End If
  143.             objNewRef.Visible = objBlkRef.Visible
  144. '            objNewRef.Update
  145. '            If objNewRef.HasAttributes Then
  146. '              varOldAtt = objBlkRef.GetAttributes
  147. '              varNewAtt = objNewRef.GetAttributes
  148. '              For intCnt = 0 To UBound(varOldAtt)
  149. '                'varNewAtt(intCnt).TextString = varOldAtt(intCnt).TextString
  150. '
  151. '                varNewAtt(intCnt).InsertionPoint = varOldAtt(intCnt).InsertionPoint
  152. ''               Debug.Print "NEWATT INSX= " & CStr(varNewAtt(intCnt).InsertionPoint(0))
  153. ''                Debug.Print "NEWATT INSY= " & varNewAtt(intCnt).InsertionPoint(1)
  154. ''                Debug.Print "OLDATT INSX= " & varOldAtt(intCnt).InsertionPoint(0)
  155. ''                Debug.Print "OLDATT INSY= " & varOldAtt(intCnt).InsertionPoint(1)
  156. ''                Debug.Print "***********************************"
  157. '
  158. '                'varNewAtt(intCnt).Rotation = varOldAtt(intCnt).Rotation
  159. '              Next intCnt
  160. '            End If
  161.             objBlkRef.Delete
  162.             objNewRef.Update
  163.           Else
  164.             Set objNewRef = ThisDrawing.PaperSpace.InsertBlock(dblInsPt, objBlkRef.Name, dblScale(0), dblScale(1), dblScale(2), dblRotRad)
  165.             If objNewRef.HasAttributes Then
  166.               varOldAtt = objBlkRef.GetAttributes
  167.               varNewAtt = objNewRef.GetAttributes
  168.               For intCnt = 0 To UBound(varOldAtt)
  169.                 varNewAtt(intCnt).TextString = varOldAtt(intCnt).TextString
  170.               Next intCnt
  171.             End If
  172.             objNewRef.Layer = objBlkRef.Layer
  173.             objNewRef.Linetype = objBlkRef.Linetype
  174.             objNewRef.LinetypeScale = objBlkRef.LinetypeScale
  175.             objNewRef.Lineweight = objBlkRef.Lineweight
  176.             If Left(ThisDrawing.GetVariable("acadver"), 2) = "16" Then
  177.               objNewRef.TrueColor = objBlkRef.TrueColor
  178.             Else
  179.               objNewRef.color = objBlkRef.color
  180.             End If
  181.             objNewRef.Visible = objBlkRef.Visible
  182.             objBlkRef.Delete
  183.             objNewRef.Update
  184.             End If
  185.         End If
  186.       End If
  187.     Next objEnt
  188.       
  189. ExitHere:
  190. Exit Sub
  191. ErrorControl:
  192.   Select Case Err.Number
  193.   Case Else
  194.       MsgBox "''" & Err.Description & "'' error has occured in UnMirror" & vbCr & _
  195.       "All Blocks May NOT have updated correctly" & vbCrLf & _
  196.       "Please report the error to Cad Manager", vbCritical, "Error in UnMirror"
  197.       GoTo ExitHere
  198.   End Select
  199. End Sub
  200. Function KillSet(strSet As String)
  201.   Dim objSelSet As AcadSelectionSet
  202.   Dim objSelSets As AcadSelectionSets
  203.   
  204.   Set objSelSets = ThisDrawing.SelectionSets
  205.       
  206.   For Each objSelSet In objSelSets
  207.     If objSelSet.Name = strSet Then
  208.       ThisDrawing.SelectionSets.Item(strSet).Delete
  209.     Exit For
  210.     End If
  211.   Next
  212. End Function

回复

使用道具 举报

17

主题

162

帖子

7

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
234
发表于 2006-12-21 23:43:32 | 显示全部楼层
嘿杰米!很高兴见到你。希望新的冒险进行顺利,你有一个伟大的圣诞节!
回复

使用道具 举报

jjs

6

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
73
发表于 2007-3-2 01:20:56 | 显示全部楼层
嘿jjs,很高兴见到你。 不要成为陌生人
回复

使用道具 举报

jjs

6

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
73
发表于 2007-3-2 09:13:34 | 显示全部楼层
我有一些ABS编程要做,所以我会更频繁地出现。
回复

使用道具 举报

16

主题

168

帖子

39

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
197
发表于 2007-3-2 11:16:25 | 显示全部楼层
我,你确定它不是麦基弗吗?
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-7 09:10 , Processed in 1.876848 second(s), 71 queries .

© 2020-2025 乐筑天下

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