根据测绘坐标数据展绘块[2025.2.16更新逻辑语句]
本帖最后由 煮茗 于 2025-2-16 15:09 编辑;;; 功能：根据测绘数据文件（代码描述及点坐标）在平面图上展绘块
;;; 日期：2024 年 12 月 9 日2025.2.16更新逻辑语句
;;; 主要代码来源于论坛，感谢各前辈大佬。
能展绘的前提是：1，已经有相应名称的块，已加载到文件中或存放在“支持文件搜索路径”下。2，测绘数据文件满足要求（看本文最后）。
2025.2.16 更新逻辑语句
(if (or (tblsearch "block" dm) (findfile (strcat dm ".dwg")));文件已导入块或【支持文件搜索路径】下存放有此名称的块
……
)
以下是全部代码。愿意打赏的可以到附件下载。感谢大家！
;;; 功能：根据测绘数据文件（坐标）在平面图上展绘块
;;; 日期：2024 年 12 月 9 日2025.2.16更新逻辑语句
;;; 主要代码来源于论坛，感谢各前辈大佬
(vl-load-com)
(defun slice-list (lst start end / len sliced result i); 定义一个函数，用于切片列表
(setq len (length lst)) ; 获取列表长度
(setq sliced nil) ; 初始化切片列表
(setq result nil) ; 初始化结果列表
; 处理负索引和 end 为 nil 的情况
(if (< start 0); 如果开始索引为负数，转换为正索引
(setq start (+ len start))
)
(if (null end); 如果结束索引为 nil，设置为列表长度
(setq end len)
)
(if (< end 0); 如果结束索引为负数，转换为正索引
(setq end (+ len end))
)
(if (and (listp lst) (numberp start) (numberp end) (<= start end)); 检查参数类型和范围
(progn; 如果参数有效，则进行切片操作
(setq sliced lst) ; 复制原列表到切片列表
(setq i 0) ; 初始化计数器
(repeat start; 使用 repeat 和 cdr 模仿 nthcdr 功能
(setq sliced (cdr sliced)) ; 逐步缩减切片列表以模拟 nthcdr
)
(setq i start) ; 设置 i 为开始索引
(while (and sliced (> end i)); 遍历列表并构建切片
(setq result (cons (car sliced) result)) ; 将当前元素添加到结果列表
(setq sliced (cdr sliced)) ; 指向下一个元素
(setq i (+ i 1)) ; 更新计数器
)
(reverse result) ; 反转结果列表以保持原始顺序
)
(alert "Invalid arguments for slicing.") ; 参数无效时的警告
)
)
;; 定义 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
; 函数: PARSE2
; 功能: 解析一个字符串，根据给定的分隔符将其分割成一个子字符串列表。
; 参数:
; STR - 要解析的原始字符串。
; DELIM - 用作分隔符的字符串，函数将根据此分隔符来分割 STR。
; 局部变量:
; LST - 存储分割后的子字符串列表。
; POS - 分隔符在字符串中的位置。
; 返回值: 一个列表，包含按照分隔符分割的所有子字符串。
; 注意: 如果分隔符在字符串的末尾，那么最后一个子字符串将是一个空字符串。
; 如果分隔符不在字符串中，则返回包含原始字符串的单个元素列表。
; 示例: (PARSE2 "one,two,three" ",") 返回 ("one" "two" "three")
(DEFUN PARSE2 (STR DELIM / LST POS)
; 初始化变量LST和POS
(while (and (setq POS (VL-STRING-SEARCH DELIM STR)))
; 将DELIM之前的子字符串添加到列表LST中，然后更新STR
(setq LST (APPEND LST (LIST (SUBSTR STR 1 POS))))
(setq STR (SUBSTR STR (+ 2 POS)))
)
; 如果STR长度大于0，则将STR添加到LST中，否则返回LST
(if (> (STRLEN STR) 0)
(PROGN (APPEND LST (LIST STR)))
(PROGN LST)
)
)
(defun entmake-dzw(km pt co la bm / data);插块 改颜色图层编码
(regapp "TCF")
(command-s "_.insert" km "x" KBL "y" KBL "z" KBL "non" pt "") ;块比例
(command-s "chprop" (entlast)"" "c" co "la" la "")
(setq data (entget (entlast)))
(setq data (append data bm))
(entmod data)
)
(defun C:ZH ( / FILE i zn MN moden IN XN YN F1 STR str1 LST zdm)
(setvar "cmdecho" 0)
(setq oldom (getvar "osmode"))
(setvar "osmode" 0)
(setq LUJING1 (getenv "userprofile")) ; 设置路径1
(setq LUJING2 "\\Desktop\\") ; 设置路径2
(defun *error* (msg)
(if oldom
(setvar "OSMODE" oldom)
))
(setq KBL (getreal "\n请设定展绘的块比例:<1>"));块比例设置
(if (null KBL)(setq KBL 1))
(setq mode (getstring "\n 请输入数据文件内数列排序格式：[（须大写）编号(I),X 值(X),Y 值(Y),Z 值(Z),DM(M)]默认<MIYXZ>:"))
(setq FILE (getfiled "选择.dat.txt 文件" (strcat LUJING1 LUJING2 "0\\") "dat;txt" 8))
(princ "\n展绘进行中，请稍等...\n\n")
(if (or (= mode nil) (= mode ""))
(setq mode "MIYXZ")
)
(setq i 1)
(setq zn "")
(setq MN "")
(setq moden (strlen mode))
(while ( < i (+ moden 1))
(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
;============================
;定义命令编组开始
(command "_.undo" "be")
;; 以读模式打开文件
(setq F1 (open FILE "r"))
(setq DNLST (list ""))
(setq k 0)
(setq j 0)
(while (and (/= nil (setq S (READ-LINE F1))))
(setq P (slice-list (PARSE2 S ",") -5 nil))
(setq dm (NTH MN P))
(setq x0 (NTH XN P))
(setq y0 (NTH YN P))
(setq x (ATOF x0)) ; 将字符串转换为浮点数
(setq y (ATOF y0)) ; 将字符串转换为浮点数
(if (or (tblsearch "block" dm) (findfile (strcat dm ".dwg")));文件已导入块或【支持文件搜索路径】下存放有此名称的块
(progn
(entmake-dzw dm (list y x) 2 "0" '((-3 ("TCF" (1000 . "通过ZH展绘导入的图块")))))
(setq j (+ j 1))
)
(progn
(setq DNLST (append DNLST (list "第" (+ k 1) "行：" dm "、")))
)
)
(setq k (+ k 1))
)
(CLOSE F1) ; 关闭文件
(princ (strcat "\n展绘完成。数据文件共" (vl-princ-to-string k) "行，导入" (vl-princ-to-string j) "个图元。"))
(if (/= k j)
(progn
(princ (strcat "\n数据文件中：" (vl-princ-to-string DNLST) "等共计" (vl-princ-to-string (- k j)) "个图元未能绘制成功。"))
(princ (strcat "请查改数据文件或创建、导入相应名称的图块。\n"))
)
(princ "\n全部数据点均已展绘。")
)
;==========================
(COMMAND "_.UNDO" "E")
;定义命令编组结束
(setvar "osmode" oldom)
(princ)
) ;_ 结束 defun
也是花了些时间和精力的。
愿意赏点小钱的爷请点这里下载：
↑↑↑2025.2.16更新逻辑语句。已下载过的可以免币重新下载一下。
附：
测绘数据文件说明：
是以逗号分隔的数据文本文件，按5列保存，顺序可调。具体代码中IXYZM含义：编号(I),X 值(X),Y 值(Y),Z 值(Z),DM(M)。
例如下面表格，数据顺序是MIXYZ：
棱锥造型10713.4953476.369.762
大叶黄杨球10708.8953478.969.715
螺旋造型10703.1653473.789.622
圆顶香樟10702.7453475.829.674
香樟10701.5653478.0711.152
红花檵木球10700.9353481.2211.14
1蘑菇造型10706.7853480.7811.2
长颈鹿头造型10705.7753483.111.197
无患子10707.8753488.7812.723
造型法桐10705.8153490.8512.73
M确定块名，X、Y确定X、Y坐标
。I、Z列的数据在本插件中没有用到。
感谢大佬的热心分享~ 无论如何，共享的态度不要这么谦卑 谢谢分享，下载学习 感谢大佬的热心分享~ 谢谢分享。。。。 很好→很棒！很好~很棒！！很好……很棒！！！ 请楼主介绍一下事先准备的块文件放置的路径，块文件的名称和格式，不然不知道怎么使用啊！ 香远益清 发表于 2024-12-20 10:04
请楼主介绍一下事先准备的块文件放置的路径，块文件的名称和格式，不然不知道怎么使用啊！
这个可以。过几天不那么忙的时候简单写一篇。
感谢大佬的热心分享~
页:
[1]