隧道中线 间距 边线点 环号 坐标导出

gaomingabc456

(defun C:sdhjs (/ ss ent distTotal step offset lx ptFoot ptNext tanAng norAng ptOff num txtPt opt reverseFlg startDist fpath fobj)
  (vl-load-com)
  (setvar "CMDECHO" 0)
  ;;自动创建【环号】图层
  (if (not (tblsearch "LAYER" "环号"))
    (entmake '((0 . "LAYER")(100 . "AcDbSymbolTableRecord")(2 . "环号")(62 . 5)(70 . 0)(6 . "CONTINUOUS")))
  )

  ;;选择中线：直线、多段线(含圆弧段)、轻多段线
  (setq ss (ssget "_+.:E:S" '((0 . "LINE,PLINE,LWPOLYLINE"))))
  (if ss
    (progn
      (setq ent (ssname ss 0)
            distTotal (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
      )
      ;;选择编号方向，默认1（起点开始）
      (initget "1 2")
      (setq opt (getkword "\n 编号方向 [1起点开始/2终点开始] <默认1>:"))
      (if (not opt) (setq opt "1"))
      (setq reverseFlg (= opt "2"))

      ;;输入布点间距
      (initget 1)
      (setq step (getreal "\n输入中线布点间距："))
      ;;输入统一偏距 前进方向左负、右正
      (initget "")
      (setq offset (getreal "\n 输入统一偏距(前进方向左负/右正)："))
      (if offset
        (progn
          ;;选择保存坐标文件
          (setq fpath (getfiled "保存" "中线坐标" "txt" 1))
          (if fpath
            (setq fobj (open fpath "w"))
            (progn (princ "\n 未选择文件，不导出坐标！") (setq fobj nil))
          )
          ;;写入文件表头
          (if fobj
            (write-line "编号,里程,X垂足,Y垂足,X放样点,Y放样点" fobj)
          )

          (setq num 1)
          ;;判断遍历方向
          (if reverseFlg
            (setq lx distTotal startDist (- step))
            (setq lx 0.0 startDist step)
          )

          (while (if reverseFlg (>= lx 0.0) (<= lx distTotal))
            ;;获取当前里程中线垂足点
            (setq ptFoot (vlax-curve-getpointatdist ent lx))
            ;;微小步长求切线方向
            (if (< (+ lx 0.001) distTotal)
              (setq ptNext (vlax-curve-getpointatdist ent (+ lx 0.001)))
              (setq ptNext (vlax-curve-getpointatdist ent (- lx 0.001)))
            )
            (setq tanAng (angle ptFoot ptNext)
                  norAng (+ tanAng (/ pi 2.0))
                  ptOff (polar ptFoot norAng offset)
            )
            ;;绘制垂线
            (entmake (list '(0 . "LINE") (cons 10 ptFoot) (cons 11 ptOff)))
            ;;红色标记放样圆点
            (entmake (list '(0 . "CIRCLE") '(62 . 1) (cons 10 ptOff) '(40 . 0.16)))

            ;;垂足编号【环号图层】文字偏移，不压线
            (setq txtPt (polar ptFoot (+ tanAng (* pi 0.25)) 0.35))
            (entmake (list '(0 . "TEXT")
                           '(8 . "环号")
                           '(40 . 0.30)
                           (cons 10 txtPt)
                           (cons 1 (itoa num))
                           '(50 . 0.0)
                      )
            )

            ;;命令行输出坐标，保留4位小数
            (princ (strcat "\n编号=" (itoa num) " 里程 " (rtos lx 2 4)
                           " ,X=" (rtos (car ptOff) 2 4)
                           " ,Y=" (rtos (cadr ptOff) 2 4)))

            ;;写入TXT文件：逗号分隔
            (if fobj
              (write-line
                (strcat      "编号=" (itoa num) " 里程 " (rtos lx 2 4)
                           ", 垂足X=" (rtos (car ptFoot) 2 4)
                           ", 垂足Y=" (rtos (cadr ptFoot) 2 4)
                           " ,放样X=" (rtos (car ptOff) 2 4)
                           ", 放样Y=" (rtos (cadr ptOff) 2 4)
                )
                fobj
              )
            )

            (setq lx (+ lx startDist)
                  num (1+ num))
          )
          ;;关闭文件
          (if fobj (close fobj))
          (princ "\n 批量垂线生成完成，坐标文件已导出！")
        )
        (princ "\n未输入偏距，程序退出")
      )
    )
    (princ "\n 请选中直线或多段线中线！")
  )
  (setvar "CMDECHO" 1)
  (princ)
)
(princ "\n加载完成，命令：sdhjS")
(princ)