[编程交流] 阵列维度

;(prompt "\nType "mine" to run........")
(defun c:mine ( / theobj thelist n xval1 yval1 newlist maxdeg amax xval2 yval2 xval3 yval3 d1 d2 d3 z a l anarray mspace myobj)
                           
;load the visual lisp extensions
(vl-load-com)
                           
;get the entity and entity name
(setq theobj (car (entsel "\nSelect a Polyline: ")))
                           
;convert to vl object
(setq theobj (vlax-ename->vla-object theobj))
;retrieve the coordinates
(setq thelist (vlax-get-property theobj 'coordinates))
;convert to a list
(setq thelist (vlax-safearray->list  (variant-value thelist)))
;zero the counter
(setq n 0)
;make a list of the simplified coordinates
(setq xval1 (car thelist))
(setq yval1 (cadr thelist))
(setq newlist '(xval1 yval1))
;ask for maximum angle
(setq maxdeg (getint "\nEnter Maximum Angle (0 - 90 deg) : "))
;convert degrees to radians using "dtr" routine
(setq amax (dtr maxdeg))
;start the loop and repeat it for (n-2) times
(repeat (- (/ (length thelist) 2) 2)
;get the x coordinates
(setq xval1 (nth n thelist))
(setq xval2 (nth (+ 2 n) thelist))
(setq xval3 (nth (+ 4 n) thelist))
;increase the counter
(setq n (1+ n))
;get the y coordinates
(setq yval1 (nth n thelist))
(setq yval2 (nth (+ 2 n) thelist))
(setq yval3 (nth (+ 4 n) thelist))
;calculate distances using "distan" routine
(setq d1 (distan xval1 xval2 yval1 yval2)) 
(setq d2 (distan xval1 xval3 yval1 yval3))
(setq d3 (distan xval2 xval3 yval2 yval3)) 
;calculate angle
(setq z (/ (- (+ (expt d1 2) (expt d2 2)) (expt d3 2)) (* 2 (* d1 d2))))   
(setq a (arccos z))
;compare the angles
(if (> a (/ amax 2))
;if true do the following
(progn  
 
;add the coordinates to the new list
(setq newlist (append '(newlist xval3 yval3)))
);progn
);if
;increase the counter
(setq n (1+ n))
);repeat
;add the last point to the simplified list
(setq xval1 (nth (- (length thelist) 1) thelist))
(setq yval1 (last thelist))
(setq newlist (append '(newlist xval1 yval1)))
;make an array with the points of the simplified list
(setq anarray (vlax-make-safearray vlax-vbDouble '(0 . (- (length newlist) 1))))
;fill it with x and y values
(vlax-safearray-fill anarray newlist)
;reference to model space
(setq mspace (vla-get-modelSpace (vla-get-activeDocument (vlax-get-acad-object))))
;draw the simplified polyline
(setq myobj (vla-addLightweightPolyline mspace anarray))
(princ)
);defun
;------------------------------------------
;This function converts Degrees to Radians.
(defun dtr (x)
;define degrees to radians function
(* pi (/ x 180.0))
;divide the angle by 180 then
;multiply the result by the constant PI
) ;end of function
;clean loading
(princ)
;This function calculates distance
(defun distan (x1 x2 y1 y2)
;calculate dx dy
(setq pt1 (list x1 y1))
(setq pt2 (list x2 y2))
;find the distance
(distance pt1 pt2)
) ;end of function
;clean loading
(princ)
;This function inverse cosine (ArcCos)
;Args: -1 <= x <= 1
(defun arccos (x)
 (atan (/ (sqrt (- 1 (expt x 2))) x))
)
;clean loading
(princ)
;-------------------------------------------
;End of mine.lsp
;---------------------------