★边坡台阶自动开挖程序求实现

wanhongron

工作中经常遇到在边坡开挖台阶，要求台阶高0.5m，宽为整数(即n×0.1m，如0.4m、0.5m等)，且按照现状地形最大限度开挖，见图红色线为现状地面线，白色线为开挖台阶线。我的思路是这样的，先按照0.5m高度阵列与地形线相交，然后求出每个台阶与地形线相交的水平长度，对长度取整，最后连点成线，不知道哪位大侠能帮忙给个程序。

xyp1964

参考效果：

czb203

这个非常好用，感谢nnnnnnnnnn兄

keleke85

需要这个插件，实用

wanhongron

这样的思路也应该可以，画线从最上面顶点开始，读取所有多段线线顶点坐标，按竖向排序，求任意第i阶y坐标（0.5m×i）对应的x坐标，对x坐标取整，然后去取得任意i阶坐标，最后连点成线。

wanhongron

(setq PT (vlax-curve-getpointatdist Ent 1))这个能按曲线长度获取点，
请问怎样才能按照垂直高度每隔0.5m在多段线上获取点呢？

mmmmmm

需要做辅助水平线，然后intersectwith求交点

wanhongron

麻烦mmmmmm 大哥写一段程序了，小女比较笨笨

mmmmmm

(Defun c:zz()(_DrawSect (car (entsel))))
(Defun _DrawSect (pl           /            _GetPlineVertex   _FixRoundX
                  INT           LL            OBJ             P1              P2       PLX
                  RTN           UR            VLO
                 )
  (Defun _FixRoundX (pt base / x)
    (setq x (car pt)
          x (* 100 (fix (+ 0.5 (* x 0.01))))
    )
    (list x (cadr pt))
  )
  (Defun _GetPlineVertex (ptx / PT0 PT1 RTN X0)
    (setq x0 (caar ptx))
    (while (cdr ptx)
      (setq pt0        (_FixRoundX (car ptx) x0)
            pt1        (_FixRoundX (cadr ptx) x0)
            rtn        (append        (list (list 10 (car pt1) (cadr pt0))
                              (list 10 (car pt0) (cadr pt0))
                        )
                        rtn
                )
            ptx        (cdr ptx)
      )
    )
    (setq
      rtn (append (list (list 10 (car (last ptx)) (cadr (last ptx))))
                  rtn
          )
    )
    rtn
  )

  (setq vlo (vlax-ename->vla-object pl))
  (vla-getboundingbox vlo 'll 'ur)
  (setq        ll (trans (vlax-safearray->list ll) 0 1)
        ur (trans (vlax-safearray->list ur) 0 1)
  )
  (setq        p1 (polar ll pi (* 0.1 (- (car ur) (car ll))))
        p2 (polar ll 0 (* 1.2 (- (car ur) (car ll))))
  )
  (entmake (list (cons 0 "line") (cons 10 p1) (cons 11 p2)))
  (setq obj (vlax-ename->vla-object (entlast)))
  (while
    (and
      (setq int (vla-intersectwith vlo obj acExtendNone))
      (null
        (vl-catch-all-error-p
          (vl-catch-all-apply
            '(lambda ()
               (setq
                 int (vlax-safearray->list (vlax-variant-value int))
               )
             )
          )
        )
      )
      (= (length int) 3)
    )
     (setq rtn (cons int rtn))
     (vla-move obj
               (vlax-3d-point '(0. 0. 0))
               (vlax-3d-point '(0. 500. 0.))
     )
  )
  (vla-erase obj)
  (setq        rtn (_GetPlineVertex
              (vl-sort rtn '(lambda (p1 p2) (< (cadr p1) (cadr p2))))
            )
        plx (append (list (cons 0 "lwpolyline")
                          (cons        100
                                "AcDbEntity"
                          )
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length rtn))
                    )
                    rtn
            )
  )
  (entmake plx)
)

wanhongron

非常感谢mmmmmm 大哥，太神了，基本达到了我需要的功能，美中不足的就是开挖台阶线即白色线部分越过了红线，另外最上面的竖向开挖边不垂直，还有就是起始点想要从红线开始，更完美的话就是起始点可选择从上面或从下面开始。还是麻烦大哥再修饰修饰一下。。。

wanhongron

不好意思，我的表达有误，最后一根线垂直得了，可以不受0.5m限制

mmmmmm

突出的区域还是用眼和手修改吧，程序要判断处理的话，要判断曲线的形状走向以及特定点的哪个方向是土，代码估计要长出一倍去。

wanhongron

好的，还是要谢谢你大侠，虽然有点修改，但还是方便很多。