感谢@yshf@xvjiex可能是我描述的不准确 不过 已经可以完美解决了问题谢谢
怎么解决的 ？方便分享下么 hkhbs 发表于 2021-8-18 06:32
是我表述的问题是这个里程
CAD文字字体的原因； xvjiex 发表于 2021-8-17 08:39
不懂你们的专业，不知道是否这个里程？没有找到大于100的里程。
这个高程应该是平距，左负右正 这问题应该在原来的帖子下跟帖
http://bbs.mjtd.com/thread-168574-1-1.html
这样问题汇总在一起 根据大神的代码生成 cjf160204 发表于 2023-1-4 11:15
根据大神的代码生成
运行命令 hdm 确实，测试后，少一个横断面 本帖最后由 skg123 于 2024-7-21 16:24 编辑
hkhbs 发表于 2021-8-18 06:32
是我表述的问题是这个里程这个程序有个设计不足的地方，没有让用户选择 横断面起点位置（插入点位置），这样的后果是 第二次读取数据绘图就重叠了；
整理了一下程序，附后
(defun lczh (x / x1 x2)
(if (> x 0)
(setq x1 (itoa (fix (/ x 1000.)))
x2 (substr (rtos (+ (rem x 1000) 2000.) 2 3) 2)
)
(setq x1 (itoa (fix (1- (/ x 1000.))))
x2 (substr (rtos (+ (rem x 1000) 2000.) 2 3) 2)
)
)
(strcat "K" x1 "+" x2)
)
skg123 发表于 2024-7-21 16:08
这个程序有个设计不足的地方，没有让用户选择 横断面起点位置（插入点位置），这样的后果是 第二次读取数据 ...
(defun c:HDM (/ FF LL L1 L2 L3 H_DIST V_DIST TY TN)
(setvar "dimzin" 0)
(setq FF (getfiled "请选择横断面文件:" "" "hdm" 0))
(setq LL (TH-READFILE FF))
(setq L1 (vl-remove-if-not '(lambda (x) (= "B" (substr x 1 1))) LL))
(setq L2 (mapcar '(lambda (x) (vl-position x LL)) L1))
(setq L3 (append (mapcar '(lambda (x y) (GETSUBLIST LL x (1- y))) L2 (cdr L2))
(list (member (nth (last L2) LL) LL))))
(initget 6)
(setq H_DIST (getreal "\n请输入横向间距(默认100): "))
(if (not H_DIST) (setq H_DIST 100))
(initget 6)
(setq V_DIST (getreal "\n请输入纵向间距(默认100): "))
(if (not V_DIST) (setq V_DIST 100))
(setq TY 0 TN 0)
(foreach x L3
(setq MV_PT (list (* (fix (/ (1- TN) 5)) H_DIST) (* TY V_DIST)))
(setq TY (1+ TY) TN (1+ TN))
(if (= TY 6) (setq TY 1))
(DRAW_DM x)
)
(princ)
)
(defun DRAW_DM (x / PT_LIST LI_CHENG F_READ F_LINE)
(setq PT_LIST nil)
(setq LI_CHENG (LCZH (read (vl-list->string
(reverse (cdr (member 58 (reverse (cdr (member 44 (vl-string->list (car x))))))))))
(setq x (cdr x))
(setvar "cmdecho" 0)
(while (and x)
(setq F_READ (car x))
(setq x (cdr x))
(setq F_LINE (STRPARSE F_READ ","))
(setq PT_LIST (cons (list (atof (car F_LINE)) (atof (cadr F_LINE))) PT_LIST))
)
(setq PT_LIST (reverse PT_LIST))
(setq MV_PT (list (* (fix (/ (1- TN) 5)) H_DIST) (* TY V_DIST)))
(CG_LIST PT_LIST MV_PT)
(PL_DRAW CG-LIST)
(princ)
)
(defun LCZH (x / X1 X2 ZFFH X2ZF)
(setq ZFFH (if (< x 0.0) "-" "+")
x (abs x)
X1 (fix (/ x 1000.0))
X2 (- x (* X1 1000.0))
X2ZF (rtos X2 2 3))
(cond ((< X2 10.0) (setq X2ZF (strcat "00" X2ZF)))
((< X2 100.0) (setq X2ZF (strcat "0" X2ZF))))
(strcat "K" (itoa X1) ZFFH X2ZF)
)
(defun PL_DRAW (PTL /)
(command "_.pline")
(foreach pt PTL (command pt))
(command "")
(command "_.pedit" (entlast) "_w" "0" "")
(command "_.change" (entlast) "" "_p" "_c" "3" "")
(command "_.text" "_j" "_m"
(list (/ (+ (apply 'min (mapcar 'car PTL))
(apply 'max (mapcar 'car PTL)))
(apply 'max (mapcar 'cadr PTL)))
"1.5" "0" LI_CHENG)
(command "_.zoom" "_e")
)
(defun STRPARSE (str delimiter / pos lst)
(while (setq pos (vl-string-search delimiter str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 2))))
(reverse (cons str lst))
)
(defun CG_LIST (ORI_LIST CAL_PT / DX DY)
(setq DX (- (car CAL_PT) (car (nth 0 ORI_LIST)))
DY (- (cadr CAL_PT) (cadr (nth 0 ORI_LIST)))
(setq CG-LIST (mapcar '(lambda (pt) (list (+ (car pt) DX) (+ (cadr pt) DY))) ORI_LIST))
)
页:
1
[2]