grread pline make

grread pline make

diegolopezsilanes
Advocate Advocate
911 Views
4 Replies
Message 1 of 5

grread pline make

diegolopezsilanes
Advocate
Advocate

hi, Im trying to use grread to see a preview of a pline with not so much luck

any help?

 

(defun c:PickList2()
(setq PT_LIST nil)
(while
(while
(setq PT (getpoint "\nPick a point: "))
; (command "borra" "lt" "")
(if (= PT_LIST nil)
(setq PT_LIST (list PT))
(setq PT_LIST (append (list PT) PT_LIST))
)
);while
(if (/= PT_LIST nil)

(progn
(command "_pline")
(foreach PT PT_LIST (command PT))
(command "")
)
);if
);while
(princ)
)
0 Likes
912 Views
4 Replies
Replies (4)
Message 2 of 5

Kent1Cooper
Consultant
Consultant

I think you'd need more than (grread), but would also need to involve (grdraw) and/or (grvecs) functions.  Read about (grvecs) >in the AutoLisp Reference< -- it is probably just what you need, if you have a list of points.

 

It can also be done with an actual temporarily drawn Polyline -- I have rarely used these functions, but I made a routine that works that way, to draw a rectangle starting by picking its midpoint, called RectMidPoint.lsp, available >here<.  It's not a trivial exercise, but it should certainly be possible to do what you describe in similar fashion, if the (grvecs) approach doesn't suit for some reason.

Kent Cooper, AIA
0 Likes
Message 3 of 5

CADaSchtroumpf
Advisor
Advisor

Hi,

An exemple with grread, you can use at end, the list lst_pt for (entmake) a polyline.

 

((lambda ( / p1 p2 p3 ll pt_m px1 px2 key rad inc lst_pt pa1 pa2)
  (setq
    p1 (polar (getvar "VIEWCTR") 0 (* 0.5 (getvar "VIEWSIZE")))
    p2 (polar (getvar "VIEWCTR") pi (* 0.5 (getvar "VIEWSIZE")))
    p3 (polar (getvar "VIEWCTR") (* 2 pi) (* 0.5 (getvar "VIEWSIZE")))
    ll (list p1 p2)
    pt_m (getvar "VIEWCTR")
    px1 (polar pt_m (+ (angle p1 p2) (* pi 0.5)) (distance p1 p2))
    px2 (polar pt_m (- (angle p1 p2) (* pi 0.5)) (distance p1 p2))
  )
  (princ "\nGive radius?: ")
  (while (and (setq key (grread T 4 0)) (/= (car key) 3))
    (cond
      ((eq (car key) 5)
        (redraw)
        (setq
          p3 (cadr key)
        )
        (cond
          (pt_m
            (setq 
              rad (distance pt_m p3)
              inc (angle pt_m p1)
              lst_pt '()
            )
            (repeat 36
              (setq
                pa1 (polar pt_m inc rad)
                inc (+ inc (/ (* pi 2.0) 36.0))
                pa2 (polar pt_m inc rad)
                lst_pt (append lst_pt (list pa1 pa2))
              )
            )
            (grvecs lst_pt)
          )
        )
      )
    )
  )
))
0 Likes
Message 4 of 5

diegolopezsilanes
Advocate
Advocate

done this from Elpanov's code

its f

(defun c:vv () (c:VECTORS))
(defun c:VECTORS (/ PT PTLIST)
  ; Sequential choice of points
  ; by ElpanovEvgeniy
  ; (2005-10-19 17:59:01)
  ; (VECTORS)
  (setq d1 (getpoint "\n Specify the first point  ")
		d2 (getpoint "2nd pnt"))
  (setq d3 (v- d2 d1))
  (setq PTLIST (list
                 (setq PT (getpoint "\n Specify the first point  "))
               ) ;_  list
  ) ;_  setq
  (princ "\n Specify the following point  ")
  (princ)
  (while
    (setq PT
           (progn (while
                    (and (setq PT (grread 5))
                         (= (car PT) 5)
                    ) ;_  and
							; (if (= PT_LIST nil)
							; (setq PT_LIST (list PT))
							; (setq PT_LIST (append (list PT) PT_LIST))
							; )
                     (redraw)
                     (mapcar
                       (function
                         (lambda (x1 x2)
                           (grdraw x1 x2 6 5)
                         ) ;_  lambda
                       ) ;_  function
                       (cons (cadr PT) PTLIST)
                       PTLIST
                     ) ;_  mapcar
					 (mapcar
                       (function
                         (lambda (x1 x2)
                           (grdraw x1 x2 6 5)
                         ) ;_  lambda
                       ) ;_  function
                       (cons (cadr PT) d4)
                       d4
                     ) ;_  mapcar
                  ) ;_  while
                  (if (listp (cadr PT))
                    (cadr PT)
                  ) ;_  if
           ) ;_  progn
    ) ;_  setq
     (setq PTLIST (cons PT PTLIST))
	 (setq d4 (mapcar '(lambda (x) (mapcar '+ x d3)) PTLIST))
  ) ;_  while
  ; (setq d4 (mapcar '(lambda (x) (mapcar '+ x d3)) PTLIST))
  (make-lwpol PTLIST nil)
  (make-lwpol d4 nil)
) ;_  defun

unny for making multiple plines , but I cannot use ortho, so doesnt match

0 Likes
Message 5 of 5

diegolopezsilanes
Advocate
Advocate

ill use this other kind for multi plines

 

 

;http://forums.augi.com/showthread.php?155444-Lisp-routine-for-a-new-command-to-draw-a-polyline-at-8-quot-wide-and-add-to-layer
(vl-load-com)
(defun c:PL8 (/ *error* acDoc layerName clayer plinewid)
  (defun *error* (msg)
    (and clayer (setvar 'clayer clayer))
    (and plinewid (setvar 'plinewid plinewid))
    (vla-endundomark acDoc)
    (cond ((not msg))							; Normal exit
	  ((member msg '("Function cancelled" "quit / exit abort")))	; <esc> or (quit)
	  ((princ (strcat "\n** Error: " msg " ** ")))			; Fatal error, display it
    )
    (princ)
  )
  ;; start undomark
  (vla-startundomark
    (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
  )
  ;; layer check
  (if (not (tblsearch "layer" (setq layerName "-mylayer")))
    (vla-add (vla-get-layers acDoc) layerName)
  )
  ;; get/set sysvars
  (setq clayer (getvar 'clayer))
  (setvar 'clayer layerName)
  (setq plinewid (getvar 'plinewid))
  (setvar 'plinewid 8.0)						;<-- be sure to adjust for your drawing units
  ;; draw the polyline
  (command "._pline")
  (while (= 1 (getvar 'cmdactive))
    (command pause)
  )
  (*error* nil)
)

;kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk
;kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk
;kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk
;kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk
(defun c:XX () (c:PickList))
(defun c:PickList()
  (setq d1 (getpoint "\n Specify the first point  ")
		d2 (getpoint "2nd pnt"))
  (setq d3 (v- d2 d1))
(setq PT_LIST nil)
(c:PL8)
(c:pts)
(princ)
)
;kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk
(defun c:pts (/ pl );----------------------------------------
(setq n 5)
(and (setq pl (ssget "_L"))
     (foreach itm
	(setq PT_LIST (mapcar 'cdr
				     (vl-remove-if-not
				       '(lambda	(x)
					  (= (car x) 10)
					)
				       (entget (ssname pl 0))
				     )
			     )
		)
       (print itm)
       )
     )
(setq i 0)	 
(while (> n i)
(setq PT_LIST (mapcar '(lambda (x) (mapcar '+ x d3)) PT_LIST))
(make-lwpol PT_LIST nil)
(setq i (+ 1 i))
) ;_  while
  (princ)
  )
;kkkkkkkkkkkkkk
0 Likes