三角网坡度分析转三维面-仿CASS

树櫴希德

2. 
   
3. ;;;;;;;
   
4. 
   
5. 
   
6. 
   
7. (defun vxs (e / i v lst)
   
8.   (setq i 0)
   
9.   (while
   
10.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
    
11.      (setq lst (cons v lst))
    
12.   )
    
13.   (reverse lst))
    
14. 
    
15. (defun podujs (pzx / zjs podu1 podu2 podu3 pzx)
    
16. (setq zjs (list (/ (+ (car(car pzx)) (car(cadr pzx)) (car(caddr pzx))   ) 3.000)
    
17.                 (/ (+ (cadr(car pzx)) (cadr(cadr pzx)) (cadr(caddr pzx))   ) 3.000)
    
18.                 (/ (+ (caddr(car pzx)) (caddr(cadr pzx)) (caddr(caddr pzx))   ) 3.000)
    
19.     ))
    
20. 
    
21.   
    
22. (setq podu1 (read(angtos (atan(abs  (/ (- (caddr(car pzx))  (caddr zjs)) (distance (car pzx) zjs) )   ))0 3)))
    
23. (setq podu2 (read(angtos (atan(abs  (/ (- (caddr(cadr pzx))  (caddr zjs)) (distance (cadr pzx) zjs) )   ))0 3)))
    
24.   (setq podu3 (read(angtos (atan(abs  (/ (- (caddr(caddr pzx))  (caddr zjs)) (distance (caddr pzx) zjs) )   ))0 3)))
    
25. 
    
26.   (max podu1 podu2 podu3)
    
27.       )
    
28. 
    
29. 
    
30. 
    
31. ;;;;;;;;;;;;;;;
    
32. (defun c:sjwswt ( / pzx ssa en ptb i ii no yanse demj zongmj)
    
33. (setq ssa (ssget '((0 . "POLYLINE") (8 . "sjw"))))
    
34.                 (setq ii   0
    
35.                       no  0
    
36.                   )
    
37.                   (repeat (sslength ssa)
    
38.                        (setq en (ssname ssa ii)
    
39.                             ptb (vxs en)
    
40.            ;demj (vlax-curve-getArea  (vlax-ename->vla-object en))
    
41.           pzx (append pzx (list ptb))
    
42.   ;zongmj (append zongmj (list demj))         
    
43.            ii  (1+ ii)               )
    
44.        ; (setq pzx (list (car pt) (cadr pt) (caddr pt)))
    
45.                        
    
46.                   )
    
47.   ;(write-line (strcat pzx) fff)
    
48.                  ; (close fff)
    
49.                   ;(princ (strcat "\n坐标已存入"" wjm ""中"))
    
50.    
    
51.     ;(setvar "cmdecho" cm)
    
52.     (princ)
    
53. 
    
54. 
    
55. (foreach n pzx
    
56. 
    
57.   
    
58. (setq yanse nil)
    
59.   (cond  ((< 0 (podujs n) 12)  (setq yanse 4)   )
    
60. 
    
61. ((< 12 (podujs n) 25)  (setq yanse 5)   )
    
62. ((< 25 (podujs n)  35)  (setq yanse 2)   )   
    
63. ((< 35 (podujs n) 90)  (setq yanse 6)   )
    
64.     )
    
65. 
    
66. 
    
67.   
    
68. (entmake  (list '(0 . "3dface") (cons 10 (nth 0 n))
    
69.     (cons 11 (nth 1 n))
    
70.                 (cons 12 (nth 2 n))
    
71.                 (cons 13 (nth 0 n))
    
72.                 '(8 . "0")
    
73.     (cons 62 yanse)
    
74.     )  )
    
75. 
    
76. (setq no (1+ no))
    
77.   )
    
78. (princ)
    
79. 
    
80. )

<br /> ;;;;;;;<br /> <br /> <br /> <br /> (defun vxs (e / i v lst)<br />   (setq i 0)<br />   (while<br />     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />      (setq lst (cons v lst))<br />   )<br />   (reverse lst))<br /> <br /> (defun podujs (pzx / zjs podu1 podu2 podu3 pzx)<br /> (setq zjs (list (/ (+ (car(car pzx)) (car(cadr pzx)) (car(caddr pzx))   ) 3.000)<br />                 (/ (+ (cadr(car pzx)) (cadr(cadr pzx)) (cadr(caddr pzx))   ) 3.000)<br />                 (/ (+ (caddr(car pzx)) (caddr(cadr pzx)) (caddr(caddr pzx))   ) 3.000)<br />     ))<br /> <br />   <br /> (setq podu1 (read(angtos (atan(abs  (/ (- (caddr(car pzx))  (caddr zjs)) (distance (car pzx) zjs) )   ))0 3)))<br /> (setq podu2 (read(angtos (atan(abs  (/ (- (caddr(cadr pzx))  (caddr zjs)) (distance (cadr pzx) zjs) )   ))0 3)))<br />   (setq podu3 (read(angtos (atan(abs  (/ (- (caddr(caddr pzx))  (caddr zjs)) (distance (caddr pzx) zjs) )   ))0 3)))<br /> <br />   (max podu1 podu2 podu3)<br />       )<br /> <br /> <br /> <br /> ;;;;;;;;;;;;;;;<br /> (defun c:sjwswt ( / pzx ssa en ptb i ii no yanse demj zongmj)<br /> (setq ssa (ssget '((0 . "POLYLINE") (8 . "sjw"))))<br />                 (setq ii   0<br />                       no  0<br />                   )<br />                   (repeat (sslength ssa)<br />                        (setq en (ssname ssa ii)<br />                             ptb (vxs en)<br />            ;demj (vlax-curve-getArea  (vlax-ename->vla-object en))<br />           pzx (append pzx (list ptb))<br />   ;zongmj (append zongmj (list demj))         <br />            ii  (1+ ii)               )<br />        ; (setq pzx (list (car pt) (cadr pt) (caddr pt)))<br />                        <br />                   )<br />   ;(write-line (strcat pzx) fff) <br />                  ; (close fff)<br />                   ;(princ (strcat "\n坐标已存入"" wjm ""中"))<br />    <br />     ;(setvar "cmdecho" cm)<br />     (princ)<br /> <br /> <br /> (foreach n pzx<br /> <br />   <br /> (setq yanse nil)<br />   (cond  ((< 0 (podujs n) 12)  (setq yanse 4)   )<br /> <br /> ((< 12 (podujs n) 25)  (setq yanse 5)   )<br /> ((< 25 (podujs n)  35)  (setq yanse 2)   )   <br /> ((< 35 (podujs n) 90)  (setq yanse 6)   )<br />     )<br /> <br /> <br />   <br /> (entmake  (list '(0 . "3dface") (cons 10 (nth 0 n))<br />     (cons 11 (nth 1 n))<br />                 (cons 12 (nth 2 n))<br />                 (cons 13 (nth 0 n))<br />                 '(8 . "0")<br />     (cons 62 yanse)<br />     )  )<br /> <br /> (setq no (1+ no))<br />   )<br /> (princ)<br /> <br /> )

429014673

加一些动画和测试文件

树櫴希德

2. (defun vxs (e / i v lst)
   
3.   (setq i 0)
   
4.   (while
   
5.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
   
6.      (setq lst (cons v lst))
   
7.   )
   
8.   (reverse lst))
   
9. 
   
10. ;;;;;;;
    
11. (defun getplarea (l)
    
12.   (* 0.5
    
13.      (apply
    
14.        '+
    
15.        (mapcar
    
16.          '(lambda (a b) (- (* (car a) (cadr b)) (* (car b) (cadr a))))
    
17.          l
    
18.          (append (cdr l) (list (car l)))
    
19.        )
    
20.      )
    
21.   )
    
22. )
    
23. ;;;;;;;
    
24. 
    
25. 
    
26. 
    
27. (entmake (list (cons 0  "TEXT") (cons 1 (rtos (getplarea(vxs(car(entsel)))) 2 3)) (cons 10 (getpoint""))
    
28.                (cons 40 0.5)
    
29.                (cons 8 "面积")
    
30.                ))

(defun vxs (e / i v lst)<br />   (setq i 0)<br />   (while<br />     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />      (setq lst (cons v lst))<br />   )<br />   (reverse lst))<br /> <br /> ;;;;;;;<br /> (defun getplarea (l)<br />   (* 0.5<br />      (apply<br />        '+<br />        (mapcar<br />          '(lambda (a b) (- (* (car a) (cadr b)) (* (car b) (cadr a))))<br />          l<br />          (append (cdr l) (list (car l)))<br />        )<br />      )<br />   )<br /> )<br /> ;;;;;;;<br /> <br /> <br /> <br /> (entmake (list (cons 0  "TEXT") (cons 1 (rtos (getplarea(vxs(car(entsel)))) 2 3)) (cons 10 (getpoint""))<br />                (cons 40 0.5)<br />                (cons 8 "面积")<br />                ))

面积计算