树櫴希德大神的展点源码，高程点小数点位数想设置为3位，改了不对

寒潮大冬瓜

cjf160204 发表于 2024-7-31 22:52
;cass中一键展高程与测点(注记分开)
(defun c:zd()
  (vl-load-com) ;将 Visual LISP 扩展功能加载到 A ...

大侠的代码很好→很棒！很好~很棒！！很好……很棒！！！
能不能优化一下高程(标高)的圆标记改为三角形的？

;属性块形式的标高标注程序！
;http://bbs.mjtd.com/forum.php?mo ... &fromuid=418631
;(出处: 明经CAD社区)
这个网页的三角形高程(标高)点，可惜没有大侠的这个方便。

寒潮大冬瓜

gzxl 发表于 2024-7-15 15:14
没点改进，全都是搬来搬去。那是 CASS几的高程点？CASS11 的高程点分散看看。
虽然是小问题。贴一个 arx， ...

能不能优化一下高程(标高)的圆标记改为三角形的？

;属性块形式的标高标注程序！
;http://bbs.mjtd.com/forum.php?mo ... &fromuid=418631
;(出处: 明经CAD社区)
这个网页的三角形高程(标高)点，可惜没有大侠的这个方便。

寒潮大冬瓜

cass通用升级版CGC圆圈高程(标高Gu_xl)点CFC三角形高程(标高77077)点创建
http://bbs.mjtd.com/forum.php?mo ... &fromuid=418631
(出处: 明经CAD社区)

cjf160204

(defun c:zd ()
  (vl-load-com) ; 加载 Visual LISP 扩展功能
  (regapp "SOUTH")
  (regapp "NAME")
  (regapp "CODE")
  (regapp "TIME")
  (setq TIME (list "TIME" (cons 1000 (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD-HH:MM:SS)"))))
  (setq osm (getvar "osmode")) ; 保存当前捕捉模式
  (setvar "osmode" 0) ; 设置为无捕捉模式
  (vl-cmdf ".undo" "be") ; 开始撤销标记
  (setq blc (getint "\n请输入比例尺1:"))
  (setvar 'userr1 blc) ; 设置比例尺
  (setq zg (* 0.002 blc)) ; 字高
  (setq scale (* 0.001 blc)) ; 缩放比例
  (setq xswsa 3) ; 固定高程小数位数为3

  (setq ff (open (getfiled "请选择要展点的数据文件" "" "dat" 2) "r")) ; 打开数据文件
  (while (setq zb (read-line ff))
    (while (vl-string-search "," zb) (setq zb (vl-string-subst " " "," zb))) ; 用空格替换逗号
    (setq zb (read (strcat "(" zb ")"))
          id (nth 0 zb)
    )
    (if (= (length zb) 5)
        (setq zpt (list (nth 2 zb) (nth 3 zb) (nth 4 zb))) ; 高程与点号的插入点
        (setq zpt (list (nth 1 zb) (nth 2 zb) (nth 3 zb)))
    )
    (setq p2 (polar zpt (* 0.25 pi) (* 1.5 zg))) ; 点号注记的插入点
    (entmake (list '(0 . "POINT") (cons 10 zpt) '(8 . "ZDH")
                   (list -3 (list "NAME" (cons 1000 (vl-princ-to-string (nth 0 zb))))
                         (list "CODE" (cons 1000 (vl-princ-to-string (nth 1 zb)))) TIME
                   )
              )
    )
    (entmake (list '(0 . "TEXT") (cons 1 (vl-princ-to-string id)) (cons 10 p2) '(7 . "HZ") '(8 . "ZDH") (cons 40 zg) '(41 . 0.8))) ; 点号注记
    (gxl-cs:gcd zpt (caddr zpt) scale 2 (list "NAME" (cons 1000 (vl-princ-to-string (nth 0 zb)))
                                              (cons 1000 (vl-princ-to-string (nth 1 zb)))
                                              )
               ) ; 展高程点
  )
  (close ff)
  (command "undo" "e") ; 结束撤销标记
  (setvar "osmode" osm) ; 恢复原来的捕捉模式
  (princ "展点完成")
  (princ)
)

(defun gxl-cs:gcd (inspt height scale xsws name / pt blkdef obj)
  (setvar "CMDECHO" 0)
  (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" "" "")
  (if height
      (setq height (rtos height 2 xswsa)) ; 格式化高程值为3位小数
      (setq height "")
  )
  (regapp "SOUTH")
  
  ; 检查字体 "HZ" 是否存在
  (if (not (tblobjname "style" "HZ"))
      (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  )
  
  ; 检查是否存在高程点图块定义
  (if (not (tblobjname "block" "GC200"))
      (progn
        (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
        (setq obj
              (vla-AddPolyline
               blkdef
               (vlax-make-variant
                (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbdouble (cons 0 5))
                 '(-0.2 0 0 0.2 0 0)
                 )
                )
              )
        )
        (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
        (vla-put-Closed obj :vlax-true)
        (vla-put-ConstantWidth obj 0.4)
      )
  )
  
  ; 插入块
  (entmake (list
             '(0 . "INSERT")
             '(100 . "AcDbEntity")
             '(100 . "AcDbBlockReference")
             '(66 . 1) ; 属性跟随标志,1跟随，0不跟随
             (cons 2 "GC200")
             (cons 10 inspt)
             (cons 41 scale)
             (cons 42 scale)
             (cons 43 scale)
             (list -3 '("SOUTH" (1000 . "202101")) NAME TIME)
            )
  )
  
  ; 插入属性
  (entmake (list
             '(0 . "ATTRIB")
             '(100 . "AcDbEntity")
             '(100 . "AcDbText")
             (cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
             (cons 40 (* 2.0 scale))
             (cons 50 0)
             (cons 41 0.8)
             (cons 51 0)
             (cons 1 height)
             (cons 7 "HZ")
             (cons 72 0)
             (cons 11 pt)
             '(100 . "AcDbAttribute")
             (cons 2 "height")
             (cons 70 0)
             (cons 74 2)
            )
  )
  
  ; 结束标志
  (entmake '((0 . "SEQEND")))
  (princ)
)

cjf160204

高程三位小数

cjf160204

(defun c:zd ()
  (vl-load-com)
  (regapp "SOUTH")
  (regapp "NAME")
  (regapp "CODE")
  (regapp "TIME")
  (setq TIME (list "TIME" (cons 1000 (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD-HH:MM:SS)"))))
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (vl-cmdf ".undo" "be")
  (setq blc (getint "\n请输入比例尺1: (默认值500) "))
  (setq blc (if blc blc 500))
  (setvar 'userr1 blc)
  (setq zg (* 0.002 blc))
  (setq scale (* 0.001 blc))
  (setq xswsa 3)
  (setq ff (open (getfiled "请选择要展点的数据文件" "" "dat" 2) "r"))
  (while (setq zb (read-line ff))
    (while (vl-string-search "," zb) (setq zb (vl-string-subst " " "," zb)))
    (setq zb (read (strcat "(" zb ")"))
          id (nth 0 zb)
    )
    (if (= (length zb) 5)
        (setq zpt (list (nth 2 zb) (nth 3 zb) (nth 4 zb)))
        (setq zpt (list (nth 1 zb) (nth 2 zb) (nth 3 zb)))
    )
    (setq p2 (polar zpt (* 0.25 pi) (* 1.5 zg)))
    (entmake (list '(0 . "POINT") (cons 10 zpt) '(8 . "ZDH")
                   (list -3 (list "NAME" (cons 1000 (vl-princ-to-string (nth 0 zb))))
                         (list "CODE" (cons 1000 (vl-princ-to-string (nth 1 zb)))) TIME
                   )
              )
    )
    (entmake (list '(0 . "TEXT") (cons 1 (vl-princ-to-string id)) (cons 10 p2) '(7 . "HZ") '(8 . "ZDH") (cons 40 zg) '(41 . 0.8)))
    (gxl-cs:gcd zpt (caddr zpt) scale 2 (list "NAME" (cons 1000 (vl-princ-to-string (nth 0 zb)))
                                              (cons 1000 (vl-princ-to-string (nth 1 zb)))
                                              )
               )
  )
  (close ff)
  (command "undo" "e")
  (setvar "osmode" osm)
  (princ "展点完成")
  (princ)
)

(defun gxl-cs:gcd (inspt height scale xsws name / pt blkdef obj)
  (setvar "CMDECHO" 0)
  (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" "" "")
  (if height
      (setq height (rtos height 2 xswsa))
      (setq height "")
  )
  (regapp "SOUTH")
  (if (not (tblobjname "style" "HZ"))
      (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  )
  (if (not (tblobjname "block" "GC200"))
      (progn
        (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
        (setq obj
              (vla-AddPolyline
               blkdef
               (vlax-make-variant
                (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbdouble (cons 0 5))
                 '(-0.2 0 0 0.2 0 0)
                 )
                )
              )
        )
        (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
        (vla-put-Closed obj :vlax-true)
        (vla-put-ConstantWidth obj 0.4)
      )
  )
  (entmake (list
             '(0 . "INSERT")
             '(100 . "AcDbEntity")
             '(100 . "AcDbBlockReference")
             '(66 . 1)
             (cons 2 "GC200")
             (cons 10 inspt)
             (cons 41 scale)
             (cons 42 scale)
             (cons 43 scale)
             (list -3 '("SOUTH" (1000 . "202101")) NAME TIME)
            )
  )
  (entmake (list
             '(0 . "ATTRIB")
             '(100 . "AcDbEntity")
             '(100 . "AcDbText")
             (cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
             (cons 40 (* 2.0 scale))
             (cons 50 0)
             (cons 41 0.8)
             (cons 51 0)
             (cons 1 height)
             (cons 7 "HZ")
             (cons 72 0)
             (cons 11 pt)
             '(100 . "AcDbAttribute")
             (cons 2 "height")
             (cons 70 0)
             (cons 74 2)
            )
  )
  (entmake '((0 . "SEQEND")))
  (princ)
)