Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

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

2 REPLIES 2
Reply
Message 1 of 3
JPB143
1978 Views, 2 Replies

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

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.
2 REPLIES 2
Message 2 of 3
Anonymous
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:part ( / 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
Message 3 of 3
ademontis
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

 

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost