TEST (grread) & (grvecs

[hosneyalaa]

;;; Draw perpendicular line
;;; Alan J. Thompson, 10.15.09
(defun c:AALPer (/ #Ent #Read)
  (and
    (setq #Ent (car (entsel "\nSelect curve: ")))
    (vl-position (cdr (assoc 0 (entget #Ent))) '("LWPOLYLINE" "ARC" "LINE" "CIRCLE" "ELLIPSE"))
    
(setq lAth'( 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18))
(setq lstReturnXY'(0 0.05 0.1 0.15 0.2 0.25 0.3 0.35 0.4 0.45 0.5 0.55 0.6 0.65 0.7 0.75 0.80 0.85 0.9 0.95 1))
    
    (while (not (eq 25 (car (setq #Read (grread T 15 0)))))
      (princ "\rSpecify point for line: ")
      (redraw)
      (if (vl-consp (cadr #Read))
	(progn

	   (setq ClosestPoint(vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T))
	  (setq END1 ClosestPoint END2 (cadr #Read))
	(setq lst (mapcar (function (lambda (a) (polar END1 (angle END1 END2) (* (distance END2 END1) a))  )) lstReturnXY))
	(if (< lAct (- (length  lAth) 2))  ;;(length  lAth)
	    (PROGN
	    (setq lAth (foo  lAth))
	    (setq lAct (+ 1 lAct))
	    )
	    (PROGN
	    (setq lAth'( 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18))
	    (setq lAct 0)
	    )
	    )
	(grvecs (list
	  1 (NTH 0 lst) (NTH 1 lst)
			  1 (NTH (car lAth)  lst) (NTH (cadr lAth) lst)
			  1 (NTH (- (length lst) 2)  lst) (NTH (- (length lst) 1)  lst)
;;;			 1 (NTH 19  lst) (NTH 20 lst)
		     )
             )
	(fooaa (NTH (car lAth)  lst)  (NTH (cadr lAth) lst))
	
	)
	
      ) ;_ if

    ) ;_ while
  ) ;_ and
  (redraw)
  (princ)
) ;_ defun




(defun fooaa (p p1 / )
     (progn (setq hp  (getvar 'HPNAME)
                i   1
		*length*(distance p p1)
                ang (angle p p1)
                a   (polar p (+ ang (* pi 1.5)) (/ *length* 2.))
                b   (polar p (+ ang (* pi 0.5)) (/ *length* 2.))
                c   (polar p ang *length*)
          )
          (grvecs (list -3 a b b c c a))
       )
)

(defun foo ( l ) (repeat 1(setq l (append (cdr l) (list (car l)))) ))
  

 

[pBe]

Dejavu <---- check your neighbouring lsp forum