Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
New Member
JPB143
Posts: 2
Registered: ‎10-06-2008
Message 1 of 3 (994 Views)

Lisp routine to break line when inserting block (from a palette)

994 Views, 2 Replies
10-13-2008 11:04 AM
I insert blocks using a tool palette. I am looking for a lisp routine that will automatically break the line at the edges of my block where I insert it (i.e. a valve on a process line in a P&ID). Though I have read some information online regarding lisp routines and how they are created, I have never actually created one myself and am curious to see if anyone has already written one for what I'm looking for. Most importantly, it has to work with tool palettes. Thanks.
*George Drayton
Message 2 of 3 (992 Views)

Re: Lisp routine to break line when inserting block (from a palette)

10-14-2008 06:26 PM in reply to: JPB143
Try the routine below. copy the text into a file say in Notepad and
save it as a useful name e.g. symbol-insert.lsp. Note the extension
must be "lsp". Put the file into the AutoCAD search path.

Load the routine with
(load" symbol-insert")

This defines a new command called "part"

At the command prompt type "part" (no quotes) and follow the
instructions. This routine can be modified to suit you. If yoju need
some help email me george.drayton at cd-cad.co.nz



;;;This routine shows automatic part numbering
;;; Very old code but refined by George Drayton 22/7/00
;;; Stores last number in user variable useri2

;;; Converted from cap.lsp to res.lsp 19/02/02

;;; added bline function and mods to automatically break lines if they
exist under the insertion point 18/4/02
;;; fixed damaged file 19/4 improved looping

;;;made into general purpose routine 19/4/02

;;; This version creates and inserts a 25 x 50 rectangle which has been
made into a block called'part' (via (makeblock)
;;; with an auto-number (height=10 in line 36) in the centre
;;; If a line, lwpolyline or polyline is detected underneath the
insertion point it will break the line.
;;; This uses the (bline) function with appropriate parameters.

;;; To customise, change code to create/find your own block symbol and
change name of this part line 94 & break length in Line 95


(defun c:smileytongue:art ( / ang arad attribute looptest olderror point
previous_no startdefault startno startno$ blockss osmode
attdia previous_no start_no startdefault)

(setvar "cmdecho" 1);testing
(setvar "cmdecho" 0)
(setq attdia (getvar "attdia"))
(setvar "attdia" 0)
(setq olderror *error*)
(setq *error* gderror)
(setq osmode (getvar "osmode"))
(setvar "osmode" 512);;;nearest
(setvar "orthomode" 1)
(command "-style" "arial" "arial.ttf" "" "" "" "" "")
(setq textheight 10)


;;;Create part and turn it into a block with (MakeBlock) function
defined below


(command "rectang" "0,-12.5" "50,12.5")
(setq blockss (ssadd))
(ssadd (entlast) blockss)
(MakeBlock blockss "part" '(0.0 0.0 0.0) T)


(if (not (tblsearch "block" "part"))
(progn
(alert "A block called 'Part' cannot be found. This not good. \n I
have to exit.")
(exit)
)
)

(setq previous_no (getvar "useri2")) ;checks if last number used has
been stored
(if (/= previous_no 0)
(setq startno (1+ previous_no))
) ;_ end of if

(if (not startno)
(setq startdefault 1)
(setq startdefault startno)
) ;_ end of if
(terpri)
(setq startno (getint (strcat "\nWhat is the starting number for the
Parts:? <"
(itoa startdefault)
">"
) ;_ end of strcat
) ;_ end of getint
) ;_ end of setq
(if (= startno nil)
(setq startno startdefault)
(setq startdefault startno)
) ;_ end of if
(princ)


(while
(setq point
(getpoint "\nShow the insertion point...( or Esc to
Quit):"
) ;_ end of GETPOINT
) ;_ end of SETQ
(setq inspoint point)
(if insPoint
(progn
(setq startno$ (itoa startno)) ;starting no. converted to a string
;;; (setq attribute (strcat "R" startno$))
;;; ;to make the string into the
form 'C21'.
(setq arad (getangle insPoint "What is the angle <0>: "))
(if (= arad nil)
(setq arad 0)
) ;_ end of if
;;; (setq ang (fix (+ (/ (* arad 180.0) pi) 0.5)))
(setq ang (/ (* 180.0 arad) pi))
(command "insert" "part" inspoint "1" "1" ang)
(bline inspoint 50 ang);;;breakline action
(setvar "osmode" 0);; 19/03/06
(command "text" "j" "m" (polar inspoint arad 25) textheight ang
startno$ )
(setvar "useri2" startno) ;updates variable to store last
used number
(setq startno (1+ startno))
(setq startdefault startno)
) ;end progn
(exit)
) ;end if

) ;_ end of WHILE

(setq *error* olderror)
(setvar "attdia" attdia)
(setvar "osmode" osmode)
(princ)
);end defun

;;; Error handler
(defun gderror (msg)
(setq emsg msg)
(if (/= msg "quit / exit abort") ;
(prompt msg)
) ;_ end of if
(setq *error* olderror)
(setvar "attdia" attdia)
(setvar "osmode" osmode)
(princ)

) ;_ end of defun

(princ)
;;; line breaking funtion defined here

(defun bline (pick gap breakangle / osmode pick1 pick2 selection_set
entity_name angelrad breakpoint)
(setq osmode (getvar "osmode"))
(setvar "osmode" 512) ;nearest
(setq pickpoint pick)
(setq pick1 (list (- (car pickpoint) 1) (- (cadr pickpoint) 1)))
;create a snall window
(setq pick2 (list (+ (car pickpoint) 1) (+ (cadr pickpoint) 1)))
(setq selection_set (ssget "F" (list pick1 pick2) '((-4 . " "LINE")
(0 . "LWPOLYLINE")
(0 . "POLYLINE")
(-4 . "OR>")))
)
;;; (setq selection_set (ssget "F" (list pick1 pick2) ))

(if selection_set
(setq entity_name (ssname selection_set 0));;;;use first item in
selection set only

;;; (prompt "\nNo entity to select at this point.")
) ;_ end of if
(setq anglerad (/ (* breakangle pi) 180)) ;convert to radians
(setq breakpoint (polar pickpoint anglerad gap))
(if (and selection_set entity_name pickpoint breakpoint)
(command "break" entity_name pickpoint breakpoint)
) ;_ end of if
(setvar "osmode" osmode)
(princ)
) ;_ end of defun
(princ)




;;;block-create.lsp
;;; info from AutoCAD newsgroup & Jon Fleming
;;; to create a block with lisp
;;; G Drayton 1/1/00

(defun test (e1 e2 / SelSet)
;;;e1 and e2 entity names of entities for block
;;;manually created with (setq e1 (car(entsel)))
(setq SelSet (ssadd))
(ssadd e1 SelSet)
(ssadd e2 SelSet)
(MakeBlock SelSet "TEST_BLOCK" '(0.0 0.0 0.0) T)
(prin1)
) ;_ end of defun

;; Make a block from a selection set. Arguments are the selection set,
;; a string contianing the name of the block, a list of three numbers
;; defining the insertion point, and a flag (NIL to leave the original
;; entities in the drawing, non-NIL to delete the original entities).

;;; * * * * MAIN FUNCTION * * * * *

(defun MakeBlock
(SelSet BlockName InsertPoint DeleteEntitiesFlag / Counter)
(entmake (list '(0 . "BLOCK")
(cons 2 BlockName)
'(8 . "0")
'(70 . 0)
(append (list 10) InsertPoint)
) ;_ end of list
) ;_ end of entmake
(setq Counter (sslength SelSet))
(while (<= 0 (setq Counter (1- Counter)))
(entmake (StripDXFPairs (entget (ssname SelSet Counter))))
(if DeleteEntitiesFlag
;;;should this be DeleteEntitiesFlag ?
(entdel (ssname SelSet Counter))
) ;_ end of if
) ;_ end of while
(entmake '((0 . "ENDBLK")))
) ;_ end of defun

;; Strip the DXF pairs not allowed in an entmake call from an
;; Entity Association List. Returns the EAL minus the stripped
;; pairs.
(defun StripDXFPairs (EList / CodesToStrip ReturnList)
(setq CodesToStrip '(5))
(foreach DXFPair EList
(if (not (member (car DXFPair) CodesToStrip))
(setq ReturnList (cons DXFPair ReturnList))
) ;_ end of if
) ;_ end of foreach
(reverse ReturnList)
) ;_ end of defun

(princ)



;|«Visual LISP© Format Options»
(100 2 40 1 T "end of " 60 9 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;


George Drayton CD-CAD Ltd Christchurch New Zealand
Active Member
ademontis
Posts: 7
Registered: ‎12-07-2010
Message 3 of 3 (955 Views)

Re: Lisp routine to break line when inserting block (from a palette)

12-07-2010 04:52 AM in reply to: JPB143

Goodmorning,

this routine would be very useful for my goal, I am a P&IDs cad engineer and always looked for a routine like this...

i tried to use it but i get the following error on the VisualLisp editor

 

Command: ; error: misplaced dot on input
Command:

 

sadly it doesn't indicate on what line in the code.

 

Could it be because of some incompatibility? I use AutoCAD 2008

 

Thanks in advance,

Alex Demontis

Rome

 

 

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community