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

hkhbs

感谢@yshf  @xvjiex  可能是我描述的不准确   不过 已经可以完美解决了问题  谢谢

f4800

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

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

skg123

hkhbs 发表于 2021-8-18 06:32
是我表述的问题  是这个里程

CAD文字字体的原因；

渠辉

xvjiex 发表于 2021-8-17 08:39
不懂你们的专业，不知道是否这个里程？没有找到大于100的里程。

这个高程应该是平距，左负右正

skg123

这问题应该在原来的帖子下跟帖
http://bbs.mjtd.com/thread-168574-1-1.html
这样问题汇总在一起

cjf160204

根据大神的代码生成

cjf160204

cjf160204 发表于 2023-1-4 11:15
根据大神的代码生成

运行命令 hdm

skg123

确实，测试后，少一个横断面

skg123

hkhbs 发表于 2021-8-18 06:32
是我表述的问题  是这个里程

这个程序有个设计不足的地方，没有让用户选择 横断面起点位置（插入点位置），这样的后果是 第二次读取数据绘图就重叠了；
整理了一下程序，附后

2. (defun lczh (x / x1 x2)
   
3.   (if (> x 0)
   
4.     (setq x1 (itoa (fix (/ x 1000.)))
   
5.             x2 (substr (rtos (+ (rem x 1000) 2000.) 2 3) 2)
   
6.     )
   
7.     (setq x1 (itoa (fix (1- (/ x 1000.))))
   
8.             x2 (substr (rtos (+ (rem x 1000) 2000.) 2 3) 2)
   
9.     )
   
10.   )
    
11.   (strcat "K" x1 "+" x2)
    
12. )

(defun lczh (x / x1 x2)<br />   (if (> x 0)<br />     (setq x1 (itoa (fix (/ x 1000.)))<br />             x2 (substr (rtos (+ (rem x 1000) 2000.) 2 3) 2)<br />     )<br />     (setq x1 (itoa (fix (1- (/ x 1000.))))<br />             x2 (substr (rtos (+ (rem x 1000) 2000.) 2 3) 2)<br />     )<br />   )<br />   (strcat "K" x1 "+" x2)<br /> )

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