读取cad钢束生成midas文件

dogingate 发表于 2019-12-19 15:01:24 | 显示全部楼层 | 阅读模式
本帖最后由 dogingate 于 2019-12-19 15:03 编辑

在cad中加载这个dvb小东东,可以直接读取钢束生成mct文件,方便钢束建模

公路桥梁荷载横向分布计算(李国豪+石洞).pdf

6.65 MB, 下载次数: 0

售价: 1 元堡币  [记录]  [购买]

桥梁结构空间分析设计方法与应用-戴公连+李建连.pdf

4.26 MB, 下载次数: 0

售价: 1 元堡币  [记录]  [购买]

_东江大桥报告.pdf

7.45 MB, 下载次数: 3

售价: 1 元堡币  [记录]

_超大跨度斜拉桥几何非线性及随机模拟分析-梁鹏老师博士论文.pdf

4.97 MB, 下载次数: 0

售价: 1 元堡币  [记录]  [购买]

桥梁工程软件Midas Civil常见问题解答.pdf

5.51 MB, 下载次数: 0

售价: 1 元堡币  [记录]  [购买]

《拱桥》(下册).pdf

9.69 MB, 下载次数: 0

售价: 1 元堡币  [记录]  [购买]

★(李国豪)桥梁结构稳定与振动.pdf

8.27 MB, 下载次数: 1

售价: 1 元堡币  [记录]  [购买]

装配式公路钢桥多用途使用手册.pdf

9.63 MB, 下载次数: 0

售价: 1 元堡币  [记录]  [购买]

刚构-连续组合梁桥.pdf

6.8 MB, 下载次数: 4

售价: 1 元堡币  [记录]

readTendons.zip

66.59 KB, 下载次数: 22

售价: 1 元堡币  [记录]

精彩评论倒序浏览

9135查看7评论

gu888min 发表于 2019-12-19 19:00:13
在cad中要输什么命令

点评

这个,要vbaload那个dvb文件,然后vbaide打开编辑器,从里面按f5运行  详情 回复 发表于 2020-1-14 17:25
举报 回复
桥梁追梦人... 发表于 2019-12-20 09:15:46
楼主说的dvd是附件里的那个压缩包?
举报 回复
dogingate 发表于 2020-1-14 17:25:26
gu888min 发表于 2019-12-19 19:00
在cad中要输什么命令

这个,要vbaload那个dvb文件,然后vbaide打开编辑器,从里面按f5运行
举报 回复
dogingate 发表于 2020-7-2 17:25:43
  1. Sub TendonsCadTransformsToMidas()
  2. On Error Resume Next
  3. Dim oZdPlinesXYZ As Object: Set oZdPlinesXYZ = CreateObject("scripting.dictionary")

  4. Dim zdkey As String
  5. Dim zditem As Variant
  6. Dim strFullFileName As String

  7. '''=============================读取坐标原点坐标=======================================
  8. Dim dblXBase As Double, dblYBase As Double, dblZBase As Double
  9. Dim dblScaleFactor As Double, strTendonName As String, strTendonBelong As String
  10. Dim oSset As AcadSelectionSet
  11. Dim keyWord As String
  12. Dim objAcadEntity As AcadEntity
  13. Dim varPickedPoint As Variant
  14. Dim arrCoordinates As Variant

  15. keyWord = "C"
  16. intPlineNum = 0
  17. intPlinesCount = 0

  18. Do While keyWord = "C"

  19.     '''比例尺
  20.     dblScaleFactor = 1

  21.     '''钢束特性值
  22.     strTendonName = ThisDrawing.Utility.GetString(False, "请输入Midas钢束名称,默认=auto : ")
  23.     If Err Then
  24.         If StrComp(Err.Description, "User input is a keyword", 1) Then
  25.             Err.Clear
  26.             strTendonName = "auto"
  27.         End If
  28.     End If
  29.     If strTendonName = "" Then
  30.         strTendonName = "auto"
  31.     End If
  32.    
  33.    
  34.     '''钢束所属单元
  35.     strTendonBelong = ThisDrawing.Utility.GetString(False, "请输入Midas钢束分配单元,默认为1to100 : ")
  36.     If Err Then
  37.         If StrComp(Err.Description, "User input is a keyword", 1) Then
  38.             Err.Clear
  39.              strTendonBelong = "1to100"
  40.         End If
  41.     End If
  42.     If strTendonBelong = "" Then
  43.         strTendonBelong = "1to100"
  44.     End If
  45.    
  46.     ptBase = ThisDrawing.Utility.GetPoint(, "请指定坐标原点,默认为(0,0)点 : ")
  47. '    If StrComp(Err.Description, "User input is a keyword", 1) Then
  48. '        Err.Clear
  49. '        ptBase(0) = 0: ptBase(1) = 0: ptBase(2) = 0
  50. '    End If
  51.    
  52.     Set oSset = ThisDrawing.SelectionSets.Add("TEST_SSET") '增加选择集
  53.     If Err Then
  54.         Err.Clear
  55.         ThisDrawing.SelectionSets.Item("TEST_SSET").Delete     '删除选择集
  56.         Set oSset = ThisDrawing.SelectionSets.Add("TEST_SSET")
  57.     End If
  58.    
  59.     oSset.SelectOnScreen '''在屏幕上进行选择
  60.    
  61.     '================================读取多段线坐标============================================
  62.     For k = 0 To oSset.Count - 1
  63.     If TypeOf oSset.Item(k) Is AcadLWPolyline Then '''判断选择集是否为多段线
  64.         Set oLWPolyline = oSset.Item(k): arrCoordinates = oLWPolyline.Coordinates
  65.    
  66.         '''读取数据存入oPlines
  67.         zdkey = oLWPolyline.ObjectID

  68.         If Not oZdPlinesXYZ.exists(zdkey) Then
  69.             intPlinePointsCount = (UBound(arrCoordinates) + 1) / 2 '''控制点个数
  70.             ReDim zditem(0 To intPlinePointsCount - 1, 0 To 7) '''0)x;1)y;2)z;3)radius;4)bulge(凸度);5)缩放因子;6)钢束名称;7)钢束所属单元
  71.                        
  72.             For n = 0 To intPlinePointsCount - 1 '''下标从0开始,并将y坐标与z坐标进行转换
  73.                 zditem(n, 0) = arrCoordinates((n) * 2) - ptBase(0) '''x坐标
  74.                 zditem(n, 1) = 0 '''y坐标
  75.                 zditem(n, 2) = arrCoordinates((n) * 2 + 1) - ptBase(1) '''z坐标
  76.                 zditem(n, 3) = 0 '''radius
  77.                 zditem(n, 4) = oLWPolyline.GetBulge(n) '''bulge
  78.                 zditem(n, 5) = dblScaleFactor
  79.                 zditem(n, 6) = strTendonName
  80.                 zditem(n, 7) = strTendonBelong
  81.             Next
  82.             
  83.             Call sortPlineByX(zditem)
  84.             
  85.             oZdPlinesXYZ(zdkey) = zditem
  86.         End If
  87.     End If
  88.     Next k
  89.    
  90.     ThisDrawing.SelectionSets.Item("TEST_SSET").Delete '''删除选择集
  91.    
  92.     ThisDrawing.Utility.InitializeUserInput 0, "C E"
  93.     keyWord = ThisDrawing.Utility.GetKeyword("是否继续选择,继续选择<C>,结束选择并输出数据<E>,默认为C >]: ")
  94.    
  95.     If Err Or keyWord = "" Then
  96.         keyWord = "C"
  97.         Err.Clear
  98.     End If
  99.    
  100. Loop

  101. Dim arrZdkeys As Variant: arrZdkeys = oZdPlinesXYZ.keys
  102. Dim strOut As String: strOut = ""
  103. For k = 0 To oZdPlinesXYZ.Count - 1
  104.     zdkey = arrZdkeys(k)
  105.     arrPlines = oZdPlinesXYZ(zdkey)
  106.     strOut = strOut & dPlinesXYCal(arrPlines) & vbCrLf
  107. Next k

  108. ''====================================================================
  109. ''输出数据
  110. strFullFileName = "c:" & "\TendonsToMidas.txt"
  111. Open strFullFileName For Output As #1
  112. Print #1, strOut
  113. Close #1

  114. ''====================================================================
  115. ThisDrawing.Utility.Prompt "输出Civil Midas的钢束数据文件成功!"

  116. End Sub

  117. Sub sortPlineByX(arr)
  118. Dim i&, j&, vSwap, min&
  119. For i = LBound(arr, 1) To UBound(arr, 1)
  120.     min = i
  121.     For j = i + 1 To UBound(arr, 1)
  122.         If arr(min, 0) > arr(j, 0) Then min = j
  123.     Next
  124.     If min <> i Then
  125.         For k = 0 To 7
  126.             vSwap = arr(min, k): arr(min, k) = arr(i, k): arr(i, k) = vSwap
  127.         Next k
  128.     End If
  129. Next i

  130. End Sub


  131. Function dPlinesXYCal(ByVal arrPlines As Variant)

  132. Dim intPlinesCount As Integer: intPlinesCount = 1

  133. '半径赋值
  134. Dim dTheta As Double, dblLength As Double, dblRadius As Double
  135. Dim a0 As Double, b0 As Double, c0 As Double
  136. Dim a1 As Double, b1 As Double, c1 As Double
  137. Dim dblDimensionUnit As Double: dblDimensionUnit = 100

  138. For k = 1 To intPlinesCount  '''逐钢束

  139.     Dim intPlinePointsCount As Integer:    intPlinePointsCount = UBound(arrPlines, 1) - LBound(arrPlines, 1) + 1
  140.     Dim arrPlinesNew As Variant
  141.    
  142.     '如果是导线点,半径按输入的计入,如果是圆弧,推算转点及半径
  143.     j = 0
  144.     For n = 0 To intPlinePointsCount - 1 '''逐钢束上的控制点
  145.         If arrPlines(n, 4) <> 0 Then '''凸度不为零 bulge=tan(theta/4)=2*L/H
  146.             dTheta = 4 * Atn(Abs(arrPlines(n, 4))) '''圆心角
  147.             dblLength = Sqr((arrPlines(n + 1, 0) - arrPlines(n, 0)) ^ 2 + (arrPlines(n + 1, 2) - arrPlines(n, 2)) ^ 2) '''割线长度=sqrt((x2-x2)^2+(y2-y1)^2)
  148.             dblRadius = 0.5 * dblLength / Sin(dTheta / 2) '''半径

  149.             '''上一个直线和下一个直线的交点即为实际的转点
  150.             '''获取上一条直线ax+by+c=0方程的系数
  151.             Call getLinePara(arrPlines(n - 1, 0), arrPlines(n - 1, 2), arrPlines(n, 0), arrPlines(n, 2), a0, b0, c0)
  152.             '''获取下一条直线ax+by+c=0方程的系数
  153.             Call getLinePara(arrPlines(n + 1, 0), arrPlines(n + 1, 2), arrPlines(n + 2, 0), arrPlines(n + 2, 2), a1, b1, c1)
  154.             '''获取两条直线的交点
  155.             arrpoint = getCrossPoint(a0, b0, c0, a1, b1, c1)
  156.             ReDim Preserve arrPlinesNew(UBound(arrPlinesNew, 1), UBound(arrPlinesNew, 2) + 1)
  157.             arrPlinesNew(0, j) = arrpoint(0) / dblDimensionUnit
  158.             arrPlinesNew(1, j) = 0
  159.             arrPlinesNew(2, j) = arrpoint(1) / dblDimensionUnit
  160.             arrPlinesNew(3, j) = dblRadius / dblDimensionUnit 'radius
  161.             n = n + 1
  162.             j = j + 1
  163.         Else '''凸度为零
  164.             If j <> 0 Then
  165.                 ReDim Preserve arrPlinesNew(UBound(arrPlinesNew, 1), UBound(arrPlinesNew, 2) + 1)
  166.             Else
  167.                 ReDim arrPlinesNew(0 To 3, 0 To 0)
  168.             End If
  169.             arrPlinesNew(0, j) = arrPlines(n, 0) / dblDimensionUnit 'x
  170.             arrPlinesNew(1, j) = arrPlines(n, 1) / dblDimensionUnit 'y
  171.             arrPlinesNew(2, j) = arrPlines(n, 2) / dblDimensionUnit 'z
  172.             arrPlinesNew(3, j) = 0 'radius
  173.             j = j + 1
  174.         End If

  175.     Next n

  176. Next k

  177. Call sortPlineByX(arrPlinesNew)

  178. dblScaleFactor = arrPlines(0, 5)
  179. strTendonName = arrPlines(0, 6)
  180. strTendonBelong = arrPlines(0, 7)

  181. strTendonProperty = "auto"
  182. strTendonGroup = "auto"

  183. dPlinesXYCal = TendonsTransformToMidas(arrPlinesNew, dblScaleFactor, strTendonName, strTendonProperty, strTendonBelong, strTendonGroup)

  184. End Function


  185. Sub getInput(dblScaleFactor, strTendonName, strTendonBelong, ptBase)
  186. '''================================读取参数(默认值)================================================
  187. ''''比例因子
  188. 'dblScaleFactor = ThisDrawing.Utility.GetReal("请输入钢束线长度至m单位需放大的比例,默认=1 :")
  189. 'If Err Then
  190. '    If StrComp(Err.Description, "User input is a keyword", 1) Then
  191. '        Err.Clear
  192. '        dblScaleFactor = 1
  193. '    End If
  194. 'End If
  195. 'If dblScaleFactor = "" Then
  196. '    dblScaleFactor = 1
  197. 'End If

  198.    
  199. End Sub


  200. Private Function TendonsTransformToMidas(arrPlinesNew, dblScaleFactor, strTendonName, strTendonProperty, strTendonBelong, strTendonGroup)
  201. ''====================================================================
  202. '*TDN-PROFILE   ; Tendon Profile
  203. '; NAME=NAME, TDN-PROPERTY, ELEM_LIST, BEGIN, END, CURVE, INPUT  ; line 1
  204. ';      GROUP, LENGOPT, BLEN, ELEN, bTP, rNUM                    ; line 2
  205. ';      SHAPE, IP_X, IP_Y, IP_Z, AXIS, VX, VY                    ; line 3(Straight)
  206. ';      SHAPE, IP_X, IP_Y, IP_Z, RC_X, RC_Y, OFFSET, DIR         ; line 3(Curve)
  207. ';      SHAPE, INS_PT, REF_ELEM, AXIS                            ; line 3(Element)
  208. ';      XAR_ANGLE, bPROJECTION, GR_AXIX, GR_ANGLE                ; line 4(Straight/Curve)
  209. ';      XAR_ANGLE, bPROJECTION, OFFSET_Y, OFFSET_Z               ; line 4(Element)
  210. ';      X1, Y1, Z1, bFIX1, RY1, RZ1, RADIUS1                     ; from line 5(3D)

  211. '*TDN-PROPERTY    ; Tendon Property
  212. '; NAME, TYPE, MATL, AREA, DIA, RM, RC, FF, WF, US, YS, LT, ASB, ASE, bBONDED, ALPHA, \
  213. ';       bOSRF, FT, FPK, ACHANGE, bRELAX, TDMFK, WobbleType, AngleDisp
  214. '   15, INTERNAL, 2, 0.0021, 0.09, 2, 0, 0.3, 0.0066, 1.86326e+006, 1.56906e+006, POST, 0.006, 0.006, YES, 0, NO, 0.3, 1860000, 0, YES, 0, 0, 0
  215. '   12, INTERNAL, 2, 0.00168, 0.08, 2, 0, 0.3, 0.0066, 1.86326e+006, 1.56906e+006, POST, 0.006, 0.006, YES, 0, NO, 0.3, 1860000, 0, YES, 0, 0, 0

  216. Dim dX As Double, dY As Double, dZ As Double, dR As Double
  217. Dim strOut As String: strOut = ""

  218. '''钢束特性
  219. strOut = strOut & "*TDN-PROPERTY    ; Tendon Property" & vbCrLf
  220. strOut = strOut & strTendonProperty & ", INTERNAL, 2, 0.0021, 0.09, 2, 0, 0.3, 0.0066, 1.86326e+006, 1.56906e+006, POST, 0.006, 0.006, YES, 0, NO, 0.3, 1860000, 0, YES, 0, 0, 0" & vbCrLf

  221. '''钢束组
  222. strOut = strOut & "*TENDON-GROUP    ; Tendon Group" & vbCrLf
  223. strOut = strOut & strTendonGroup & vbCrLf

  224. '''钢束形状
  225. strOut = strOut & "*TDN-PROFILE   ; Tendon Profile" & vbCrLf
  226. strOut = strOut & "NAME=" & strTendonName & "," & strTendonProperty & "," & strTendonBelong & ",0,0,ROUND,3D" & vbCrLf

  227. strOut = strOut & strTendonGroup & ",USER,0,0,NO," & vbCrLf
  228. strOut = strOut & "STRAIGHT,0,0,0,X,0,0" & vbCrLf
  229. strOut = strOut & "0,YES,Y,0" & vbCrLf
  230. For i = 0 To UBound(arrPlinesNew, 2)
  231.     dX = Round(arrPlinesNew(0, i), 3)
  232.     dY = Round(arrPlinesNew(1, i), 3)
  233.     dZ = Round(arrPlinesNew(2, i), 3)
  234.     dR = Round(arrPlinesNew(3, i), 3)
  235.     strOut = strOut & dX & "," & dY & "," & dZ & ",NO,0,0," & dR & vbCrLf
  236. Next i

  237. TendonsTransformToMidas = strOut

  238. End Function

  239. Private Sub getLinePara(x0, y0, X1, Y1, A, B, C)
  240. '''两点求直线方程ax+by+c=0

  241. A = y0 - Y1
  242. B = X1 - x0
  243. C = x0 * Y1 - y0 * X1

  244. End Sub

  245. Private Function getCrossPoint(a0 As Double, b0 As Double, c0 As Double, a1 As Double, b1 As Double, c1 As Double)
  246. '''计算两直线交点

  247. Dim arrxy As Variant: ReDim arrxy(1)
  248. D = a0 * b1 - a1 * b0
  249. If D <> 0 Then
  250.     arrxy(0) = (b0 * c1 - b1 * c0) / D
  251.     arrxy(1) = (a1 * c0 - a0 * c1) / D
  252. End If
  253. getCrossPoint = arrxy

  254. End Function





复制代码
举报 回复
david63246 发表于 2020-7-14 19:20:05
楼主 这个生成的MCT文件在哪里呀?

截图202007141919286941..png
举报 回复
xiangkeke2... 发表于 2021-1-6 17:05:22
能说得更清楚明白些吗?
举报 回复
dogingate 发表于 2022-5-5 13:04:53
就是2条直线求交点啊
给4个点的坐标,分别用前面两个点和后面两个点各确定一条直线,然后求交点坐标
举报 回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则

 
 
  • QQ:56984982
  • 点击这里给我发消息
    电话:13527553862
    站务咨询群桥头堡站务咨询桥梁专业交流群:
    中国桥梁专业领袖群
    工作时间
    8:00-18:00