学习心得－统一修改标高值

xiguao

请老大提修改意见
<CommandMethod("cxb_bg")> Public Sub cxb_bg()
        '统一修改标高值
        Dim acDbobject As DBObject
        Dim acText As DBText
        Dim acValue As Double
        Dim acPromptEntityOptions As PromptEditorOptions = New PromptEntityOptions(vbLf & "选择将改变数值以层为标准的标准文字:")
        Dim acPromptEntityResult As PromptEntityResult = acDocEd.GetEntity(acPromptEntityOptions)
        If acPromptEntityResult.Status = PromptStatus.OK Then
            Using acTrans As Transaction = acdoc.TransactionManager.StartTransaction()
                acDbobject = acTrans.GetObject(acPromptEntityResult.ObjectId, OpenMode.ForRead)
                If TypeOf (acDbobject) Is DBText Then
                    acText = acDbobject
                Else
                    Exit Sub
                End If

                If acText.TextString Like "*#.##*" Then
                    '' 创建一个 TypedValue 数组，用于定义过滤条件    Create a TypedValue array to define the filter criteria
                    Dim acTypValAr(1) As TypedValue
                    acTypValAr.SetValue(New TypedValue(DxfCode.Start, "Text"), 0)
                    acTypValAr.SetValue(New TypedValue(DxfCode.LayerName, acText.Layer), 1)
                    '' 赋值过滤条件给 SelectionFilter 对象    Assign the filter criteria to a SelectionFilter object
                    Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
                    '' 要求在图形区域中选择对象    Request for objects to be selected in the drawing area
                    Dim acSSPrompt As PromptSelectionResult
                    acDocEd.WriteMessage(vbLf & "选择将改变数值的文字:")
                    acSSPrompt = acDocEd.GetSelection(acSelFtr)
                    '' 如果提示状态是 OK，对象就被选择了    If the prompt status is OK, objects were selected
                    If acSSPrompt.Status = PromptStatus.OK Then
                        Dim acSSet As SelectionSet = acSSPrompt.Value
                        Dim acPromptDoubleOptions As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "输入标高差值:")
                        Dim acPromptDoubleResult As PromptDoubleResult = acDocEd.GetDouble(acPromptDoubleOptions)
                        If Not IsDBNull(acPromptDoubleResult) Then
                            acValue = acPromptDoubleResult.Value
                        Else
                            Exit Sub
                        End If
                        '' 遍历选择集中的对象   Step through the objects in the selection set
                        For Each acSSObj As SelectedObject In acSSet
                            '' 检查以确定返回的 SelectedObject 对象是有效的     Check to make sure a valid SelectedObject object was returned
                            If Not IsDBNull(acSSObj) Then
                                '' 以写的方式打开选择的对象   Open the selected object for write
                                'Dim acEnt As Entity = acTrans.GetObject(acSSObj.ObjectId, OpenMode.ForWrite)
                                acText = acTrans.GetObject(acSSObj.ObjectId, OpenMode.ForWrite)
                                If Not IsDBNull(acText) Then

                                    acText.TextString = Format(Val(acText.TextString) + acValue, "0.00")
                                End If
                            End If

                        Next


                    End If
                End If
                acTrans.Commit()
            End Using

        End If
    End Sub

LIULISHENG

学习一下

寒潮大冬瓜

;;;BGTY获取高程块GC200属性(height值和Z值)为参照点高程值然后框选N个B点后计算高差值并逐个写入B高程块GC200属性(height值和Z值)中去当于是属性块的高程的属性更新高程刷。
(DEFUN C:BGTY ()        (BGTY2023)(princ))
(defun BGTY2023 (/ SS1A I EN0B EN1B ENT0B ENT1B PT0B STR1 SSB)
  (princ
    "BGTY获取高程块GC200属性(height值和Z值)为参照点高程值然后框选N个B点后计算高差值并逐个写入B高程块GC200属性(height值和Z值)中去当于是属性块的高程的属性更新高程刷QWQ"
  )
        (CMDLA0)
        (SETQ SS1A(entsel "\n选择高程基准参照点: "));获取所选图元A的端点10坐标xyz
        (SETQ laynamA10(cdr (assoc 10 (entget (car SS1A)))));获取所选图元A的端点10坐标xyz
        ;(SETQ STRXA10 (rtos (car laynamA10) 2 14)) ;_内容X
        (SETQ STRYA10 (rtos (cadr laynamA10) 2 14)) ;_内容Y
        ;(SETQ STRzA10 (rtos (caddr laynamA10) 2 14)) ;_内容z
        ;(SETQ pt1A10 (strcat STRxA10 "," STRyA10 "," STRZA10))
        (SETQ STRYA10 (atof STRYA10));转换成实数→基准点的参数值提取
        ;(SETQ PT0 (cdr (assoc 10 ENT0))) ;_插入点
        (SETQ STR1A (rtos (caddr laynamA10) 2 8)) ;_新内容小数点位数JD→改为8位默认
        (SETQ STR22A (atof STR1A))
        ;(princ STR22A)
        (SETQ zA STR22A);高程基准参照点初始值定义过程
        (if (not zA)(SETQ zA 0))
        (SETQ        selA(strcat "\nZ向归具体数值基准点<" (rtos zA 2 4) ">【直接回车将按照读取数值继续下一步操作】:"))
  (SETQ z1A (getreal selA))
  (if z1A(SETQ zA z1A))
        (SETQ STR22A zA)
        (princ STR22A);高程基准参照点初始值定义过程
       
        (princ "\n请单选或框选要更新的高程点")(princ (lsp20230908))
       
        ;(SETQ zAA (getreal "\n请输入标注计算比例因子:"));20240313213425
       
        (graphscr);20240313213449
  (if (not z99)
    (SETQ z99 1)
  )
  (SETQ        sel99
         (strcat
           "\n输入具体指定数值<"
           (rtos z99 2 16)
           ">【直接回车将读取上次输入的文字数值】:"
         )
  )
  (SETQ z199 (getreal sel99))
  (if z199
    (SETQ z99 z199)
  );20240313213437
       
        ;(SETQ zAA(getreal selABA))
        ;(if (not zAA)(SETQ zAA 1))
        ;(SETQ        selAA(strcat "\n设定高程点Z值之间度量计算比值<" (rtos zAA 2 4) ">【直接回车将按照读取数值继续下一步操作】:"))
        ;(SETQ        ZAA(strcat "\n设定高程点Z值之间度量计算比值<" (rtos zAA 2 4) ">【直接回车将按照读取数值继续下一步操作】:"))
        ;(SETQ zAA(getreal "\n设定高程点Z值之间度量计算比值<0.001>: "))
        ;(SETQ selAaA(atof ZAA))
        ;(SETQ ZAA(* 1 ZAA))
       
           ;(SETQ ZABL2023(* 0.001 (getvar "dimscale")))
     ;(SETQ        ZABL2023(getreal (strcat "\n请输入标注计算比例因子:<" (rtos ZABL2023 2 14) ">")))
           ;(SETQ ZABL2023(atof ZABL2023))
       
  ;(SETQ ZAA(getreal "\nn请输入标注计算比例因子<0.001>: "));getint
        ;(SETQ        ZAA(getreal (strcat "\n请输入标注计算比例因子:<" (rtos 0.001 2 14) ">")))
       
       
        (if (SETQ  SSB (ssget '((0 . "insert") (2 . "*")))) ;框选B或批量高程点
                ;(if (SETQ SSB (ssget '()))                ;拾取N个高程点
                (progn
                        (repeat (SETQ i (sslength SSB))
                                (SETQ EN0B  (ssname SSB (SETQ i (1- i)))
                                        ENT0B (entget EN0B)
                                        EN1B  (entnext EN0B)
                                        ENT1B (entget EN1B)
                                )
                                (SETQ PT0B (cdr (assoc 10 ENT0B))) ;_插入点
                                (SETQ STRXB10 (rtos (car PT0B) 2 14)) ;_内容X
                                (SETQ STRYB10 (rtos (cadr PT0B) 2 14)) ;_内容Y
                                (SETQ STRYB10B (atof STRYB10));实数
                                (SETQ STRZB10 (rtos (caddr PT0B) 2 14)) ;_内容Z
                                ;(SETQ STRZB10B (atof STRZB10));实数
                                ;(SETQ str22AB(+ STR22A (* (- STRYB10B STRYA10) 0.001)));度量计算比值*(指定参数基准点+(计算点y值-基准点y值))
                                (SETQ str22ABB(- STRYB10B STRYA10))
                                ;(SETQ str22AABB(* str22ABB 0.001))
                                (SETQ str22AABB(* str22ABB z99));用计算比值乘上Y轴方向的计算差值
                                ;(SETQ str22AABB(* str22ABB ZAA));用计算比值乘上Y轴方向的计算差值
                                (SETQ str22AB(+ STR22A str22AABB));度量计算比值*(指定参数基准点+(计算点y值-基准点y值))
                                (SETQ STR31B (rtos str22AB 2 4)) ;_新内容小数点位数JD→改为8位默认
                                ;(terpri)
                                ;(princ STR31B)
                                (entmod (subst (cons 1 STR31B) (assoc 1 ENT1B) ENT1B))
                                (entupd EN0B) ;_更新
                                (SETQ z str22AB);赋值给z
                                ;(SETQ z STR31B);赋值给z
                                (SETQ b10 (assoc 10 ENT0B))
                                (SETQ x10 (cadr b10))
                                (SETQ y10 (caddr b10))
                                (SETQ b101 (cons 10 (list x10 y10 z)))
                                (SETQ ENT0B (subst b101 b10 ENT0B))
                                (entmod ENT0B);_更新
                       
                                ;(princ "\n请选择要设置height值和Z值的实体")(princ (lsp20230908))
                        )
                        (princ "成功更新高程点Z值于")(princ(lsp20230908))
                )
        )
        (cmdla1)
        (princ)
)
;(SETQ   STR22 (atof  STR1));
;实数(itoa i)与(rtos z1 2 6)同效
;(command "._copy" "p" "" "M");上次的选择集

寒潮大冬瓜

;;;------------------------ CMDLA0 -------------------------
;;; CMDLA0保存用户系统变量CMDLA1恢复用户系统变量(恢复世界坐标系统)
;;;方式 : (CMDLA0)
;抄袭自明经[讨论] 【e派】工具箱函数再揭秘及应用实例公布大量代码源码，发表于 2012-7-21 01:18 由此估计院长新时期的代码中xyp-start应该就是这个自定义函数
;;; 保存原有系统变量，设置程序运行时的系统变量
(Defun cmdla0 ()
  (SETQ        cmdech202404 (Getvar "Cmdecho");设置回显提示和输入
                oom202404    (Getvar "Orthomode");设置正交模式
                osm202404    (Getvar "Osmode");设置捕捉模式
                la202404     (Getvar "Clayer");设置当前层
                rmode202404  (getvar "regenmode")
                pw202404     (getvar "plinewid")
  )
        ;(if (null sc)
        ;        (SETBL);xyp-SetBL 设置出图比例 (xyp-SetBL)目前还没有院长发布的这个自定义函数，还期待已经收集了的大侠分享一下
        ;) ;确认SC存在
        (setvar "DIMZIN" 1);设置DIMZIN的值为1，否则小数末尾为0会被抹掉(断点)
  (Setvar "Cmdecho" 0);控制在 AutoLISP命令函数运行时是否回显提示和输入。
  (Setvar "Regenmode" 0);控制图形的自动重生成
        (command "ucs" "") ;恢复世界坐标系统
        (setvar "plinewid" 0) ;多义线宽→0
        (princ)
)
;;;------------------------ CMDLA1 -------------------------
;;; 恢复用户系统变量
;;;方式 : (CMDLA1)
;;; 恢复原有系统变量
(Defun cmdla1 ();(/ cmdech202404 LA202404 oom202404 osm202404)
  (Setvar "Cmdecho" cmdech202404)
  (Setvar "Clayer" LA202404)
  (Setvar "Orthomode" oom202404)
  (Setvar "Osmode" osm202404)
        (setvar "plinewid" pw202404)
  (setvar "regenmode" 1)
  (Terpri)
  (Princ)
)