- 积分
- 3897
- 明经币
- 个
- 注册时间
- 2022-9-23
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2024-6-27 14:41:50
|
显示全部楼层
(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")
)
) |
|
显身卡