断面生成后断面里程不对 麻烦老师们给看看
还有最后的一个断面总是生成不出来测试数据 麻烦师傅们给看一下
hkhbs 发表于 2021-8-18 19:18
感谢@yshf@xvjiex可能是我描述的不准确 不过 已经可以完美解决了问题谢谢
怎么解决的 ？方便分享下么 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))
) 断面里程怎么个不对，请详细说明。或图片说明。 生成到里程100后面里程不会累加了 还有一般最后一个断面 出不来必须把数据单独拎出来生成 不懂你们的专业，不知道是否这个里程？没有找到大于100的里程。
是我表述的问题是这个里程
你的要求是什么，比如有这样的数据：BEGIN,178.848:14。你要在CAD上显示什么样子？ 本帖最后由 yshf 于 2021-8-18 10:03 编辑
1、将：
(setq l3 (mapcar '(lambda(x y) (GetSubList ll x (1- y))) l2 (cdr l2)))
改为：
(setq l3 (append (mapcar '(lambda(x y) (GetSubList ll x (1- y))) l2 (cdr l2))
(list (member (nth (last l2) ll) ll))
)
)
2、将：
(defun lczh (x / x1 x2)
(if (> x 0)
(setq x1 (itoa (fix (/ x 1000.)))
x2 (substr (rtos (+ (rem x 1000) 2000.) 2 3) 3)
)
(setq x1 (itoa (fix (1- (/ x 1000.))))
x2 (substr (rtos (+ (rem x 1000) 2000.) 2 3) 3)
)
)
(strcat "k" x1 "+" x2)
)
改为：
(defun lczh (x / x1 x2 zffh x2zf)
(setq zffh "+")
(if (< x 0.0) (setqzffh "-"))
(setq x (abs x))
(setq x1 (fix (/ x 1000.0)))
(setq x2 (- x (* x1 1000.0)))
(setq x2zf (rtos x2 2 3))
(If (< x2 10.0)
(setq x2zf (strcat "00" x2zf))
(if (< x2 100.0)
(setq x2zf (strcat "0" x2zf))
)
)
(setq x2zf (strcat "K" (itoa x1) zffh x2zf))
)
3、注意：变量名x用得太泛滥
K0+178.84:D
页:
[1]
2