计算曲线上两点间的距离

marting

1. ;;; Calculate distance between 2 specified points on curve object
   
2. ;;; Required Subroutines: AT:DrawX
   
3. ;;; Alan J. Thompson, 03.20.10 / 03.28.10
   
4. (defun c:DBP (/ *error* #Obj #Pnt #Pnt2 #D1 #D2 #List #Dist ent)
   
5.   (vl-load-com)
   
6.   (redraw)
   
7.   (setq *error* (lambda (m) (and (= (type #Obj) 'VLA-OBJECT)  (vla-highlight #Obj :vlax-false))))
   
8.   (and
   
9.     (AT:DrawX (setq #Pnt (getpoint "\nSpecify first point on curve: "))  3)
   
10.     (or  (setq #Obj
    
11.                   (ssget "c"
    
12.                         (polar #Pnt -0.7854 (* 0.01 (getvar 'viewsize)))
    
13.                         (polar #Pnt 2.3562 (* 0.01 (getvar 'viewsize)))
    
14.                         '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))
    
15.                   )
    
16.         )
    
17.         (alert "Point must be on curve!")
    
18.     ) ;_ or
    
19.     (AT:DrawX  (setq #Pnt2 (getpoint #Pnt "\nSpecify next point on curve: ")) 3)
    
20.     (or (and
    
21.             (setq #Obj
    
22.                     (ssget "c"
    
23.                             (polar #Pnt2 -0.7854 (* 0.01 (getvar 'viewsize)))
    
24.                             (polar #Pnt2 2.3562 (* 0.01 (getvar 'viewsize)))
    
25.                             '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))
    
26.                     )
    
27.             )
    
28.             (vl-some (function
    
29.                         (lambda (x)
    
30.                             (and (setq ent x)
    
31.                                   (vlax-curve-getdistatpoint x (trans #Pnt 1 0))
    
32.                                   (vlax-curve-getdistatpoint x (trans #Pnt2 1 0))
    
33.                             )
    
34.                         )
    
35.                     )
    
36.                     (vl-remove-if 'listp (mapcar 'cadr (ssnamex #Obj)))
    
37.             )
    
38.             (setq #D2 (vlax-curve-getDistAtPoint (setq #Obj (vlax-ename->vla-object ent)) (trans #Pnt2 1 0)))
    
39.             (setq #D1 (vlax-curve-getDistAtPoint #Obj (trans #Pnt 1 0)))
    
40.             (not (vla-highlight #Obj :vlax-true))
    
41.         ) ;_ and
    
42.         (alert "Points must be on curve!")
    
43.     ) ;_ or
    
44.     (progn
    
45.       (setq #Dist (car (setq #List (vl-sort (list #D1 #D2) '<))))
    
46.       (while (< #Dist (- (cadr #List) (/ (cadr #List) 100.)))
    
47.         (grdraw
    
48.           (trans (vlax-curve-getPointAtDist #Obj #Dist) 0 1)
    
49.           (trans (vlax-curve-getPointAtDist #Obj (setq #Dist (+ (/ (cadr #List) 100.) #Dist))) 0 1)
    
50.           1
    
51.         ) ;_ grdraw
    
52.       ) ;_ while
    
53.       (princ)
    
54.       (alert (strcat "Distance between points on curve: "
    
55.                     (rtos (abs (- #D1 #D2)) (getvar 'lunits) (getvar 'luprec))
    
56.             ) ;_ strcat
    
57.       ) ;_ alert
    
58.     ) ;_ progn
    
59.   ) ;_ and
    
60.   (*error* nil)
    
61.   (princ)
    
62. ) ;_ defun
    
63. 
    
64. 
    
65. ;;; Draw and "X" vector at specified point
    
66. ;;; P - Placement point for "X"
    
67. ;;; C - Color of "X" (must be integer b/w 1 & 255)
    
68. ;;; Alan J. Thompson, 10.31.09 / 03.26.10
    
69.   (defun AT:DrawX (P C / d n)
    
70.     (if (and (vl-consp P)
    
71.             (setq d (* (getvar "VIEWSIZE") 0.02))
    
72.         ) ;_ and
    
73.       (progn (grvecs (cons C
    
74.                           (mapcar
    
75.                             (function (lambda (#)  (polar P (* # pi) d) ))
    
76.                             '(0.25 1.25 0.75 1.75)
    
77.                           ) ;_ mapcar
    
78.                     ) ;_ cons
    
79.             ) ;_ grvecs1
    
80.             P
    
81.       ) ;_ progn
    
82.     ) ;_ if
    
83.   ) ;_ defun
    
84. 
    

;;; Calculate distance between 2 specified points on curve object<br /> ;;; Required Subroutines: AT:DrawX<br /> ;;; Alan J. Thompson, 03.20.10 / 03.28.10<br /> (defun c:DBP (/ *error* #Obj #Pnt #Pnt2 #D1 #D2 #List #Dist ent)<br />   (vl-load-com)<br />   (redraw)<br />   (setq *error* (lambda (m) (and (= (type #Obj) 'VLA-OBJECT)  (vla-highlight #Obj :vlax-false))))<br />   (and<br />     (AT:DrawX (setq #Pnt (getpoint "\nSpecify first point on curve: "))  3)<br />     (or  (setq #Obj<br />                   (ssget "c"<br />                         (polar #Pnt -0.7854 (* 0.01 (getvar 'viewsize)))<br />                         (polar #Pnt 2.3562 (* 0.01 (getvar 'viewsize)))<br />                         '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))<br />                   )<br />         )<br />         (alert "Point must be on curve!")<br />     ) ;_ or<br />     (AT:DrawX  (setq #Pnt2 (getpoint #Pnt "\nSpecify next point on curve: ")) 3)<br />     (or (and<br />             (setq #Obj<br />                     (ssget "c"<br />                             (polar #Pnt2 -0.7854 (* 0.01 (getvar 'viewsize)))<br />                             (polar #Pnt2 2.3562 (* 0.01 (getvar 'viewsize)))<br />                             '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))<br />                     )<br />             )<br />             (vl-some (function<br />                         (lambda (x)<br />                             (and (setq ent x)<br />                                   (vlax-curve-getdistatpoint x (trans #Pnt 1 0))<br />                                   (vlax-curve-getdistatpoint x (trans #Pnt2 1 0))<br />                             )<br />                         )<br />                     )<br />                     (vl-remove-if 'listp (mapcar 'cadr (ssnamex #Obj)))<br />             )<br />             (setq #D2 (vlax-curve-getDistAtPoint (setq #Obj (vlax-ename->vla-object ent)) (trans #Pnt2 1 0)))<br />             (setq #D1 (vlax-curve-getDistAtPoint #Obj (trans #Pnt 1 0)))<br />             (not (vla-highlight #Obj :vlax-true))<br />         ) ;_ and<br />         (alert "Points must be on curve!")<br />     ) ;_ or<br />     (progn<br />       (setq #Dist (car (setq #List (vl-sort (list #D1 #D2) '<))))<br />       (while (< #Dist (- (cadr #List) (/ (cadr #List) 100.)))<br />         (grdraw<br />           (trans (vlax-curve-getPointAtDist #Obj #Dist) 0 1)<br />           (trans (vlax-curve-getPointAtDist #Obj (setq #Dist (+ (/ (cadr #List) 100.) #Dist))) 0 1)<br />           1<br />         ) ;_ grdraw<br />       ) ;_ while<br />       (princ)<br />       (alert (strcat "Distance between points on curve: "<br />                     (rtos (abs (- #D1 #D2)) (getvar 'lunits) (getvar 'luprec))<br />             ) ;_ strcat<br />       ) ;_ alert<br />     ) ;_ progn<br />   ) ;_ and<br />   (*error* nil)<br />   (princ)<br /> ) ;_ defun<br /> <br /> <br /> ;;; Draw and "X" vector at specified point<br /> ;;; P - Placement point for "X"<br /> ;;; C - Color of "X" (must be integer b/w 1 & 255)<br /> ;;; Alan J. Thompson, 10.31.09 / 03.26.10<br />   (defun AT:DrawX (P C / d n)<br />     (if (and (vl-consp P)<br />             (setq d (* (getvar "VIEWSIZE") 0.02))<br />         ) ;_ and<br />       (progn (grvecs (cons C<br />                           (mapcar<br />                             (function (lambda (#)  (polar P (* # pi) d) ))<br />                             '(0.25 1.25 0.75 1.75)<br />                           ) ;_ mapcar<br />                     ) ;_ cons<br />             ) ;_ grvecs1<br />             P<br />       ) ;_ progn<br />     ) ;_ if<br />   ) ;_ defun<br /> <br />

chaozi5756

奈斯，歪瑞奈斯！

一张单程票

看到好贴必点赞，感谢分享！