- ;;;;;;;
- (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
- no 0
- )
- (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)
- )
|