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)))) ))
  

[Kent1Cooper]

Is there a question?

I tried it, to find out what it's supposed to do, and on entering the command name, I got the prompt:

but as soon as I picked something [it was a LWPOLYLINE], I got:

Note that the Command: AALPER part is the same one as above -- the initial typing in of the command name itself.  The Select curve: prompt above didn't "slide up" in the command history, but was overwritten in-place by the point-for-line prompt [followed by the error message].  The same happened when I tried it on a Line, Arc, and Circle. 

[pbejse]

You need to define  this variable lAct 

Like in here,

(setq lAct 0 #Ent (car (entsel "\nSelect curve: ")))

The rest i'm not really sure what is supposed to .

[pbejse · Accepted solution]

(defun c:AALPer (/ #Ent #Read)
  (and
    (setq lAct 0 #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
      (progn
	(not (eq 25 (car (setq #Read (grread T 15 0)))))
      	(princ "\rSpecify point for line: ")
      	(redraw)
	      (cond
		((= 3 (car #Read)) (princ "\nMouse click | Put whatever here") nil)
		((vl-consp (cadr #Read))
		   (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)) lst
			)
		)
	)
    ) ;_ while
  ) ;_ and
  (redraw)
  (princ)
)