乐筑天下

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

设置现有门样式

[复制链接]

57

主题

235

帖子

3

银币

后起之秀

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

铜币
463
发表于 2006-7-26 09:36:53 | 显示全部楼层 |阅读模式
任何人都有一个简单的模糊来设置预定义的门样式为当前?

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

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

使用道具 举报

6

主题

38

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
62
发表于 2006-7-26 12:00:31 | 显示全部楼层
这要么是Windows注册表中的设置,要么是一些xData hoo ha,我不记得是哪个了...相信我,SendCommand是您在这里最好的选择。
***添加了***
它在注册表中...这是密钥...至少在我的上。因人而异,具体取决于您使用的版本。
HKEY_CURRENT_USER\Software\欧特克\AutoCAD\R16.0\ACAD-204:409\Profiles\
\对话框\AecArchX40-DoorAdd\StyleName
顺便说一句,这是与当前设置任何对象样式相同的一般位置和方法。墙壁、门、窗户等...
回复

使用道具 举报

57

主题

235

帖子

3

银币

后起之秀

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

铜币
463
发表于 2006-7-26 13:11:17 | 显示全部楼层

我不想创建新的门样式,我想通过vba将现有样式设置为当前样式。
回复

使用道具 举报

57

主题

235

帖子

3

银币

后起之秀

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

铜币
463
发表于 2006-7-26 15:00:50 | 显示全部楼层
他告诉你需要在哪里设置信息,并建议你改用发送命令。他没有说要创建一个新样式。
回复

使用道具 举报

57

主题

235

帖子

3

银币

后起之秀

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

铜币
463
发表于 2006-7-26 15:03:21 | 显示全部楼层
我必须更改注册表设置以更改活动的门样式?
回复

使用道具 举报

12

主题

150

帖子

3

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
198
发表于 2006-7-26 15:06:56 | 显示全部楼层
我自己没有ADT,我不能肯定,但根据我对BAshworth的了解,是的,除非您使用send命令。我听说ADT暴露给VBA的是有限的和可怜的。看起来这就是一个例子。
回复

使用道具 举报

57

主题

235

帖子

3

银币

后起之秀

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

铜币
463
发表于 2006-7-26 15:08:50 | 显示全部楼层
(呼!!!)伙计,不是开玩笑的。对于手动进行简单的更改来说,这是一项艰巨的工作!
回复

使用道具 举报

12

主题

150

帖子

3

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
198
发表于 2006-7-26 15:48:49 | 显示全部楼层
这些家伙给你提了个好建议。
你知道SendCommabd "是什么吗?
如果没有。查一下,你的问题就解决了。
this drawing . send command " blah " & vbcr
回复

使用道具 举报

12

主题

150

帖子

3

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
198
发表于 2006-7-26 15:53:25 | 显示全部楼层
是的,我知道“发送命令”是什么,我不想无礼,但事实是,使用“发送命令”来完美地执行这个功能并不像你想象的那么简单。在你评价我的能力之前,试着让它自己发挥作用。
回复

使用道具 举报

57

主题

235

帖子

3

银币

后起之秀

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

铜币
463
发表于 2006-7-26 19:38:27 | 显示全部楼层
抱歉,
也不是想粗鲁。快速评论有被误读的倾向。
我一直使用sendCommand。我主要处理3D实体。因此,许多方法都不可用,例如对齐。我还使用它来运行pedit和设置ucs。我意识到在不同的提示下使用它可能很棘手,有时根本不起作用,例如使分组集可选择,因为必须阅读提示然后回复。
在您的情况下,一位高级程序员似乎完全理解您正在尝试做的事情,他会推荐它。我知道,有时这很令人沮丧,sendCommand也不例外。
您的另一个选择是注册表。编写也不是问题。
您只需要做出选择并完成它。
下面的代码将对reg做很多事情。您需要添加自己的代码来调用您需要的函数。将代码放在模块中,而不是表单中,只需调用函数并将字符串传递给它们。
祝你好运,
Dave
  1. ' Created by E.Spencer (elliot@spnc.demon.co.uk) - This code is public domain.
  2. '
  3. Option Explicit
  4. Global sValue As String
  5. 'Security Mask constants
  6. Public Const READ_CONTROL = &H20000
  7. Public Const SYNCHRONIZE = &H100000
  8. Public Const STANDARD_RIGHTS_ALL = &H1F0000
  9. Public Const STANDARD_RIGHTS_READ = READ_CONTROL
  10. Public Const STANDARD_RIGHTS_WRITE = READ_CONTROL
  11. Public Const KEY_QUERY_VALUE = &H1
  12. Public Const KEY_SET_VALUE = &H2
  13. Public Const KEY_CREATE_SUB_KEY = &H4
  14. Public Const KEY_ENUMERATE_SUB_KEYS = &H8
  15. Public Const KEY_NOTIFY = &H10
  16. Public Const KEY_CREATE_LINK = &H20
  17. Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
  18.    KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
  19.    KEY_CREATE_LINK) And (Not SYNCHRONIZE))
  20. Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
  21.    KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
  22. Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
  23. Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE _
  24.    Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
  25. ' Possible registry data types
  26. Public Enum InTypes
  27.    ValNull = 0
  28.    ValString = 1
  29.    ValXString = 2
  30.    ValBinary = 3
  31.    ValDWord = 4
  32.    ValLink = 6
  33.    ValMultiString = 7
  34.    ValResList = 8
  35. End Enum
  36. Public Type typSrings
  37.   Val1 As String
  38.   Val2 As String
  39. End Type
  40. ' Registry value type definitions
  41. Public Const REG_NONE As Long = 0
  42. Public Const REG_SZ As Long = 1
  43. Public Const REG_EXPAND_SZ As Long = 2
  44. Public Const REG_BINARY As Long = 3
  45. Public Const REG_DWORD As Long = 4
  46. Public Const REG_LINK As Long = 6
  47. Public Const REG_MULTI_SZ As Long = 7
  48. Public Const REG_RESOURCE_LIST As Long = 8
  49. ' Registry section definitions
  50. Public Const HKEY_CLASSES_ROOT = &H80000000
  51. Public Const HKEY_CURRENT_USER = &H80000001
  52. Public Const HKEY_LOCAL_MACHINE = &H80000002
  53. Public Const HKEY_USERS = &H80000003
  54. Public Const HKEY_PERFORMANCE_DATA = &H80000004
  55. Public Const HKEY_CURRENT_CONFIG = &H80000005
  56. Public Const HKEY_DYN_DATA = &H80000006
  57. ' Codes returned by Reg API calls
  58. Private Const ERROR_NONE = 0
  59. Private Const ERROR_BADDB = 1
  60. Private Const ERROR_BADKEY = 2
  61. Private Const ERROR_CANTOPEN = 3
  62. Private Const ERROR_CANTREAD = 4
  63. Private Const ERROR_CANTWRITE = 5
  64. Private Const ERROR_OUTOFMEMORY = 6
  65. Private Const ERROR_INVALID_PARAMETER = 7
  66. Private Const ERROR_ACCESS_DENIED = 8
  67. Private Const ERROR_INVALID_PARAMETERS = 87
  68. Private Const ERROR_NO_MORE_ITEMS = 259
  69. ' Registry API functions used in this module (there are more of them)
  70. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  71. Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
  72. Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  73. Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  74. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  75. Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  76. Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
  77. Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
  78. Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  79. Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
  80. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
  81. Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
  82. ' This routine allows you to get values from anywhere in the Registry, it currently
  83. ' only handles string, double word and binary values. Binary values are returned as
  84. ' hex strings.
  85. '
  86. ' Example
  87. ' Text1.Text = ReadRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "DefaultUserName")
  88. '
  89. Public Function ReadRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String
  90. Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
  91. Dim TStr1 As String, TStr2 As String
  92. Dim i As Integer
  93. On Error Resume Next
  94. lResult = RegOpenKey(Group, Section, lKeyValue)
  95. sValue = Space$(2048)
  96. lValueLength = Len(sValue)
  97. lResult = RegQueryValueEx(lKeyValue, Key, 0&, lDataTypeValue, sValue, lValueLength)
  98. If (lResult = 0) And (Err.Number = 0) Then
  99.    If lDataTypeValue = REG_DWORD Then
  100.       td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
  101.       sValue = Format$(td, "000")
  102.    End If
  103.    If lDataTypeValue = REG_BINARY Then
  104.        ' Return a binary field as a hex string (2 chars per byte)
  105.        TStr2 = ""
  106.        For i = 1 To lValueLength
  107.           TStr1 = Hex(Asc(Mid(sValue, i, 1)))
  108.           If Len(TStr1) = 1 Then TStr1 = "0" & TStr1
  109.           TStr2 = TStr2 + TStr1
  110.        Next
  111.        sValue = TStr2
  112.    Else
  113.       sValue = Left$(sValue, lValueLength - 1)
  114.    End If
  115. Else
  116.    sValue = "Not Found"
  117. End If
  118. lResult = RegCloseKey(lKeyValue)
  119. ReadRegistry = sValue
  120. End Function
  121. ' This routine allows you to write values into the entire Registry, it currently
  122. ' only handles string and double word values.
  123. '
  124. ' Example
  125. ' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App", "NewSubKey", ValString, "NewValueHere"
  126. ' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App", "NewSubKey", ValDWord, "31"
  127. '
  128. Public Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, ByVal ValType As InTypes, ByVal Value As Variant)
  129. Dim lResult As Long
  130. Dim lKeyValue As Long
  131. Dim InLen As Long
  132. Dim lNewVal As Long
  133. Dim sNewVal As String
  134. On Error Resume Next
  135. lResult = RegCreateKey(Group, Section, lKeyValue)
  136. If ValType = ValDWord Then
  137.    lNewVal = CLng(Value)
  138.    InLen = 4
  139.    lResult = RegSetValueExLong(lKeyValue, Key, 0&, ValType, lNewVal, InLen)
  140. Else
  141.    ' Fixes empty string bug - spotted by Marcus Jansson
  142.    If ValType = ValString Then Value = Value + Chr(0)
  143.    sNewVal = Value
  144.    InLen = Len(sNewVal)
  145.    lResult = RegSetValueExString(lKeyValue, Key, 0&, 1&, sNewVal, InLen)
  146. End If
  147. lResult = RegFlushKey(lKeyValue)
  148. lResult = RegCloseKey(lKeyValue)
  149. End Sub
  150. ' This routine enumerates the subkeys under any given key
  151. ' Call repeatedly until "Not Found" is returned - store values in array or something
  152. '
  153. ' Example - this example just adds all the subkeys to a string - you will probably want to
  154. ' save then into an array or something.
  155. '
  156. ' Dim Res, NewLine As String
  157. ' Dim i As Long
  158. ' Res = ReadRegistryGetSubkey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall", i)
  159. ' NewLine = ""
  160. ' Do Until Res = "Not Found"
  161. '   Text1.Text = Text1.Text & NewLine & Res
  162. '   i = i + 1
  163. '   Res = ReadRegistryGetSubkey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall", i)
  164. '   NewLine = Chr(13) & Chr(10)
  165. ' Loop
  166. Public Function ReadRegistryGetSubkey(ByVal Group As Long, ByVal Section As String, Idx As Long) As String
  167. Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
  168. On Error Resume Next
  169. lResult = RegOpenKey(Group, Section, lKeyValue)
  170. sValue = Space$(2048)
  171. lValueLength = Len(sValue)
  172. lResult = RegEnumKey(lKeyValue, Idx, sValue, lValueLength)
  173. If (lResult = 0) And (Err.Number = 0) Then
  174.    sValue = Left$(sValue, InStr(sValue, Chr(0)) - 1)
  175. Else
  176.    sValue = "Not Found"
  177. End If
  178. lResult = RegCloseKey(lKeyValue)
  179. ReadRegistryGetSubkey = sValue
  180. End Function
  181. ' This routine allows you to get all the values from anywhere in the Registry under any
  182. ' given subkey, it currently only returns string and double word values.
  183. '
  184. ' Example - returns list of names/values to multiline text box
  185. ' Dim Res As Variant
  186. ' Dim i As Long
  187. ' Res = ReadRegistryGetAll(HKEY_CURRENT_USER, "Software\Microsoft\Notepad", i)
  188. ' Do Until Res(2) = "Not Found"
  189. '    Text1.Text = Text1.Text & Chr(13) & Chr(10) & Res(1) & " " & Res(2)
  190. '    i = i + 1
  191. '    Res = ReadRegistryGetAll(HKEY_CURRENT_USER, "Software\Microsoft\Notepad", i)
  192. ' Loop
  193. '
  194. Public Function ReadRegistryGetAll(ByVal Group As Long, ByVal Section As String, Idx As Long) As Variant
  195. Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long
  196. Dim lValueLength As Long, lValueNameLength As Long
  197. Dim sValueName As String ', sValue As String
  198. Dim td As Double
  199. On Error Resume Next
  200. lResult = RegOpenKey(Group, Section, lKeyValue)
  201. sValue = Space$(2048)
  202. sValueName = Space$(2048)
  203. lValueLength = Len(sValue)
  204. lValueNameLength = Len(sValueName)
  205. lResult = RegEnumValue(lKeyValue, Idx, sValueName, lValueNameLength, 0&, lDataTypeValue, sValue, lValueLength)
  206. If (lResult = 0) And (Err.Number = 0) Then
  207.    If lDataTypeValue = REG_DWORD Then
  208.       td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
  209.       sValue = Format$(td, "000")
  210.    End If
  211.    sValue = Left$(sValue, lValueLength - 1)
  212.    sValueName = Left$(sValueName, lValueNameLength)
  213. Else
  214.    sValue = "Not Found"
  215. End If
  216. lResult = RegCloseKey(lKeyValue)
  217. ' Return the datatype, value name and value as an array
  218. ReadRegistryGetAll = Array(lDataTypeValue, sValueName, sValue)
  219. End Function
  220. ' This routine deletes a specified key (and all its subkeys and values if on Win95) from the registry.
  221. ' Be very careful using this function.
  222. '
  223. ' Example
  224. ' DeleteSubkey HKEY_CURRENT_USER, "Software\My Name\My App"
  225. '
  226. Public Function DeleteSubkey(ByVal Group As Long, ByVal Section As String) As String
  227. Dim lResult As Long, lKeyValue As Long
  228. On Error Resume Next
  229. lResult = RegOpenKeyEx(Group, vbNullChar, 0&, KEY_ALL_ACCESS, lKeyValue)
  230. lResult = RegDeleteKey(lKeyValue, Section)
  231. lResult = RegCloseKey(lKeyValue)
  232. End Function
  233. ' This routine deletes a specified value from below a specified subkey.
  234. ' Be very careful using this function.
  235. '
  236. ' Example
  237. ' DeleteValue HKEY_CURRENT_USER, "Software\My Name\My App", "NewSubKey"
  238. '
  239. Public Function DeleteValue(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String
  240. Dim lResult As Long, lKeyValue As Long
  241. On Error Resume Next
  242. lResult = RegOpenKey(Group, Section, lKeyValue)
  243. lResult = RegDeleteValue(lKeyValue, Key)
  244. lResult = RegCloseKey(lKeyValue)
  245. End Function

回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-6 03:41 , Processed in 0.937521 second(s), 72 queries .

© 2020-2025 乐筑天下

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