Jump to content

Issue with offset inside lsp program & way to undo only second to last command


meinfilel

Recommended Posts

Hello, everyone. I'm writing this lsp in order to offset only one side of the polyline and not all of the lines.

I'm attaching the code below as well as a gif showing my intended use.

As you probably know, while offsetting an object when you are called to choose a side, you get a preview of the new line. That is happening when I'm calling offset from my lisp file. 

My second problem, is about undo. The last two command of my lsp file are 1)the actual offset command 2)entdel to delete the "buffer line"; I call buffer line just the segment of the polyline I want to offset. What I need to achieve is after completing the program, when undo is called only the offset command gets cancelled. Because the way I got it now (group the last two command) when undo is called entdel is reversed, so I get the "buffer line", which I don't want at all to exist.

 

Any idea of doings thing differently, or a solution to my issues, will be appreciated very much.\

Thanks in advance.

 

Gif

code:

(defun c:dd ( / ent testpoint thisdrawing k firstvertex secondvertex verlister smallangle linemaker linetodelete pairvertices LM:Unique )
  (vl-load-com)
  
 ;;==subroutines==;;

(defun LM:Unique ( l ) ;remove duplicates --lee mac http://www.lee-mac.com/uniqueduplicate.html--
(if l
(cons (car l)
(LM:Unique (vl-remove (car l) (cdr l)))
)
)
)
  
(defun       drwpoint ( pnts colorflag / pnt n k mkpoint )  ;; nil doesnt work!!!
;DRAW POINTS WITH FED X,Y (IT MAKES Z = 0 FOR ALL FED POINTS)
;gets as input 2 or 3 coordinates
;in case the fed point has 3 coordinates, it keeps only X and Y
;; ( x y z ) -> slist 
;; ( (x1 y1 z1) (x2 y2 z2) ) -> clist 
;; ( ( (x1 y1 z2) (x2 y2 z2) ) ( (x3 y3 z3) (x4 y4 z4) ) ) -> sclist

  
(defun mkpoint ( xy clr )
  (if (eq (length xy) 3)
      (setq xy (list (car xy) (cadr xy)))
    )
  (entmakex
	(list (cons 0 "point") (list 10 (car xy) (cadr xy) 0)
	      (cond ;condition for color
		((eq (substr (strcase clr) 1 1) "R") (cons 62 1))
		((eq (substr (strcase clr) 1 1) "Y") (cons 62 2))
		((eq (substr (strcase clr) 1 1) "G") (cons 62 3))
		((eq (substr (strcase clr) 1 1) "C") (cons 62 6))
		((eq (substr (strcase clr) 1 1) "P") (cons 62 6))
		((eq clr "nil") )
		
)	;cond
		)
      ) )	;defun mkpoint

(command "UNDO" "BE")			;undo from this point will undo everything

(cond
  ( (eq (elementorlist pnts) "slist")  (mkpoint pnts colorflag) )
  ( (eq (elementorlist pnts) "clist") (foreach n pnts (mkpoint n colorflag)) )
  ( (eq (elementorlist pnts) "sclist") (foreach n pnts (foreach k n (mkpoint k colorflag))) )
  

)	;cond  
  (command "UNDO" "END")
  ) ;defun drawpoint




;;================================================================================;;
	  ;;================================================================================;;
	  ;;================================================================================;;

(defun elementorlist ( pnts )
;;;  takes as argument one of the following
;;;  and returns the corresponding message
;;; !! a and b must be numbers !!
;;;- a or (a)-> elmnt (single element)
;;;- (a b) -> slist (simple list)
;;;- ( (a b) (c d)) -> clist (complex list)
;;;- ( ( (a1 b1) (a2 b2) ) ( (c1 d2) (c2 d2) ) ) -> sclist (super complex list) 
  
  (vl-load-com)
(if (numberp pnts) ; to check if is REAL or INTeger
;(or (eq (type pnts) (READ "INT"))
	;(eq (TYPE X) (READ "REAL"))	)	;OR
(setq pnts (list pnts))
  (princ)	)
(cond

  (	 (AND
	  (eq (length pnts) 1 )
	  (vl-every '(lambda (x) (numberp x)
	  ;(or (eq (TYPE X) (READ "REAL"))
			       ;(eq (TYPE X) (READ "INT"))   ) ;OR
				   ) 
				   pnts)	) ;AND
	   
   "elmnt" )
  ( (vl-every '(lambda (x) (numberp x)
  ;(or (eq (TYPE X) (READ "REAL"))
			       ;(eq (TYPE X) (READ "INT"))
			       ;)	;or
		 ) pnts) "slist")
  ( (AND
      (vl-every '(lambda (x) (listp x) ;(eq (TYPE X) (READ "list"))
	  )
	      pnts )
     (vl-every '(lambda (x)  (listp (car X)) ;(eq (TYPE (car X)) (READ "list") ) 
	 ) 
	      pnts    )
      )	;AND
   "sclist" )
  (T "clist")
  )	;cond

  ) ;defun elementorlist
;;================================================================================;;
	  ;;================================================================================;;
	  ;;================================================================================;;

(defun pairvertices ( lst / 1p extrapair )
;accepts only clist
; make list ( (a b) (c d) (d e) ) ->
;           ( ( (a b) (b c) ) ((b c)  (c d) ) ( (c d) (d e) (e a))
(if (eq (elementorlist lst) "clist" )
(progn
  
  (if (eq (length lst) 2) ;if only two points are in the vertices list, do nothing
    pts
    (progn
      
      (setq extrapair (list (last lst) (car lst)) )
(repeat (- (length lst) 1)
(setq 1p (append 1p (list (list (nth 0 lst) (nth 1 lst))) ) )
(setq lst (cdr (member (nth 0 lst) lst))) ;read from here
)
(setq 1p (append 1p (list extrapair))  )    
1p
)	;progn if vertices list has more than 2 points
    )	;if
)	;progn if clist is fed
  (progn
    (princ "\nWrong Input. Exiting.")
    (exit)
    )	;progn in anything but clist is fed
  )	;if
)	;defun pairvertices


;;================================================================================;;
	  ;;================================================================================;;
	  ;;================================================================================;;
 (defun vertlister ( arrowpline / pts titty )
	  

;subfunction making list with vertices of pline
;input -> entity name

	    
(setq titty (entget arrowpline))
(while (assoc 10 titty)

  (setq pts (append pts (list (cdr (assoc 10 titty)))))

  (setq titty (cdr (member (append (list 10 ) (last  pts)) titty)))


)	;while	
(if
(> (length pts)
(length (lm:unique pts))	) ;if true then pline isn't closed
;note: a pline can have overlapping vertices and still be open, not closed

(lm:unique pts)
pts
)	;if

	)	;defun vertlister
	 (defun Linemaker (p1 p2) ;subroutine to make line
 (entmakex (list (cons 0 "LINE")
		 (cons 8 "wontbeprinted")
                 (cons 10 p1)
                 (cons 11 p2)
                 )))	;linemaker
	  ;;================================================================================;;
	  ;;================================================================================;;
	  ;;================================================================================;;
	;;================================================================================;;
  (defun smallangle ( pt1 pt2 / ang1 ang2 )
;gets two points as input
;it returns the smallest angle between them

(setq ang1 (angle pt1 pt2)
      ang2 (angle pt2 pt1) )

(if (< ang1 ang2)
  ang1
  ang2
  )	;if

  );	defun smallangle

	  	  ;;================================================================================;;
	  ;;================================================================================;;
  ;;==subroutines==;;

(if (eq					;check that selection is polyline
      (cdr
	(assoc 0
	       (entget
		 (car (setq ent (entsel "Pick line segment to offset.")))
	       )
	)
      )
      "LWPOLYLINE"
    )
  (progn
  
(setq ;ent	(entsel "Pick line segment to offset.")
      testpoint	(vlax-curve-getclosestpointto
		  (vlax-ename->vla-object (car ent))
		  (cadr ent)
		)
)
  (setq thisdrawing (vla-get-activedocument 
                          (vlax-get-acad-object))) ;used in vl-startend undo mark commands

;following loop returns the two vertices of pline
;that have the smallest angle against testpoint
;ie vertices of pline which are in a straight line
;passing from testpoint

(foreach k (pairvertices (vertlister (car ent)))
			   (if
	     (equal
	       (smallangle testpoint (car k)) (smallangle testpoint (cadr k))
	       0.001)	;eq
		(setq nearestpt k)
	     )	;if
	   ) ;foreach


(setq firstvertex (car nearestpt) secondvertex (cadr nearestpt))
(setq linetodelete (linemaker firstvertex secondvertex))
;(vla-startundomark thisdrawing)
(command "._UNDO" "_Begin")
   (drwpoint nearestpt "y") ; == debugging
(command
"_.offset"
"_non"
pause
linetodelete
"_non"
pause ; select side
"" ;exit offset command
)	; end command
;(vla-endundomark thisdrawing)
    
;delete buffer line
(entdel linetodelete)



  (command "._UNDO" "_End")


)	;progn if LWPOLYLINE
  (progn
    (princ "\nNo polyline selected. Consider using build-in offset command.")
      (princ)
      ) 	;progn
  )	;if
)

 

Link to comment
Share on other sites

Well, I should have taken a step back before asking about the undo situtation. The most straightforward solution is to include the creation of the line in the undo group.

Link to comment
Share on other sites

For the preview check out the following.

 

This is how to undo multiple commands with one undo.

 

undo with vla looks like these are used in your lisp.  you need to move these lines of code to an earlier spot.

(Setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) 

(vla-startundomark thisdrawing)

(vla-endundomark thisdrawing)

 

unfo with command

(vl-cmdf "_.Undo" "Be") ;set the beging of undo
(vl-cmdf "_.Undo" "E")  ;set the end of undo

 

 

  • Like 1
Link to comment
Share on other sites

Thanks you both for your responses, I got some very good ideas about what features I can add.

 

Although, I can't see to find solution regarding the offset command not showing a preview.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...