wanhongron
发表于 2012-7-10 22:54:16
只是还有个小问题,台阶从上面开始,开始点不在线上,即是没有闭合,希望从最上面开始的时候最上面闭合,最下面可不闭合,再次麻烦哥哥了。。
wanhongron
发表于 2012-7-10 22:57:25
zz命令非常好,就是zz1命令麻烦再完善一下。
mmmmmm
发表于 2012-7-11 10:15:01
(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 flag / BB BX DIR PT RTN VTX)
(if (equal flag (* 0.5 pi) 0.001)
(setq bx (caar ptx))
(setq bx (car (last ptx)))
)
(setq 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))))
dir
)
rtn (append (list (cons 0 "lwpolyline")
(cons 100
"AcDbEntity"
)
(cons 100 "AcDbPolyline")
(cons 90 (length rtn))
)
rtn
)
)
(entmake rtn)
(princ)
)
wanhongron
发表于 2012-7-12 00:25:09
MMMMM哥哥,你太有才了,也很细心,非常谢谢。
keleke85
发表于 2019-11-26 11:17:11
需要这个插件,实用
czb203
发表于 2020-2-28 09:13:39
这个非常好用,感谢nnnnnnnnnn兄
彳余
发表于 2020-2-29 13:31:26
这个非常好用