三角网坡度分析转三维面-仿CASS
;;;;;;;
(defun vxs (e / i v lst)
(setq i 0)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst))
(defun podujs (pzx / zjs podu1 podu2 podu3 pzx)
(setq zjs (list (/ (+ (car(car pzx)) (car(cadr pzx)) (car(caddr pzx)) ) 3.000)
(/ (+ (cadr(car pzx)) (cadr(cadr pzx)) (cadr(caddr pzx)) ) 3.000)
(/ (+ (caddr(car pzx)) (caddr(cadr pzx)) (caddr(caddr pzx)) ) 3.000)
))
(setq podu1 (read(angtos (atan(abs(/ (- (caddr(car pzx))(caddr zjs)) (distance (car pzx) zjs) ) ))0 3)))
(setq podu2 (read(angtos (atan(abs(/ (- (caddr(cadr pzx))(caddr zjs)) (distance (cadr pzx) zjs) ) ))0 3)))
(setq podu3 (read(angtos (atan(abs(/ (- (caddr(caddr pzx))(caddr zjs)) (distance (caddr pzx) zjs) ) ))0 3)))
(max podu1 podu2 podu3)
)
;;;;;;;;;;;;;;;
(defun c:sjwswt ( / pzx ssa en ptb i ii no yanse demj zongmj)
(setq ssa (ssget '((0 . "POLYLINE") (8 . "sjw"))))
(setq ii 0
no0
)
(repeat (sslength ssa)
(setq en (ssname ssa ii)
ptb (vxs en)
;demj (vlax-curve-getArea(vlax-ename->vla-object en))
pzx (append pzx (list ptb))
;zongmj (append zongmj (list demj))
ii(1+ ii) )
; (setq pzx (list (car pt) (cadr pt) (caddr pt)))
)
;(write-line (strcat pzx) fff)
; (close fff)
;(princ (strcat "\n坐标已存入\"" wjm "\"中"))
;(setvar "cmdecho" cm)
(princ)
(foreach n pzx
(setq yanse nil)
(cond((< 0 (podujs n) 12)(setq yanse 4) )
((< 12 (podujs n) 25)(setq yanse 5) )
((< 25 (podujs n)35)(setq yanse 2) )
((< 35 (podujs n) 90)(setq yanse 6) )
)
(entmake(list '(0 . "3dface") (cons 10 (nth 0 n))
(cons 11 (nth 1 n))
(cons 12 (nth 2 n))
(cons 13 (nth 0 n))
'(8 . "0")
(cons 62 yanse)
))
(setq no (1+ no))
)
(princ)
) 加一些动画和测试文件 (defun vxs (e / i v lst)
(setq i 0)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst))
;;;;;;;
(defun getplarea (l)
(* 0.5
(apply
'+
(mapcar
'(lambda (a b) (- (* (car a) (cadr b)) (* (car b) (cadr a))))
l
(append (cdr l) (list (car l)))
)
)
)
)
;;;;;;;
(entmake (list (cons 0"TEXT") (cons 1 (rtos (getplarea(vxs(car(entsel)))) 2 3)) (cons 10 (getpoint""))
(cons 40 0.5)
(cons 8 "面积")
))面积计算
页:
[1]