Re: Trying to texture a multipatch

JohnMcGlynn — Sat, 15 Nov 2014 09:41:39 GMT

I read that document and like Allan I couldn't get it to work.

My successful effort was the sub below. I have used it to add images to the flags on the Sydney Harbour Bridge and the Anzac Bridge in Sydney. Sorry for the line nos, I forgot to strip them out.

Private Sub tileComponentGeometry(ByVal sLayer As String, ByVal sOID As String, _

ByVal sTextureFile As String, ByVal sGeomNo As String, _

ByRef sError As String, ByRef sMsg As String, ByVal sXfreq As String, _

ByVal sYfreq As String)

' Add an image to a component geometry. The image is tiled Xfreq x Yfreq across the geometry.

' sOID can only refer to one component. The image is in the texture file.

1: Using pComReleaser As New ESRI.ArcGIS.ADF.ComReleaser

2: Dim pColour As IRgbColor

3: Dim iColourNo As Integer

4: Dim pFeat As IFeature

5: Dim pFC As IFeatureClass

6: Dim pPtColl As IPointCollection4

7: Dim iOID As Integer

8: Dim pGeom As IGeometry

9: Dim bGeomProgress As Boolean

10: Dim pPt1 As ESRI.ArcGIS.Geometry.IPoint

11: Dim pWKSPt As WKSPoint

12: Dim pZAware As IZAware

13: Dim pExGeomCol As IGeometryCollection

14: Dim pExMultiPatch As IMultiPatch

15: Dim pNewGeomPatchCreator As IGeneralMultiPatchCreator

16: Dim pGenInfo As IGeneralMultiPatchInfo

17: Dim pMat As IGeometryMaterial

18: Dim pMatList As IGeometryMaterialList

19: Dim i As Integer

20: Dim iPatchType As ESRI.ArcGIS.Geometry.esriPatchType

21: Dim j As Integer

22: Dim k As Integer

23: Dim n As Integer

24: Dim iVertices As Integer

25: Dim pNewMultiPatch As IMultiPatch

26: Dim pSpatialRef As ISpatialReference

27: Dim sFldOID As String

28: Dim bWhere As Boolean = True

29: Dim iGeomCount As Integer

30: Dim iGeomNo As Integer

31: Dim iPatchCount As Integer

32: Dim iAction As m_eTextureAction = m_iTextureAction

33: Dim iVertexCount As Integer

34: Dim s As String = "s"

35: Dim pColTextureFiles As New StringCollection

36: Dim sTempTextureFile As String

37: Dim iFileIndex As Short = 0

38: Dim dTransparency As Double ' 0 to 1

39: Dim sFileDir As String = My.Application.Info.DirectoryPath

40: Dim pExMultiPatchCopy As IMultiPatch

41: Dim iNewTexture As Short

42: Dim hPatchMatII As New Hashtable ' Patch index and it's material index

43: Dim hTexturePts As New Hashtable ' Point index + texture pt

44: Dim hExistingTexturesII As New Hashtable ' Material No + nothing

45: Dim iPriority As Integer

46: Dim iGeomMatIndex As Integer ' The material index of iGeomNo

47: Dim bAssigned As Boolean = False ' Set to True if the texture is overwriting an existing texture

49: Dim iXfreq As Short

50: Dim iYfreq As Short

51: Dim iX As Short

52: Dim iY As Short

53: Dim iTotTextureVertexCount As Integer

54: Dim iTextureVertexCount As Integer

55: Dim iTexture As Integer

56: Try

57: sError = ""

58: sMsg = ""

' Only one component can be changed and at least one geometry must be specified.

59: If String.IsNullOrEmpty(sOID) OrElse IsNumeric(sOID) = False Then

60: sError = "One (and only one) Component must be chosen"

61: Exit Sub

62: End If

' Set the OID

63: iOID = CInt(sOID)

64: If String.IsNullOrEmpty(sGeomNo) OrElse IsNumeric(sGeomNo) = False Then

65: sError = "At least one Geometry must be chosen as a Geometry Number"

66: Exit Sub

67: End If

' Geometry No

68: iGeomNo = CInt(sGeomNo)

' X and Y frequency

69: If String.IsNullOrEmpty(sXfreq) Or String.IsNullOrEmpty(sYfreq) Then

70: sError = "A Row and Column tile frequency is missing"

71: Exit Sub

72: End If

73: If IsNumeric(sXfreq) = False Or IsNumeric(sYfreq) = False Then

74: sError = "The Row or Column tile frequency is not a number"

75: Exit Sub

76: End If

77: iXfreq = CInt(sXfreq)

78: iYfreq = CInt(sYfreq)

' Spatial Reference

79: pSpatialRef = m_pSxDoc.Scene.SpatialReference

' Layer FeatureClass

80: Call getLayerFC(sLayer, pFC, sError, m_hLayers)

81: If sError.Length > 0 Then

82: sError = "cmdLayerReColour;" & vbCrLf & sError

83: MsgBox(sError)

84: If g_bLogging = True Then g_wLog.WriteLine(Format(Now, "hh:mm:ss") & " " & sError)

85: Exit Sub

86: End If

87: pComReleaser.ManageLifetime(pFC)

88: sFldOID = pFC.OIDFieldName

' Get the geometries that make up the component and copy them with the

' old or the new colour/texture. Note that you cannot update these values in the

' existing multipatches.

89: pFeat = pFC.GetFeature(iOID)

90: StatusLabel1.Text = iOID.ToString

91: StatusStrip1.Refresh()

92: If pFeat.ShapeCopy.IsEmpty Then

93: sError = "EMPTY SHAPE"

94: sMsg = "Shape is empty for feature; OID = " & sOID

95: Exit Sub

96: End If

97: bGeomProgress = False

98: pExGeomCol = CType(pFeat.ShapeCopy, IGeometryCollection)

' Decide if a progressbar of geometry is required

99: iGeomCount = pExGeomCol.GeometryCount

100: If iGeomCount > MAX_GEOM_COUNT_IGNORE Then

101: bGeomProgress = True

102: ProgressBar1.Value = 0

103: ProgressBar1.Maximum = iGeomCount

104: End If

' Get the existing Multipatch and it's info

105: pExMultiPatch = CType(pFeat.ShapeCopy, IMultiPatch)

' Make a copy

106: Dim objectCopy As IObjectCopy = New ObjectCopyClass()

107: Dim obj As Object = objectCopy.Copy(CObj(pExMultiPatch))

108: pExMultiPatchCopy = CType(obj, IMultiPatch)

109: pComReleaser.ManageLifetime(pExMultiPatchCopy)

110: pGenInfo = pExMultiPatchCopy

' Get the relationship between the patches (geometries) and the materials

' and the material index of the chosen geometry

111: iTotTextureVertexCount = 0 ' The existing total texture vertex count. If the new tiles replace

' ' an existing texture then the count from that texture is omitted.

112: For i = 0 To pGenInfo.PatchCount - 1

113: j = pGenInfo.PatchMaterialIndex(i)

114: hPatchMatII.Add(i, j)

115: If i = iGeomNo Then

116: iGeomMatIndex = j

117: iTotTextureVertexCount += (iXfreq * iYfreq) + 4 ' Add top left + bottom rt texture pts

118: ElseIf pGenInfo.IsMaterialTextured(j) = True Then

119: iTotTextureVertexCount += pGenInfo.PatchTextureVertexCount(i)

120: End If

121: Next i

' MultiPatch Info

122: iVertices = pGenInfo.VertexCount

123: iPatchCount = pGenInfo.PatchCount

' Create the new materials as a copy of the existing ones

124: pMatList = New GeometryMaterialListClass

125: For i = 0 To pGenInfo.MaterialCount - 1

126: pMat = New GeometryMaterial

127: If i = iGeomMatIndex And pGenInfo.IsMaterialTextured(i) = True Then

' Replace the old with the new texture - no colour

128: pMat.TextureImage = sTextureFile

129: iNewTexture = i

130: bAssigned = True

131: Else

' Existing Texture

' Colour

132: iColourNo = pGenInfo.MaterialColor(i)

133: pColour = New RgbColor

134: pColour.RGB = iColourNo

135: pMat.Color = pColour

136: If pGenInfo.IsMaterialTextured(i) = True Then

137: hExistingTexturesII.Add(i, i)

' Save an image of the texture

138: sTempTextureFile = sFileDir & "\" & TEXTURE_TEMP_FILE & iFileIndex.ToString & ".jpg"

139: If IO.File.Exists(sTempTextureFile) Then

140: IO.File.Delete(sTempTextureFile)

141: End If

142: StatusLabel1.Text = "OID " & sOID & " reading Texture No " & i.ToString

143: StatusStrip1.Refresh()

144: Call textureImageCreate(pGenInfo, i, sTempTextureFile, sError)

145: If sError.Length > 0 Then

146: sError = "tileComponentGeometry;" & vbCrLf & sError

147: Exit Sub

148: End If

' Add the file to the list so it can be deleted later

149: pColTextureFiles.Add(sTempTextureFile)

150: pMat.TextureImage = sTempTextureFile

151: iFileIndex += 1

152: End If

' Transparency

153: dTransparency = pGenInfo.MaterialTransparencyPercent(i)

154: pMat.Transparency = dTransparency / 100

155: End If

156: pMatList.AddMaterial(pMat)

157: Next i

158: If bAssigned = False Then

' Add the new material to the material list - no colour

159: iNewTexture = pMatList.Count

160: pMat = New GeometryMaterial

' New texture

161: pMat.TextureImage = sTextureFile

162: pMatList.AddMaterial(pMat)

163: End If

' Start the MultiPatch creator for the geometry copy

164: pNewGeomPatchCreator = New GeneralMultiPatchCreatorClass

165: pNewGeomPatchCreator.Init(iVertices, iGeomCount, False, False, False, iTotTextureVertexCount, pMatList)

' Set the patch types, points, materials and start points for vertices and textures

166: k = 0 ' Vertex

167: n = 0 ' Vertex

168: iTexture = 0 ' Vertex

169: For i = 0 To iGeomCount - 1

170: iPatchType = pGenInfo.PatchType(i)

171: iVertexCount = pGenInfo.PatchVertexCount(i)

172: iTextureVertexCount = pGenInfo.PatchTextureVertexCount(i)

' Patch Type

173: pNewGeomPatchCreator.SetPatchType(i, iPatchType)

' Patch No set start of next patch

174: pNewGeomPatchCreator.SetPatchPointIndex(i, k)

' Patch Material

175: If i = iGeomNo Then

176: pNewGeomPatchCreator.SetMaterialIndex(i, iNewTexture)

177: Else

178: pNewGeomPatchCreator.SetMaterialIndex(i, hPatchMatII(i))

179: End If

' Patch priority

180: iPriority = pGenInfo.PatchPriority(i)

181: pNewGeomPatchCreator.SetPatchPriority(i, iPriority)

' Texture point indexes

'pNewGeomPatchCreator.SetPatchTexturePointIndex(i, n)

' Set the texture vertex pts

182: If i = iGeomNo Then

183: pNewGeomPatchCreator.SetPatchTexturePointIndex(i, iTexture)

'' Set the top left and bottom right texture pts

'pWKSPt = New WKSPoint

'pWKSPt.X = 0

'pWKSPt.Y = iYfreq

'pNewGeomPatchCreator.SetTextureWKSPoint(iTexture, pWKSPt)

'iTexture += 1

'pWKSPt = New WKSPoint

'pWKSPt.X = iXfreq

'pWKSPt.Y = 0

'pNewGeomPatchCreator.SetTextureWKSPoint(iTexture, pWKSPt)

'iTexture += 1

' Left

184: For iY = 0 To iYfreq

185: pWKSPt = New WKSPoint

186: pWKSPt.X = 0

187: pWKSPt.Y = iY

188: pNewGeomPatchCreator.SetTextureWKSPoint(iTexture, pWKSPt)

189: iTexture += 1

190: Next iY

' Top

191: For iX = 0 To iXfreq

192: pWKSPt = New WKSPoint

193: pWKSPt.X = iX

194: pWKSPt.Y = iY

195: pNewGeomPatchCreator.SetTextureWKSPoint(iTexture, pWKSPt)

196: iTexture += 1

197: Next iX

' Right

198: For iY = iYfreq To 0 Step -1

199: pWKSPt = New WKSPoint

200: pWKSPt.X = iX

201: pWKSPt.Y = iY

202: pNewGeomPatchCreator.SetTextureWKSPoint(iTexture, pWKSPt)

203: iTexture += 1

204: Next iY

' Bottom

205: For iX = iXfreq To 0 Step -1

206: pWKSPt = New WKSPoint

207: pWKSPt.X = iX

208: pWKSPt.Y = iY

209: pNewGeomPatchCreator.SetTextureWKSPoint(iTexture, pWKSPt)

210: iTexture += 1

211: Next iX

212: ElseIf hExistingTexturesII.ContainsKey(pGenInfo.PatchMaterialIndex(i)) Then

213: pNewGeomPatchCreator.SetPatchTexturePointIndex(i, iTexture)

' This geometry has an existing texture. Reallocate the points

214: For j = 0 To pGenInfo.PatchTextureVertexCount(i) - 1

215: pWKSPt = New WKSPoint

216: pWKSPt = pGenInfo.PatchTextureVertex(i, j)

' Add this point

217: pNewGeomPatchCreator.SetTextureWKSPoint(iTexture, pWKSPt)

218: iTexture += 1

219: Next j

220: End If

' ***** Set the geometry points *****'

' Point collection type

221: iPatchType = pGenInfo.PatchType(i)

222: Select Case iPatchType

Case esriPatchType.esriPatchTypeTriangleStrip

223: pPtColl = New TriangleStripClass

224: Case esriPatchType.esriPatchTypeTriangleFan

225: pPtColl = New TriangleFanClass

226: Case esriPatchType.esriPatchTypeTriangles

227: pPtColl = New TrianglesClass

228: Case Else

229: pPtColl = New RingClass

230: End Select

231: pGeom = pExGeomCol.Geometry(i)

232: pPtColl = CType(pGeom, IPointCollection4)

233: For j = 0 To pPtColl.PointCount - 1

234: pPt1 = New ESRI.ArcGIS.Geometry.Point

235: pZAware = pPt1

236: pZAware.ZAware = True

237: pPt1 = pPtColl.Point(j)

238: pNewGeomPatchCreator.SetPoint(n, pPt1)

' Texture

'pNewGeomPatchCreator.SetTexturePoint(n, pPt1)

239: n += 1

240: Next j

241: If bGeomProgress = True Then ProgressBar1.Value = i

' User hits stop button

242: System.Windows.Forms.Application.DoEvents()

243: If m_bStop = True Then

244: sMsg = "Aborted by user"

245: Exit Sub

246: End If

'pNewGeomPatchCreator.SetPatchTexturePointIndex(i, k)

247: k += iVertexCount

248: Next i

249: pNewMultiPatch = New MultiPatch

250: pNewMultiPatch.SpatialReference = pSpatialRef

251: pNewMultiPatch = pNewGeomPatchCreator.CreateMultiPatch

252: pFeat.Shape = pNewMultiPatch

253: pFeat.Store()

254: pNewGeomPatchCreator.ClearResources()

255: Marshal.ReleaseComObject(pFeat)

256: Marshal.ReleaseComObject(pExMultiPatch)

257: Marshal.ReleaseComObject(pNewMultiPatch)

258: Catch ex As Exception

259: sError = "ERROR: tileComponentGeometry; Line: " & Erl() & vbCrLf & "Layer " & sLayer & " OID = " & iOID & vbCrLf & ex.ToString

260: Finally

261: ProgressBar1.Visible = False

' Delete the texture files

262: If pColTextureFiles.Count > 0 Then

263: For Each sTempTextureFile In pColTextureFiles

264: Try

265: IO.File.Delete(sTempTextureFile)

266: Catch ex As Exception

267: If g_bLogging = True Then g_wLog.WriteLine(Format(Now, "hh:mm:ss") & " Error deleting file: " & sTempTextureFile & " " & ex.Message)

268: End Try

269: Next sTempTextureFile

270: End If

271: End Try

272: End Using

End Sub

topic Trying to texture a multipatch in ArcObjects SDK Questions

Trying to texture a multipatch

Re: Trying to texture a multipatch

Re: Trying to texture a multipatch

Re: Trying to texture a multipatch

Re: Trying to texture a multipatch