简码成图功能 - AutoCAD工具插件 - AutoCAD论坛 - 明经CAD社区 - 第2页

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))
               (setqSTR 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))
      (setqSTR 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 z0))
      (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")
)
)

煮茗发表于 2024-12-5 10:57:31

本帖最后由煮茗于 2024-12-5 10:59 编辑

cjf160204 发表于 2024-6-27 14:41
(defun entmake-dzw (blockname point color layer attributes)
; 这里只是一个简单的占位，您需要根 ...

原代码补全了函数也无法运行。花时间修改补全了一下。穷，所以收点币。

此插件作用就是读取测绘数据文件中的编号、代码、坐标数据，自动插入与代码相匹配的块。

2024.12.05 修改说明：补全绘制块的函数entmake-dzw，修改部分有误语句以保证可运行；修改原代码中重复的或条件语句，修改后增强适用性；增加捕捉修改，避免运行过程中绘图定位不准；增加错误退出捕捉归位；增加命令编组以便后悔操作；原GXYZ图层修改为0层。

附：
测绘数据文件说明：
是以逗号分隔的数据文本文件，按5列保存，系列分别为：编号、代码、Y、X、Z。
例如：

1DD320.51371.03818
2DF326.052101.88819
3DLZ289.708107.28418
4DJ318.28991.22116
5XF307.385104.78414
6DJ298.90681.10816

kugoo999 发表于 2024-12-5 11:45:13

这种广告不要发上来吧，程序又不见

页: 1 [2]

明经CAD社区's Archiver