简码成图功能

y854271613 · 发表于 2024-6-26 20:58:44

弥勒发表于 2024-5-30 14:33
用于绘制地形图时，用GPS测一个井位坐标，给一个代码，绘制时自动绘制 .例：1，DJ, Y , X , Z
;;; 功能 ...

str-th这个函数是不是转换逗号砖空格的

弥勒 · 发表于 2024-6-27 09:35:51

y854271613 发表于 2024-6-26 20:58
str-th这个函数是不是转换逗号砖空格的

;<5> 定义函数：替换字符串
; 参数说明： str---欲替换的字符串
;          lst---分割符表，参数类型：表
; 返回值：替换后的字符串
; 类  型：字符串
; 示  例：(str-th "<HTML>" '(("<" "a") (">" "b")))
; 返  回："aHTMLb"

|;
(defun STR-TH (STR LST / I A B LEN-A TMP J STRJ)
  (if (and STR LST)
   (progn
         (setq I 0)
         (repeat (length LST)
                  (setq A    (car (nth I LST)))
                  (setq LEN-A (strlen A))
                  (setq B    (cadr (nth I LST)))
                  (setq TMP "")

                  (if (>= (strlen STR) LEN-A)
                     (progn
                           (setq J 1)
                           (repeat (- (strlen STR) LEN-A -1)
                                 (setq STRJ (substr STR J 1 ) )
                                 (if (= STRJ A)
                                       (setq TMP (strcat TMP B) )
                                       (setq TMP (strcat TMP STRJ))
                                    )
                                 (setq J (1+ J))
                           )
                     )
                  )

               (setq I (1+ I))
               (setq  STR TMP)

         )
      )
) ;_结束 if
  STR
) ;_ 结束defun

cjf160204 · 发表于 2024-6-27 14:41:50

弥勒发表于 2024-6-27 09:35
; 定义函数：替换字符串
; 参数说明： str---欲替换的字符串
; lst---分割符表，参数类型 ...

(defun entmake-dzw (blockname point color layer attributes)
  ; 这里只是一个简单的占位，您需要根据实际功能来实现此函数
  (princ (strcat "Called entmake-dzw with: " blockname " " (vl-princ-to-string point) " " color " " layer " " (vl-princ-to-string attributes)))
)

;;; 功能：根据输入的地物代码和坐标绘制独立地物，并通过命令栏执行
;;; 日期：2024 年 6 月 27 日

(vl-load-com)

;; 定义 str-th 函数
(defun str-th (STR LST / I A B LEN-A TMP J STRJ)
  (if (and STR LST)
   (progn
      (setq I 0)
      (repeat (length LST)
      (setq A    (car (nth I LST)))
      (setq LEN-A (strlen A))
      (setq B    (cadr (nth I LST)))
      (setq TMP "")

      (if (>= (strlen STR) LEN-A)
         (progn
            (setq J 1)
            (repeat (- (strlen STR) LEN-A -1)
            (setq STRJ (substr STR J 1 ) )
            (if (= STRJ A)
               (setq TMP (strcat TMP B) )
               (setq TMP (strcat TMP STRJ))
            )
            (setq J (1+ J))
            )
         )
      )

      (setq I (1+ I))
      (setq  STR TMP)

      )
   )
) ;_结束 if
  STR
) ;_ 结束 defun str-th

(defun C:ZH ( / FILE i zn MN moden IN XN YN F1 STR str1 LST zdm)
  (setvar "cmdecho" 0)
  (setq mode (getstring "\n 默认标准 CASS 展点格式：非标准[排序（切换大写，例：IYXZM）编号(I),X 值(X),Y 值(Y),Z 值(Z),DM(M)]:"))
  (setq zdm (getstring "\n 帅哥是否需要展绘符号：[不展绘输入：1 ，展绘直接回车]"))
  (if (or (= zdm nil) (= zdm ""))
   (setq zdm "")
  )
  ;(princ "\n 读取全站仪文件数据，绘制点位。")
  (setq FILE (getfiled "选择.dat.txt 文件" "" "dat;txt" 4))
  (if (or (= mode nil) (= mode ""))
   (setq mode "IMYXZ")
  )
  (setq i 1)
  (setq zn "")
  (setq MN "")
  (setq moden (strlen mode))
  (while ( <= i moden)
(cond ((= (substr mode i 1) "I")  (setq IN (- i 1)))
      ((= (substr mode i 1) "X")  (setq XN (- i 1)))
      ((= (substr mode i 1) "Y")  (setq YN (- i 1)))
      ((= (substr mode i 1) "Z")  (setq ZN (- i 1)))
      ((= (substr mode i 1) "M")  (setq MN (- i 1)))
)
(setq i ( + i 1))
  ) ; while

  ;; 以读模式打开文件
  (setq F1 (open FILE "r"))
  ;; 逐行读取并处理
  (while (setq STR (read-line F1))
(setq str1 (str-th STR '(("," " "))))
(setq LST (read (strcat "(" STR1 ")")))
(if (>= (length LST) moden)
      (progn
      (setq id (nth IN LST))
      (setq x  (nth XN LST))
      (setq y  (nth YN LST))
      (if (/= ZN "") (setq z  (nth ZN LST)) (setq z  0))
      (if (/= MN "") (setq dm (nth MN LST)))
      (setq pt (list y x z))

      (draw-independent-feature dm x y) ; 调用绘制独立地物的函数

      )
   (princ (strcat "\n 数据不完整: " str1))
)
  ) ;_ 结束 while

  ;; 关闭文件
  (close F1)
  (princ)
) ;_ 结束 defun

(defun draw-independent-feature (feature-code x y / found-block)
  "根据特征码和坐标绘制独立地物"
  (setq found-block nil) ; 初始化是否找到匹配块的标志为否
  (foreach pair *feature-table*
(if (and (/= zdm "1")
         (or (equal (vl-princ-to-string feature-code) (cdr pair))
               (equal (vl-princ-to-string feature-code) (car pair))))
      (progn
      (setq found-block t) ; 找到匹配，设置标志为真
      (entmake-dzw (cdr pair) (list y x) 2 "GXYZ" '((-3 ("SOUTH" (1000. "175101")))))
      (princ (strcat "绘制 " (cdr pair) " 成功。"))
      (return) ; 找到并绘制后直接返回
      )
)
  )
  (if (not found-block) ; 如果没有找到匹配
(princ (strcat "\n 未找到与 " (vl-princ-to-string feature-code) " 对应的地物代码，无法绘制。"))
  )
)

(setq *feature-table*
  '(( "YJ" "gc053")
( "6" "gc053")
( "WJ" "gc043")
( "5" "gc043")
( "XJ" "gc048")
( "8" "gc048")
( "SJ" "gc042")
( "4" "gc042")
( "ZSJ" "gc042")
( "XF" "gc133")
( "3" "gc133")
( "DJ" "gc050")
( "1" "gc050")
( "RQ" "gc046")
( "7" "gc046")
( "RJ" "gc047")
( "2" "gc047")
( "DX" "gc129")
( "9" "gc129")
( "BZ" "gc041")
( "WM" "gc188")
( "SLT" "gc135")
( "DLZ" "gc234")
( "DF" "gc110")
( "ZSD" "gc019")
( "SD" "gc097")
( "HD" "gc037")
( "DD" "gc203")
( "LB" "gc052")
( "TT" "gc063")
( "HLD" "gc076")
( "GLZ" "gc038")
( "DS" "gc143")
( "GS" "gc145")
( "SS" "gc144")
( "X" "gc107")
( "QG" "gc098")
( "KG" "gcbj0117")
( "JJ" "gc146")
  )
)

账号		自动登录	找回密码
密码			注册