横断面数据提取

730527

能批量提取横断面数据就完美了

f4800

730527 发表于 2021-1-20 22:21
能批量提取横断面数据就完美了

有批量提取的

730527

能不能共享一下

willing0

学习学习 谢谢谢谢谢

技术工作室

试用不错，顶一个

cjf160204

不知道怎么用

cjf160204

(defun c:hot (/ *error* filename fn start count step point_1 px_1 py_1 s e pts)
  (vl-load-com)
  
  ;; 错误处理
  (defun *error* (msg)
    (if fn (close fn))
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\n错误: " msg)))
    (princ))
  
  ;; 用户输入起始桩号和步长
  (setq start (getint "\n请输入起始桩号 <0>: "))
  (if (not start) (setq start 0))
  (setq step (getint "\n请输入桩号步长 <20>: "))
  (if (not step) (setq step 20))
  
  ;; 初始化
  (setvar "dimzin" 0)
  (setvar "dimdec" 3)
  (setq filename (getfiled "选择输出文件" "d:/断面线数据.txt" "txt" 33))
  (if (not filename) (setq filename "d:/断面线数据.txt"))
  (setq fn (open filename "w")  ; 覆盖模式写入
        count start)            ; 桩号计数器
  
  ;; 主循环
  (while t
    (princ (strcat "\n当前桩号: " (itoa count)))
   
    ;; 1. 选择基准中心位置
    (if (not (setq point_1 (getpoint "\n选择断面基准中心位置 (ESC结束): ")))
      (exit)
    )
    (setq px_1 (car point_1)
          py_1 (cadr point_1))
   
    ;; 2. 选择多段线
    (while
      (progn
        (setq s (ssget ":S" '((0 . "POLYLINE,LWPOLYLINE"))))
        (cond
          ((not s) (princ "\n未选择对象!") T)
          ((/= (sslength s) 1) (princ "\n只能选择一条多段线!") T)
          (T nil)
        )
      )
    )
    (setq e (ssname s 0))
   
    ;; 3. 提取多段线顶点
    (setq pts (get-polyline-points e))
   
    ;; 4. 写入数据 (桩号, 平距, 高差)
    (foreach pt pts
      (write-line
        (strcat (itoa count) ","
                (rtos (- (car pt) px_1) 2 3) ","  ; 平距 = X - 基准X
                (rtos (- (cadr pt) py_1) 2 3))    ; 高差 = Y - 基准Y (高程为0)
        fn)
    )
   
    ;; 桩号递增
    (setq count (+ count step))
  )
  
  (close fn)
  (princ (strcat "\n导出完成! 文件保存至: " filename))
  (princ))

;; 辅助函数：获取多段线所有顶点坐标
(defun get-polyline-points (e / pts param pt)
  (setq pts '())
  (if (vlax-curve-isplanar e)
    (progn
      (setq param 0)
      (while (<= param (vlax-curve-getendparam e))
        (setq pt (vlax-curve-getpointatparam e param))
        (if (or (null pts) (not (equal pt (car pts) 1e-3)))
          (setq pts (cons pt pts))
        )
        (setq param (1+ param))
      )
      (reverse pts)
    )
    (progn
      (princ "\n警告: 多段线非平面，可能产生错误数据!")
      nil
    )
  )
)

杜阳

支持       赞赞

cjf160204

(defun c:hdmout (/ *error* ss_str ss_pl i ent str_list point_list height_list
                  filename fn e str_1 point_1 px_1 py_1 height_1 number jd pt pts)
  (vl-load-com)
  
  (defun *error* (msg)
    (if fn (close fn))
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\n错误: " msg)))
    (princ))
  
  (setvar "dimzin" 0)
  (setvar "dimdec" 3)
  
  (setq str_list '())
  (if (setq ss_str (ssget '((0 . "TEXT,MTEXT"))))
    (progn
      (setq i 0)
      (while (< i (sslength ss_str))
        (setq ent (ssname ss_str i))
        (setq str_list (cons (cdr (assoc 1 (entget ent))) str_list))
        (setq i (1+ i))
      )
      (setq str_list (reverse str_list))
    )
    (progn (princ "\n未选择任何桩号文字!") (exit))
  )
  
  (setq ss_pl (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (if (or (null ss_pl) (/= (sslength ss_pl) (length str_list)))
    (progn
      (princ (strcat "\n错误: 需要选择" (itoa (length str_list)) "条多段线!"))
      (exit)
    )
  )
  
  (setq point_list '()
        height_list '())
  
  (setq i 0)
  (repeat (length str_list)
    (setq str_1 (nth i str_list))
   
    (setq point_1 (getpoint (strcat "\n为桩号 " str_1 " 选择基准中心位置: ")))
    (setq point_list (append point_list (list point_1)))
   
    (initget "S I")
    (setq resp (getkword "\n高程输入方式 [选择文字(S)/输入值(I)] <S>: "))
    (setq height_1
      (cond
        ((or (null resp) (equal resp "S"))
         (if (setq ent (car (entsel "选择高程文字: ")))
           (distof (cdr (assoc 1 (entget ent))))
           (getreal "输入高程值: ")))
        ((equal resp "I") (getreal "输入高程值: "))
        (T (getreal "输入高程值: "))
      )
    )
    (setq height_list (append height_list (list height_1)))
    (setq i (1+ i))
  )
  
  (setq filename (getfiled "保存结果文件" "d:/断面数据.txt" "txt" 1))
  (setq fn (open filename "w"))
  
  (setq i 0)
  (repeat (length str_list)
    (setq str_1 (nth i str_list)
          e (ssname ss_pl i)
          point_1 (nth i point_list)
          px_1 (car point_1)
          py_1 (cadr point_1)
          height_1 (nth i height_list))
   
    (if (vlax-curve-isplanar e)
      (progn
        (setq number (fix (vlax-curve-getendparam e))
              jd (1+ number)
              pts nil)
        
        (repeat (1+ number)
          (setq pt (vlax-curve-getpointatparam e (setq jd (1- jd))))
          (if (or (null pts) (not (equal pt (car pts) 1e-3)))
            (setq pts (cons pt pts))
          )
        )
        
        (write-line str_1 fn)
        (foreach x (reverse pts)
          (write-line
            (strcat str_1 ","
                    (rtos (- (car x) px_1) 2 3) ","
                    (rtos (+ height_1 (- (cadr x) py_1)) 2 3))
            fn)
        )
        (princ (strcat "\n已处理 " str_1 " (" (itoa (length pts)) "点)"))
      )
      (princ (strcat "\n跳过非平面多段线: " str_1))
    )
    (setq i (1+ i))
  )
  
  (close fn)
  (princ (strcat "\n处理完成! 已导出 " (itoa (length str_list)) "个断面到 " filename))
  (princ))