AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

You might like this routine for your thingies section, which enables a user to pick multiple points with visual feed back and this is then passed back to the main routine.
Note the global variable...
PMV:EntlastFlag
The error routine will delete the entity if there is a crash.

Kind regards
Paul Matthews.

;;; CODING STARTS HERE.

;;; GEN:GETMPOINTS.lsp
;;; Written by Paul Matthews
;;; DESCRIPTION
;;; Sub routine that enables user to pick multiple points and returns
;;; list of points at conclusion to main routine. Function uses PLINE
;;; function to give user an indication of what is happening.
;;; MODE = nil for standard, 1 for 3D poly
;;; retain = keep created pline ( T ) or delete it ( nil ).
( defun GEN:GetMPoints ( MODE Retain / fp p1 p2 pntlst elst )
; This flag is called by error routine to check if pline requires deleting during crash
( setq PMV:EntlastFlag nil )
( defun ØÞ§GRdgp ( p )
( initget "Close Undo" )
( getpoint p "\nClose/Undo/<Endpoint of line>: " )
);def local function
( setvar "cmdecho" 0 ); turns off autocad prompts
( if
( setq fp ( getpoint "\nFrom point: " ))
( progn
( setq p1 fp pntlst ( list p1 )) ; start pntlist
( if ( = mode nil )
( progn ( setvar "PLINETYPE" 1 )( command "_.pline" p1 ))
( command "_.3dpoly" p1 )
)
( if ( null Retain )( setq PMV:EntlastFlag 1 ))
( setq p2 ( ØÞ§GRdgp p1 ) )
( while p2
( cond
;-------------------------------------------------
(( = p2 "Undo" ) ; remove last point from lst
( progn
( cond
(( > ( length pntlst ) 2 )
( progn
( setq pntlst ( reverse pntlst )
pntlst ( cdr pntlst )
p1 ( car pntlst )
pntlst ( reverse pntlst )
)
( command p2 )
)
)
(( = ( length pntlst ) 2 )
( progn
( setq p1 ( car pntlst ) pntlst ( list p1 ))
( command p2 )
)
)
(( = ( length pntlst ) 1 )
( progn
( setq PMV:EntlastFlag nil )
( princ "\nAll segments already undone." )
)
)
);cond
);progn
)
;-------------------------------------------------
(( = p2 "Close" )
( progn
( if ( > ( length pntlst ) 2 )
( progn
( command p2 )
( setq p2 0 )
( if ( null Retain )( setq PMV:EntlastFlag 1 ))
)
( progn
( princ "\nCannot close until two or more segments have been drawn")
)
);if
))
;-------------------------------------------------
(( /= p2 nil )
( progn ( command p2 )
( setq p1 p2 pntlst ( append pntlst ( list p2 )))
( if ( null Retain )( setq PMV:EntlastFlag 1 ))
))
);cond

( if ( /= p2 0 )( setq p2 ( ØÞ§GRdgp p1 )))

( if ( = p2 nil )( command "" ))

( if ( = p2 0 )( setq p2 nil ))

; ( princ pntlst)( princ " " );( princ p2 )( terpri )

);while

;(princ "flag1" )
;( princ PMV:EntlastFlag )
;( princ pntlst)
;;; function needs to discern if LWpline or HeavyPline and get
;;; resulting point list.
( setq elst ( entget ( entlast )))
;( princ "flag2" )
( if ( = ( dxf 0 elst ) "LWPOLYLINE")
( setq pntlst ( GEN:LwplinePntLst elst ))
( setq pntlst ( GEN:PlinePntLst elst ))
)
( if ( null Retain )( progn ( entdel ( entlast )) ( setq PMV:EntlastFlag nil )))
);progn
);if
pntlst
); defun

; returns pntlst of a 3dpline
( defun GEN:PlinePntLst ( elst / plst p )
( setq elst ( entnext ( dxf -1 elst ))
elst ( entget elst )
);setq
( while ( = ( dxf 0 elst ) "VERTEX")
( setq p ( dxf 10 elst )
elst ( entnext ( dxf -1 elst ))
elst ( entget elst )
);setq
( if ( null plst )
( setq plst ( list p ))
( setq plst ( append plst ( list p )))
)
);while
plst
)

; returns pntlst of a LightWeightPline
( defun GEN:LwplinePntLst ( elst / val pnt_lst )
( foreach val elst
( if ( = ( car val ) 10 )
( progn
( if ( = pnt_lst nil )
( setq val ( append ( cdr val ) '(0.0))
pnt_lst ( list val )
)
( setq val ( append ( cdr val ) '(0.0))
pnt_lst ( append pnt_lst ( list val ))
)
)
);progn
);if
);4
pnt_lst
);defun
;CODING ENDS HERE

The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website