如果台阶高能改成手动输入就好，如可根据提示输入500或600等其他数字
院长的程序小女一般用不了，太多自定义函数了，但还是感谢院长的指点。。
参考效果：
院长的程序功能确实强大，但没有通用函数没什么用
请问怎样把下面的固定500改成手动输入，怎样试都不行。。
(vla-move obj
(vlax-3d-point '(0. 0. 0))
(vlax-3d-point '(0. 500. 0.))
)
(vla-move obj
(vlax-3d-point '(0. 0. 0))
(vlax-3d-point (list 0. (if (null (setq disv (getdist"\n输入垂直间距 <500>:"))) 500.0 disv) 0.))
)
等哪天闲下来重写个满足你全部要求的函数。
mmmmmm大哥真是有求必应，打心里崇拜你，谢谢你的关心。。
飞机上写的，没太测试，主函数应该能工作，界面交互的那部分你自己弄个就好了。
;; pl=curveobject曲线实体
;; dy=vertical distance垂直分段距离
;; dir=scanning direction T=LL, NIL=UR起始点方向，t=下到上；NIL=上到下
(Defun c:zz () (_DrawSect (car (entsel)) 400. T))
(Defun c:zz1 () (_DrawSect (car (entsel)) 400. nil))
(Defun _DrawSect
(pl dy dir / _FixVertex DX EPT INT LL OBJ P1 P2 PTX RTN SPT UR VLO)
(Defun _FixVertex (ptx / BB BX DIR PT RTN VTX)
(setq bx(caar ptx)
dir (- (car (last ptx)) (caar ptx))
)
(foreach pt ptx
(setq bb (car pt)
bb (- bb bx)
bb (* 100 (fix (+ 0.5 (* bb 0.01))))
bb (+ bb bx)
)
(if (> dir 0)
(while (> (car pt) bb) (setq bb (+ bb 100)))
(while (< (car pt) bb) (setq bb (- bb 100)))
)
(setq rtn (cons (cons bb (cdr pt)) rtn))
)
(setq rtn (reverse rtn)
rtn (append rtn (list (last rtn)))
)
(while (cdr rtn)
(setq pt (car rtn)
ptx (cadr rtn)
rtn (cdr rtn)
vtx (cons (cons 10 pt) vtx)
vtx (cons (list 10 (car ptx) (cadr pt)) vtx)
)
)
vtx
)
(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)
dx (- (car ur) (car ll))
)
(if dir
(setq p1(polar ll pi (* 0.1 dx))
p2(polar ll 0 (* 1.2 dx))
dir (* 0.5 pi)
)
(setq p1(polar ur 0 (* 0.1 dx))
p2(polar ur pi (* 1.2 dx))
dir (* 1.5 pi)
)
)
(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 (polar '(0. 0. 0.) dir dy))
)
)
(vla-erase obj)
(setq ptx (car rtn)
spt (trans (vlax-curve-getstartpoint vlo) 0 1)
ept (trans (vlax-curve-getendpoint vlo) 0 1)
)
(if (> (abs (- (cadr spt) (cadr ptx)))
(abs (- (cadr ept) (cadr ptx)))
)
(setq rtn (cons ept rtn))
(setq rtn (cons spt rtn))
)
(setq rtn (_FixVertex
(vl-sort rtn '(lambda (p1 p2) (< (cadr p1) (cadr p2))))
)
rtn (append (list (cons 0 "lwpolyline")
(cons 100
"AcDbEntity"
)
(cons 100 "AcDbPolyline")
(cons 90 (length rtn))
)
rtn
)
)
(entmake rtn)
(princ)
)
这两天出差，回来一看到mmmm大哥的程序好开心哦，程序非常成功，大哥辛苦了，小女不胜感激。。。