断面生成后断面里程不对 麻烦老师们给看看

hkhbs

还有最后的一个断面总是生成不出来

hkhbs

测试数据 麻烦师傅们给看一下

f4800

hkhbs 发表于 2021-8-18 19:18
感谢@yshf  @xvjiex  可能是我描述的不准确   不过 已经可以完美解决了问题  谢谢

怎么解决的 ？方便分享下么

cjf160204

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))
)

xvjiex

断面里程怎么个不对，请详细说明。或图片说明。

hkhbs

生成到里程100后面里程不会累加了

hkhbs

还有一般最后一个断面 出不来  必须把数据单独拎出来生成

xvjiex

不懂你们的专业，不知道是否这个里程？没有找到大于100的里程。

hkhbs

是我表述的问题  是这个里程

xvjiex

你的要求是什么，比如有这样的数据：BEGIN,178.848:14。你要在CAD上显示什么样子？

yshf

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) (setq  zffh "-"))
  (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用得太泛滥

hkhbs

K0+178.84  :D