根据测绘坐标数据展绘块

煮茗

;;; 功能：根据测绘数据文件（代码描述及点坐标）在平面图上展绘块
;;; 日期：2024 年 12 月 9 日
;;; 主要代码来源于论坛，感谢各前辈大佬。


能展绘的前提是：1，已经有相应名称的块，已加载到文件中或存放在“支持文件搜索路径”下。2，测绘数据文件满足要求（看本文最后）。

以下是全部代码。愿意打赏的可以到附件下载。感谢大家！

2. ;;; 功能：根据测绘数据文件（坐标）在平面图上展绘块
   
3. ;;; 日期：2024 年 12 月 9 日
   
4. ;;; 主要代码来源于论坛，感谢各前辈大佬
   
5. 
   
6. (vl-load-com)
   
7. 
   
8. (defun slice-list (lst start end / len sliced result i)  ; 定义一个函数，用于切片列表
   
9.   (setq len (length lst)) ; 获取列表长度
   
10.   (setq sliced nil) ; 初始化切片列表
    
11.   (setq result nil) ; 初始化结果列表
    
12.   ; 处理负索引和 end 为 nil 的情况
    
13.   (if (< start 0)  ; 如果开始索引为负数，转换为正索引
    
14.     (setq start (+ len start))
    
15.   )
    
16. 
    
17.   (if (null end)  ; 如果结束索引为 nil，设置为列表长度
    
18.     (setq end len)
    
19.   )
    
20.   (if (< end 0)  ; 如果结束索引为负数，转换为正索引
    
21.     (setq end (+ len end))
    
22.   )
    
23.   (if (and (listp lst) (numberp start) (numberp end) (<= start end))  ; 检查参数类型和范围
    
24.     (progn  ; 如果参数有效，则进行切片操作
    
25.       (setq sliced lst) ; 复制原列表到切片列表
    
26.       (setq i 0) ; 初始化计数器
    
27.       (repeat start  ; 使用 repeat 和 cdr 模仿 nthcdr 功能
    
28.         (setq sliced (cdr sliced)) ; 逐步缩减切片列表以模拟 nthcdr
    
29.       )
    
30.       (setq i start) ; 设置 i 为开始索引
    
31.       (while (and sliced (> end i))  ; 遍历列表并构建切片
    
32.         (setq result (cons (car sliced) result)) ; 将当前元素添加到结果列表
    
33.         (setq sliced (cdr sliced)) ; 指向下一个元素
    
34.         (setq i (+ i 1)) ; 更新计数器
    
35.       )
    
36.       (reverse result) ; 反转结果列表以保持原始顺序
    
37.     )
    
38.     (alert "Invalid arguments for slicing.") ; 参数无效时的警告
    
39.   )
    
40. )
    
41. 
    
42. ;; 定义 str-th 函数
    
43. (defun str-th (STR LST / I A B LEN-A TMP J STRJ)
    
44.   (if (and STR LST)
    
45.       (progn
    
46.         (setq I 0)
    
47.         (repeat (length LST)
    
48.           (setq    A     (car (nth I LST)))
    
49.           (setq    LEN-A (strlen A))
    
50.           (setq    B     (cadr (nth I LST)))
    
51.           (setq    TMP   "")
    
52. 
    
53.           (if (>= (strlen STR) LEN-A)
    
54.             (progn
    
55.               (setq J 1)
    
56.               (repeat (- (strlen STR) LEN-A -1)
    
57.                 (setq STRJ (substr STR J 1 ) )
    
58.                 (if (= STRJ A)
    
59.                   (setq TMP (strcat TMP B) )
    
60.                   (setq TMP (strcat TMP STRJ))
    
61.                 )
    
62.                 (setq J (1+ J))
    
63.               )
    
64.             )
    
65.           )
    
66. 
    
67.           (setq I   (1+ I))
    
68.           (setq  STR TMP)
    
69. 
    
70.         )
    
71.       )
    
72.     ) ;_结束 if
    
73.   STR
    
74. ) ;_ 结束 defun str-th
    
75. 
    
76. 
    
77. 
    
78. ; 函数: PARSE2
    
79. ; 功能: 解析一个字符串，根据给定的分隔符将其分割成一个子字符串列表。
    
80. ; 参数:
    
81. ;   STR - 要解析的原始字符串。
    
82. ;   DELIM - 用作分隔符的字符串，函数将根据此分隔符来分割 STR。
    
83. ; 局部变量:
    
84. ;   LST - 存储分割后的子字符串列表。
    
85. ;   POS - 分隔符在字符串中的位置。
    
86. ; 返回值: 一个列表，包含按照分隔符分割的所有子字符串。
    
87. ; 注意: 如果分隔符在字符串的末尾，那么最后一个子字符串将是一个空字符串。
    
88. ;       如果分隔符不在字符串中，则返回包含原始字符串的单个元素列表。
    
89. ; 示例: (PARSE2 "one,two,three" ",") 返回 ("one" "two" "three")
    
90. (DEFUN PARSE2 (STR DELIM / LST POS)
    
91.   ; 初始化变量LST和POS
    
92.   (while (and (setq POS (VL-STRING-SEARCH DELIM STR)))
    
93.     ; 将DELIM之前的子字符串添加到列表LST中，然后更新STR
    
94.     (setq LST (APPEND LST (LIST (SUBSTR STR 1 POS))))
    
95.     (setq STR (SUBSTR STR (+ 2 POS)))
    
96.   )
    
97.   ; 如果STR长度大于0，则将STR添加到LST中，否则返回LST
    
98.   (if (> (STRLEN STR) 0)
    
99.     (PROGN (APPEND LST (LIST STR)))
    
100.     (PROGN LST)
     
101.   )
     
102. )
     
103. 
     
104. 
     
105. (defun entmake-dzw(km pt co la bm / data);插块 改颜色图层编码
     
106.     (command-s "_.insert" km "x" KBL "y" KBL "z" KBL "non" pt "") ;块比例
     
107.     (command-s "chprop" (entlast)"" "c" co "la" la "")
     
108.     (setq data(entget (entlast)))
     
109.     (setq data(append data bm))
     
110.     ;(entmod data)
     
111.   )
     
112. 
     
113. (defun C:ZH ( / FILE i zn MN moden IN XN YN F1 STR str1 LST zdm)
     
114.   (setvar "cmdecho" 0)
     
115.   (setq oldom (getvar "osmode"))
     
116.   (setvar "osmode" 0)
     
117.   (setq LUJING1 "C:\\Users\") ; 设置路径1
     
118.     (setq LUJING2 "\\Desktop\") ; 设置路径2
     
119.     (setq yonghuming  (getvar "loginname")) ; 获取当前用户登录名
     
120.   (defun *error* (msg)
     
121.     (if oldom
     
122.       (setvar "OSMODE" oldom)
     
123.     ))
     
124.   (setq KBL (getreal "\n请设定展绘的块比例:<1>"));块比例设置
     
125.   (if (null KBL)(setq KBL 1))
     
126.   (setq mode (getstring "\n 请输入数据文件内数列排序格式：[（须大写）编号(I),X 值(X),Y 值(Y),Z 值(Z),DM(M)]默认<MIYXZ>:"))
     
127.   (setq FILE (getfiled "选择.dat.txt 文件" (strcat LUJING1 yonghuming LUJING2) "dat;txt" 8))
     
128.   (if (or (= mode nil) (= mode ""))
     
129.       (setq mode "MIYXZ")
     
130.   )
     
131.   (setq i 1)
     
132.   (setq zn "")
     
133.   (setq MN "")
     
134.   (setq moden (strlen mode))
     
135.   (while ( < i (+ moden 1))
     
136.    (cond ((= (substr mode i 1) "I")  (setq IN (- i 1)))
     
137.          ((= (substr mode i 1) "X")  (setq XN (- i 1)))
     
138.          ((= (substr mode i 1) "Y")  (setq YN (- i 1)))
     
139.          ((= (substr mode i 1) "Z")  (setq ZN (- i 1)))
     
140.          ((= (substr mode i 1) "M")  (setq MN (- i 1)))
     
141.     )
     
142.   
     
143.     (setq i ( + i 1))
     
144.   ) ; while
     
145. ;============================
     
146. ;定义命令编组开始
     
147.    (command "_.undo" "be")
     
148.   ;; 以读模式打开文件
     
149.   (setq F1 (open FILE "r"))
     
150.   (setq DNLST (list ""))
     
151.   (setq i 0)
     
152.   (setq j 0)
     
153.   (while (and (/= nil (setq S (READ-LINE F1))))
     
154.         (setq P (slice-list (PARSE2 S ",") -5 nil))
     
155.        ;;(setq P (get-last-three (PARSE2 S ",")))
     
156.               ;(setq P (LIST (NTH 2 P) (NTH 3 P) (NTH 4 P))) ; 创建坐标列表
     
157.         (setq dm (NTH MN P))
     
158.         (setq x0 (NTH XN P))
     
159.         (setq y0 (NTH YN P))
     
160.               ;(setq P (MAPCAR 'ATOF P)) ; 将字符串转换为浮点数
     
161.         (setq x (ATOF x0)) ; 将字符串转换为浮点数
     
162.         (setq y (ATOF y0)) ; 将字符串转换为浮点数
     
163.         
     
164.     ;(if (and (tblsearch "block" dm) ((= (vl-string-search (car pair) (vl-princ-to-string feature-code)) 0)))
     
165.     (if (tblsearch "block" dm)
     
166.         (progn
     
167.         (entmake-dzw dm (list y x) 2 "0" '((-3 ("SOUTH" (1000 . "175101")))))
     
168.         ;(princ (strcat "\n绘制 " dm " 成功。"))
     
169.         (setq j (+ j 1))
     
170.         )
     
171.         (progn
     
172.         ;(princ (strcat "\n\n未找到与【" dm "】相匹配的块，【" dm "】未能绘制成功。"))
     
173.         (setq DNLST (append DNLST (list "第" i "行：" dm "、")))
     
174.         )
     
175.     )
     
176.       (setq i (+ i 1))
     
177.             )
     
178.       
     
179. (princ (strcat "\n展绘完成。数据文件共" (vl-princ-to-string i) "行，导入" (vl-princ-to-string j) "个图元。"))
     
180. (princ (strcat "\n数据文件中：" (vl-princ-to-string DNLST) "等共计" (vl-princ-to-string (- i j)) "个图元未能绘制成功。"))
     
181. (princ (strcat "请查改数据文件或创建、导入相应名称的图块。\n"))
     
182.             (CLOSE F1) ; 关闭文件
     
183. ;==========================
     
184.    (COMMAND "_.UNDO" "E")
     
185. ;定义命令编组结束
     
186.   (setvar "osmode" oldom)
     
187.   (princ)
     
188. ) ;_ 结束 defun
     

;;; 功能：根据测绘数据文件（坐标）在平面图上展绘块<br /> ;;; 日期：2024 年 12 月 9 日<br /> ;;; 主要代码来源于论坛，感谢各前辈大佬<br /> <br /> (vl-load-com)<br /> <br /> (defun slice-list (lst start end / len sliced result i)  ; 定义一个函数，用于切片列表<br />   (setq len (length lst)) ; 获取列表长度<br />   (setq sliced nil) ; 初始化切片列表<br />   (setq result nil) ; 初始化结果列表<br />   ; 处理负索引和 end 为 nil 的情况<br />   (if (< start 0)  ; 如果开始索引为负数，转换为正索引<br />     (setq start (+ len start))<br />   )<br /> <br />   (if (null end)  ; 如果结束索引为 nil，设置为列表长度<br />     (setq end len)<br />   )<br />   (if (< end 0)  ; 如果结束索引为负数，转换为正索引<br />     (setq end (+ len end))<br />   )<br />   (if (and (listp lst) (numberp start) (numberp end) (<= start end))  ; 检查参数类型和范围<br />     (progn  ; 如果参数有效，则进行切片操作<br />       (setq sliced lst) ; 复制原列表到切片列表<br />       (setq i 0) ; 初始化计数器<br />       (repeat start  ; 使用 repeat 和 cdr 模仿 nthcdr 功能<br />         (setq sliced (cdr sliced)) ; 逐步缩减切片列表以模拟 nthcdr<br />       )<br />       (setq i start) ; 设置 i 为开始索引<br />       (while (and sliced (> end i))  ; 遍历列表并构建切片<br />         (setq result (cons (car sliced) result)) ; 将当前元素添加到结果列表<br />         (setq sliced (cdr sliced)) ; 指向下一个元素<br />         (setq i (+ i 1)) ; 更新计数器<br />       )<br />       (reverse result) ; 反转结果列表以保持原始顺序<br />     )<br />     (alert "Invalid arguments for slicing.") ; 参数无效时的警告<br />   )<br /> )<br /> <br /> ;; 定义 str-th 函数<br /> (defun str-th (STR LST / I A B LEN-A TMP J STRJ)<br />   (if (and STR LST)<br />       (progn<br />         (setq I 0)<br />         (repeat (length LST)<br />           (setq    A     (car (nth I LST)))<br />           (setq    LEN-A (strlen A))<br />           (setq    B     (cadr (nth I LST)))<br />           (setq    TMP   "")<br /> <br />           (if (>= (strlen STR) LEN-A)<br />             (progn<br />               (setq J 1)<br />               (repeat (- (strlen STR) LEN-A -1)<br />                 (setq STRJ (substr STR J 1 ) )<br />                 (if (= STRJ A)<br />                   (setq TMP (strcat TMP B) )<br />                   (setq TMP (strcat TMP STRJ))<br />                 )<br />                 (setq J (1+ J))<br />               )<br />             )<br />           )<br /> <br />           (setq I   (1+ I))<br />           (setq  STR TMP)<br /> <br />         )<br />       )<br />     ) ;_结束 if<br />   STR<br /> ) ;_ 结束 defun str-th<br /> <br /> <br /> <br /> ; 函数: PARSE2<br /> ; 功能: 解析一个字符串，根据给定的分隔符将其分割成一个子字符串列表。<br /> ; 参数:<br /> ;   STR - 要解析的原始字符串。<br /> ;   DELIM - 用作分隔符的字符串，函数将根据此分隔符来分割 STR。<br /> ; 局部变量:<br /> ;   LST - 存储分割后的子字符串列表。<br /> ;   POS - 分隔符在字符串中的位置。<br /> ; 返回值: 一个列表，包含按照分隔符分割的所有子字符串。<br /> ; 注意: 如果分隔符在字符串的末尾，那么最后一个子字符串将是一个空字符串。<br /> ;       如果分隔符不在字符串中，则返回包含原始字符串的单个元素列表。<br /> ; 示例: (PARSE2 "one,two,three" ",") 返回 ("one" "two" "three")<br /> (DEFUN PARSE2 (STR DELIM / LST POS)<br />   ; 初始化变量LST和POS<br />   (while (and (setq POS (VL-STRING-SEARCH DELIM STR)))<br />     ; 将DELIM之前的子字符串添加到列表LST中，然后更新STR<br />     (setq LST (APPEND LST (LIST (SUBSTR STR 1 POS))))<br />     (setq STR (SUBSTR STR (+ 2 POS)))<br />   )<br />   ; 如果STR长度大于0，则将STR添加到LST中，否则返回LST<br />   (if (> (STRLEN STR) 0)<br />     (PROGN (APPEND LST (LIST STR)))<br />     (PROGN LST)<br />   )<br /> )<br /> <br /> <br /> (defun entmake-dzw(km pt co la bm / data);插块 改颜色图层编码<br />     (command-s "_.insert" km "x" KBL "y" KBL "z" KBL "non" pt "") ;块比例<br />     (command-s "chprop" (entlast)"" "c" co "la" la "")<br />     (setq data(entget (entlast)))<br />     (setq data(append data bm))<br />     ;(entmod data)<br />   )<br /> <br /> (defun C:ZH ( / FILE i zn MN moden IN XN YN F1 STR str1 LST zdm)<br />   (setvar "cmdecho" 0)<br />   (setq oldom (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq LUJING1 "C:\\Users\") ; 设置路径1 <br />     (setq LUJING2 "\\Desktop\") ; 设置路径2<br />     (setq yonghuming  (getvar "loginname")) ; 获取当前用户登录名<br />   (defun *error* (msg)<br />     (if oldom<br />       (setvar "OSMODE" oldom)<br />     ))<br />   (setq KBL (getreal "\n请设定展绘的块比例:<1>"));块比例设置<br />   (if (null KBL)(setq KBL 1))<br />   (setq mode (getstring "\n 请输入数据文件内数列排序格式：[（须大写）编号(I),X 值(X),Y 值(Y),Z 值(Z),DM(M)]默认<MIYXZ>:"))<br />   (setq FILE (getfiled "选择.dat.txt 文件" (strcat LUJING1 yonghuming LUJING2) "dat;txt" 8))<br />   (if (or (= mode nil) (= mode ""))<br />       (setq mode "MIYXZ")<br />   )<br />   (setq i 1)<br />   (setq zn "")<br />   (setq MN "")<br />   (setq moden (strlen mode))<br />   (while ( < i (+ moden 1))<br />    (cond ((= (substr mode i 1) "I")  (setq IN (- i 1)))<br />          ((= (substr mode i 1) "X")  (setq XN (- i 1)))<br />          ((= (substr mode i 1) "Y")  (setq YN (- i 1)))<br />          ((= (substr mode i 1) "Z")  (setq ZN (- i 1)))<br />          ((= (substr mode i 1) "M")  (setq MN (- i 1)))<br />     )<br />   <br />     (setq i ( + i 1))<br />   ) ; while<br /> ;============================<br /> ;定义命令编组开始<br />    (command "_.undo" "be")<br />   ;; 以读模式打开文件<br />   (setq F1 (open FILE "r"))<br />   (setq DNLST (list ""))<br />   (setq i 0)<br />   (setq j 0)<br />   (while (and (/= nil (setq S (READ-LINE F1))))<br />         (setq P (slice-list (PARSE2 S ",") -5 nil))<br />        ;;(setq P (get-last-three (PARSE2 S ",")))<br />               ;(setq P (LIST (NTH 2 P) (NTH 3 P) (NTH 4 P))) ; 创建坐标列表<br />         (setq dm (NTH MN P))<br />         (setq x0 (NTH XN P))<br />         (setq y0 (NTH YN P))<br />               ;(setq P (MAPCAR 'ATOF P)) ; 将字符串转换为浮点数<br />         (setq x (ATOF x0)) ; 将字符串转换为浮点数<br />         (setq y (ATOF y0)) ; 将字符串转换为浮点数<br />         <br />     ;(if (and (tblsearch "block" dm) ((= (vl-string-search (car pair) (vl-princ-to-string feature-code)) 0)))<br />     (if (tblsearch "block" dm)<br />         (progn<br />         (entmake-dzw dm (list y x) 2 "0" '((-3 ("SOUTH" (1000 . "175101")))))<br />         ;(princ (strcat "\n绘制 " dm " 成功。"))<br />         (setq j (+ j 1))<br />         )<br />         (progn<br />         ;(princ (strcat "\n\n未找到与【" dm "】相匹配的块，【" dm "】未能绘制成功。"))<br />         (setq DNLST (append DNLST (list "第" i "行：" dm "、")))<br />         )<br />     )<br />       (setq i (+ i 1))<br />             )<br />       <br /> (princ (strcat "\n展绘完成。数据文件共" (vl-princ-to-string i) "行，导入" (vl-princ-to-string j) "个图元。"))<br /> (princ (strcat "\n数据文件中：" (vl-princ-to-string DNLST) "等共计" (vl-princ-to-string (- i j)) "个图元未能绘制成功。"))<br /> (princ (strcat "请查改数据文件或创建、导入相应名称的图块。\n"))<br />             (CLOSE F1) ; 关闭文件<br /> ;==========================<br />    (COMMAND "_.UNDO" "E")<br /> ;定义命令编组结束<br />   (setvar "osmode" oldom)<br />   (princ)<br /> ) ;_ 结束 defun<br />

也是花了些时间和精力的。
愿意赏点小钱的爷请点这里下载：


附：
测绘数据文件说明：
是以逗号分隔的数据文本文件，按5列保存，顺序可调。具体代码中IXYZM含义：编号(I),X 值(X),Y 值(Y),Z 值(Z),DM(M)。
例如下面表格，数据顺序是MIXYZ：

棱锥造型		10713.49	53476.36	9.762
大叶黄杨球		10708.89	53478.96	9.715
螺旋造型		10703.16	53473.78	9.622
圆顶香樟		10702.74	53475.82	9.674
香樟		10701.56	53478.07	11.152
红花檵木球		10700.93	53481.22	11.14
1蘑菇造型		10706.78	53480.78	11.2
长颈鹿头造型		10705.77	53483.1	11.197
无患子		10707.87	53488.78	12.723
造型法桐		10705.81	53490.85	12.73

M确定块名，X、Y确定X、Y坐标
。I、Z列的数据在本插件中没有用到。

czb203

感谢大佬的热心分享~

LIULISHENG

无论如何，共享的态度不要这么谦卑

mkjsnow

谢谢分享，下载学习

w379106181

感谢大佬的热心分享~

gf123

谢谢分享。。。。

寒潮大冬瓜

很好→很棒！很好~很棒！！很好……很棒！！！