0
点赞
收藏
分享

微信扫一扫

Word设置只读后，为什么还能编辑？

孟祥忠诗歌 2024-11-06 阅读 10
arcgiswindows

窗体如下：

 

执行标注效果：

完整代码：

Dim pgdbPath As String = Project.Current.DefaultGeodatabasePath
Dim dict As List(Of ArcGIS.Desktop.Mapping.FieldDescription)
Dim lab_fz(5) As String
Dim lab_fm(5) As String
Dim lab_qb(5) As String
Dim lab_hb(5) As String
Dim lyrDefn As CIMFeatureLayer
Dim def_path = Project.Current.HomeFolderPath
Dim dict As List(Of FieldDescription)
Dim xsws As Integer = 2
dim Map as Map = MapView.Active.Map
DIM FeatureLayer AS FeatureLayer
RJ_ERR = False
'获取图层
FeatureLayer = MapView.Active.GetSelectedLayers().FirstOrDefault()
 ' 获取图层定义
If FeatureLayer Is Nothing = True Then
     MsgBox("未选择图层.")
     RJ_ERR = True
     Exit Sub
End If

Await QueuedTask.Run(Sub()
                         lyrDefn = FeatureLayer.GetDefinition()
                         dict = FeatureLayer.GetFieldDescriptions
                     End Sub）
'获取标注
Dim listLabelClasses = lyrDefn.LabelClasses.ToList()
Dim theLabelClass = listLabelClasses.FirstOrDefault()
'设置标注语言为VBScript
theLabelClass.ExpressionEngine = LabelExpressionEngine.VBScript
        '设置标注内容
        lab_fz(0) = ComboBox2.Text
        lab_fz(1) = DataGridView1.Rows(0).Cells(1).Value.ToString
        lab_fz(2) = DataGridView1.Rows(0).Cells(2).Value.ToString
        lab_fz(3) = DataGridView1.Rows(0).Cells(3).Value.ToString
        lab_fz(4) = DataGridView1.Rows(0).Cells(4).Value.ToString
        lab_fz(5) = DataGridView1.Rows(0).Cells(5).Value.ToString
        lab_fm(0) = ComboBox3.Text
        lab_fm(1) = DataGridView1.Rows(1).Cells(1).Value.ToString
        lab_fm(2) = DataGridView1.Rows(1).Cells(2).Value.ToString
        lab_fm(3) = DataGridView1.Rows(1).Cells(3).Value.ToString
        lab_fm(4) = DataGridView1.Rows(1).Cells(4).Value.ToString
        lab_fm(5) = DataGridView1.Rows(1).Cells(5).Value.ToString
        lab_qb(0) = ComboBox1.Text
        lab_qb(1) = DataGridView1.Rows(2).Cells(1).Value.ToString
        lab_qb(2) = DataGridView1.Rows(2).Cells(2).Value.ToString
        lab_qb(3) = DataGridView1.Rows(2).Cells(3).Value.ToString
        lab_qb(4) = DataGridView1.Rows(2).Cells(4).Value.ToString
        lab_qb(5) = DataGridView1.Rows(2).Cells(5).Value.ToString
        lab_hb(0) = ComboBox4.Text
        lab_hb(1) = DataGridView1.Rows(3).Cells(1).Value.ToString
        lab_hb(2) = DataGridView1.Rows(3).Cells(2).Value.ToString
        lab_hb(3) = DataGridView1.Rows(3).Cells(3).Value.ToString
        lab_hb(4) = DataGridView1.Rows(3).Cells(4).Value.ToString
        lab_hb(5) = DataGridView1.Rows(3).Cells(5).Value.ToString
        If ComboBox1.Text = "0.00" Then xsws = 2
        If ComboBox1.Text = "0.000" Then xsws = 3
        If ComboBox1.Text = "0.0000" Then xsws = 4
        Dim x_lian1 As String = "<CHR Spacing = '-15'>"
        Dim x_lian2 As String = "</CHR>"
        Dim FZ_ZTCO As String = ""
        Dim FM_ZTCO As String = ""
        Dim QB_ZTCO As String = ""
        Dim HB_ZTCO As String = ""
        Dim ZTCO As String = "</FNT></CLR>"

        Select Case lab_fz(5)
            Case "黑"
                FZ_ZTCO = "<CLR red='0' green='0' blue='0'>"
            Case "红"
                FZ_ZTCO = "<CLR red='255' green='0' blue='0'>"
            Case "白"
                FZ_ZTCO = "<CLR red='255' green='255' blue='255'>"
            Case "绿"
                FZ_ZTCO = "<CLR red='0' green='255' blue='0'>"
            Case "蓝"
                FZ_ZTCO = "<CLR red='0' green='0' blue='255'>"
            Case "黄"
                FZ_ZTCO = "<CLR red='255' green='255' blue='0'>"
            Case Else
                FZ_ZTCO = "<CLR red='0' green='0' blue='0'>"
        End Select
        FZ_ZTCO = FZ_ZTCO & "<FNT name='" & lab_fz(3) & "' size='" & lab_fz(4) & " '>"

        Select Case lab_fm(5)
            Case "黑"
                FM_ZTCO = "<CLR red='0' green='0' blue='0'>"
            Case "红"
                FM_ZTCO = "<CLR red='255' green='0' blue='0'>"
            Case "白"
                FM_ZTCO = "<CLR red='255' green='255' blue='255'>"
            Case "绿"
                FM_ZTCO = "<CLR red='0' green='255' blue='0'>"
            Case "蓝"
                FM_ZTCO = "<CLR red='0' green='0' blue='255'>"
            Case "黄"
                FM_ZTCO = "<CLR red='255' green='255' blue='0'>"
            Case Else
                FM_ZTCO = "<CLR red='0' green='0' blue='0'>"
        End Select
        FM_ZTCO = FM_ZTCO & "<FNT name='" & lab_fm(3) & "' size='" & lab_fm(4) & "'>"

        Select Case lab_qb(5)
            Case "黑"
                QB_ZTCO = "<CLR red='0' green='0' blue='0'>"
            Case "红"
                QB_ZTCO = "<CLR red='255' green='0' blue='0'>"
            Case "白"
                QB_ZTCO = "<CLR red='255' green='255' blue='255'>"
            Case "绿"
                QB_ZTCO = "<CLR red='0' green='255' blue='0'>"
            Case "蓝"
                QB_ZTCO = "<CLR red='0' green='0' blue='255'>"
            Case "黄"
                QB_ZTCO = "<CLR red='255' green='255' blue='0'>"
            Case Else
                QB_ZTCO = "<CLR red='0' green='0' blue='0'>"
        End Select
        QB_ZTCO = QB_ZTCO & "<FNT name='" & lab_qb(3) & "' size='" & lab_qb(4) & "'>"

        Select Case lab_hb(5)
            Case "黑"
                HB_ZTCO = "<CLR red='0' green='0' blue='0'>"
            Case "红"
                HB_ZTCO = "<CLR red='255' green='0' blue='0'>"
            Case "白"
                HB_ZTCO = "<CLR red='255' green='255' blue='255'>"
            Case "绿"
                HB_ZTCO = "<CLR red='0' green='255' blue='0'>"
            Case "蓝"
                HB_ZTCO = "<CLR red='0' green='0' blue='255'>"
            Case "黄"
                HB_ZTCO = "<CLR red='255' green='255' blue='0'>"
            Case Else
                HB_ZTCO = "<CLR red='0' green='0' blue='0'>"
        End Select
        HB_ZTCO = HB_ZTCO & "<FNT name='" & lab_hb(3) & "' size='" & lab_hb(4) & "'>"
        Dim code1 As String
        Dim code As String = "Function FindLabel([" & lab_fz(0) & "],[" & lab_fm(0) & "],[" & lab_qb(0) & "],[" & lab_hb(0) & "])" & vbCrLf &
        "FindLabel = myFind([" & lab_fz(0) & "],[" & lab_fm(0) & "],[" & lab_qb(0) & "],[" & lab_hb(0) & "])" & vbCrLf &
        "End Function" & vbCrLf &
        "Function strlen(str)" & vbCrLf &
        "Dim p_len" & vbCrLf &
        "p_len = 0 : strlen = 0 : p_len = Len(Str)" & vbCrLf &
        "For xx = 1 To p_len" & vbCrLf &
            "If Asc(Mid(str, xx, 1)) <0 Then" & vbCrLf &
                " strlen= Int(strlen) + 2" & vbCrLf &
        " Else" & vbCrLf &
                " strlen= Int(strlen) + 1" & vbCrLf &
            " End If" & vbCrLf &
        " Next" & vbCrLf &
        " End Function" & vbCrLf &
        " Function myFind(cunname, DJH,tdxz, MJ)" & vbCrLf &
        "Dim zj_fz " & vbCrLf &
        "Dim zj_fm " & vbCrLf &
        "Dim zj_qb " & vbCrLf &
        "Dim zj_hb " & vbCrLf &
        "Dim str" & vbCrLf &
        "zj_fz = " & Chr(34) & Chr(34) & vbCrLf &
        "zj_fm = " & Chr(34) & Chr(34) & vbCrLf

        Dim cctt As FieldDescription = dict.FindAll(Function(t) t.Name = lab_fz(0)).FirstOrDefault
        If cctt.GetDatabaseField.Type.ToString = "esriFieldTypeDouble" Then
            code1 = "If IsNumeric(cunname) Then" & vbCrLf &
                        "str= Round(cunname," & xsws & ") " & vbCrLf &
                  "Else" & vbCrLf &
                        "Str = cunname" & vbCrLf &
                  "End If" & vbCrLf
        Else
            code1 = "Str = cunname" & vbCrLf
        End If
        code &= code1
        code &= "If cunname <> " & Chr(34) & Chr(34) & " Then" & vbCrLf &
            "zj_fz =" & Chr(34) & lab_fz(1) & Chr(34) & " &  Str & " & Chr(34) & lab_fz(2) & Chr(34) & vbCrLf &
        "End If" & vbCrLf


        cctt = dict.FindAll(Function(t) t.Name = lab_fm(0)).FirstOrDefault
        If cctt.GetDatabaseField.Type.ToString = "esriFieldTypeDouble" Then
            code1 = "If IsNumeric(DJH) Then" & vbCrLf &
                        "str= Round(DJH, " & xsws & ") " & vbCrLf &
                  "Else" & vbCrLf &
                        "Str = DJH" & vbCrLf &
                  "End If" & vbCrLf
        Else
            code1 = "Str = DJH" & vbCrLf
        End If
        code &= code1
        code &= "If DJH <> " & Chr(34) & Chr(34) & " Then" & vbCrLf &
            "zj_fm =" & Chr(34) & lab_fm(1) & Chr(34) & " & Str & " & Chr(34) & lab_fm(2) & Chr(34) & vbCrLf &
        "End If" & vbCrLf


        cctt = dict.FindAll(Function(t) t.Name = lab_qb(0)).FirstOrDefault
        If cctt.GetDatabaseField.Type.ToString = "esriFieldTypeDouble" Then
            code1 = "If IsNumeric(tdxz) Then" & vbCrLf &
                         "str= Round(tdxz, " & xsws & ") " & vbCrLf &
                   "Else" & vbCrLf &
                         "Str = tdxz" & vbCrLf &
                   "End If" & vbCrLf
        Else
            code1 = "Str = tdxz" & vbCrLf
        End If
        code &= code1
        code &= "zj_qb=" & Chr(34) & lab_qb(1) & Chr(34) & " & Str & " & Chr(34) & lab_qb(2) & Chr(34) & vbCrLf

        cctt = dict.FindAll(Function(t) t.Name = lab_hb(0)).FirstOrDefault
        If cctt.GetDatabaseField.Type.ToString = "esriFieldTypeDouble" Then
            code1 = "If IsNumeric(MJ) Then" & vbCrLf &
                          "str= Round(MJ, " & xsws & ") " & vbCrLf &
                    "Else" & vbCrLf &
                          "Str = MJ" & vbCrLf &
                    "End If" & vbCrLf
        Else
            code1 = "Str = MJ" & vbCrLf
        End If
        code &= code1
        code &= "zj_hb=" & Chr(34) & lab_hb(1) & Chr(34) & " & Str & " & Chr(34) & lab_hb(2) & Chr(34) & vbCrLf &
        "Dim d : d=strlen(zj_hb)" & vbCrLf &
        "Dim d1: Dim d2" & vbCrLf &
        "If zj_fz <> " & Chr(34) & Chr(34) & " Then d1 = strlen(zj_fz) / 2 Else d1 = 0" & vbCrLf &
        "If d1 <1 Then d1= 1" & vbCrLf &
        "If zj_fm <> " & Chr(34) & Chr(34) & " Then d2 = strlen(zj_fm) / 2 Else d1 = 0 " & vbCrLf &
        "If d2 <1 Then d2= 1" & vbCrLf &
        "If d2 > d1 Then d1 = d2" & vbCrLf &
        "If zj_fz <>" & Chr(34) & Chr(34) & " AND  zj_fm <>" & Chr(34) & Chr(34) & " AND zj_qb <>" & Chr(34) & Chr(34) & " AND  MJ <>" & Chr(34) & Chr(34) & " THEN " & vbCrLf &
             "myFind = " & Chr(34) & FZ_ZTCO & Chr(34) & " & zj_fz & " & Chr(34) & ZTCO & Chr(34) & " & vbnewline &" & Chr(34) & QB_ZTCO & Chr(34) & "& zj_qb &" & Chr(34) & ZTCO & Chr(34) & "& " & Chr(34) & x_lian1 & Chr(34) & " &  String(d1," & Chr(34) & "—" & Chr(34) & ") & " & Chr(34) & x_lian2 & Chr(34) & "&" & Chr(34) & HB_ZTCO & Chr(34) & " & zj_hb & " & Chr(34) & ZTCO & Chr(34) & " & vbnewline & " & Chr(34) & FM_ZTCO & Chr(34) & " & zj_fm & " & Chr(34) & ZTCO & Chr(34) & vbCrLf &
        "END IF" & vbCrLf &
        "If zj_fz<>" & Chr(34) & Chr(34) & " AND  zj_fm <>" & Chr(34) & Chr(34) & " AND tdxz =" & Chr(34) & Chr(34) & " AND  MJ<>" & Chr(34) & Chr(34) & " THEN " & vbCrLf &
             "myFind =" & Chr(34) & FZ_ZTCO & Chr(34) & " & zj_fz & " & Chr(34) & ZTCO & Chr(34) & " & vbnewline & " & Chr(34) & x_lian1 & Chr(34) & " &  String(d1," & Chr(34) & "—" & Chr(34) & ") & " & Chr(34) & x_lian2 & Chr(34) & "& " & Chr(34) & HB_ZTCO & Chr(34) & " & zj_hb & " & Chr(34) & ZTCO & Chr(34) & " & vbnewline &" & Chr(34) & FM_ZTCO & Chr(34) & "& zj_fm & " & Chr(34) & ZTCO & Chr(34) & vbCrLf &
        "END IF" & vbCrLf &
        "If zj_fz<>" & Chr(34) & Chr(34) & " AND  zj_fm <>" & Chr(34) & Chr(34) & " AND tdxz <>" & Chr(34) & Chr(34) & " AND  MJ=" & Chr(34) & Chr(34) & " THEN " & vbCrLf &
             "myFind = " & Chr(34) & FZ_ZTCO & Chr(34) & " & zj_fz & " & Chr(34) & ZTCO & Chr(34) & " & vbnewline & " & Chr(34) & QB_ZTCO & Chr(34) & " & zj_qb & " & Chr(34) & ZTCO & Chr(34) & "&" & Chr(34) & x_lian1 & Chr(34) & " &  String(d1," & Chr(34) & "—" & Chr(34) & ") & " & Chr(34) & x_lian2 & Chr(34) & " &  vbnewline &" & Chr(34) & FM_ZTCO & Chr(34) & "&  zj_fm & " & Chr(34) & ZTCO & Chr(34) & vbCrLf &
        "END IF" & vbCrLf &
        "End Function"
        theLabelClass.Expression = code
        'Exit Sub'
        '应用标注设置
        lyrDefn.LabelClasses(0) = theLabelClass  '假设只有一个标注类别
        '应用标注
        Await QueuedTask.Run(Sub()
                                 FeatureLayer.SetDefinition(lyrDefn)
                                 '打开标注
                                 If FeatureLayer.IsLabelVisible = False Then
                                     FeatureLayer.SetLabelVisibility(True)
                                 End If
                             End Sub)
举报

相关推荐

【word密码】Word 文档设置了只读为什么还能编辑？

echarts前端javascript

为什么，word文件在只读模式下，仍然能编辑？

wordwindowsmicrosoft经验分享

WTForms设置表单不可编辑（只读）

WTFormsflask

Python 设置word编辑限制 或解除word编辑限制

WordPython类对象后端开发yyds干货盘点

【解疑】为什么PPT文件变成了“只读”？

wpfc#

[word] word文件显示只读怎么解决

另存为右键文件名深度学习人工智能

WebOffice在VUE/Electron网页在线编辑Office之用只读方式打开Word文档

科技网络

PGSQL设置数据库只读,表空间只读

数据库javasql用户登录创建用户HarmonyOS后端开发

word文件不能编辑是什么原因

经验分享安全网络协议pythoneclipse

设置checkbox为只读（readOnly）

javascriptViewUI3cjqueryRedis数据库
0 条评论