139 lines
3.8 KiB
Common Lisp
139 lines
3.8 KiB
Common Lisp
|
|
;|
|
|
PT2BLOCK.LSP
|
|
Michael Weaver
|
|
2175 George Road
|
|
Fairbanks, Alaska 99712
|
|
(907)488-3577 voice and fax
|
|
Email:71461.1775@compuserve.com
|
|
Mike_Weaver_Alascad@compuserve.com
|
|
Fri 02-23-1996
|
|
(c)1996 Alascad
|
|
|
|
|
|
|
|
This routine will replace points (nodes) in the current drawing will
|
|
insertions of a specified block. The insertion scale factor and the
|
|
rotation angle for block are supplied by the operator.
|
|
|
|
Example:
|
|
|
|
command: PT2BLOCK
|
|
Name of block to insert: MYBLOCK
|
|
Insertion scale factor: 1
|
|
Insertion rotation angle: 0
|
|
Select points: <Select points to replace>
|
|
|
|
Replace MYBLOCK with the name of your block. An enter at the
|
|
Select points prompt will select all points in the drawing database
|
|
(current space and excluding points found on layer DEFPOINTS).
|
|
|
|
The blocks will be inserted on the same layer as the points.
|
|
|
|
|;
|
|
|
|
(defun c:pt2block(; replace points with blocks
|
|
/; no arguments
|
|
attreq; value to restore
|
|
cmdecho; value to restore
|
|
bname; block name to insert
|
|
temp; temp variable
|
|
ent; entity name
|
|
elist; entity list
|
|
scf; insertion scale factor
|
|
rotang; insertion rotation angle
|
|
ss1; selection set of points
|
|
indx; index through selection set
|
|
sslen; number of points selected
|
|
inspt; insertion point
|
|
); end of local variable list
|
|
(if (and
|
|
(setq
|
|
bname (getstring "\nName of block to insert: ")
|
|
temp (/= "" bname)
|
|
)
|
|
(progn
|
|
(if (or
|
|
(tblsearch "BLOCK" bname); the block exists in the drawing
|
|
(findfile (strcat bname ".dwg")); the block can be pulled from disk
|
|
); end or
|
|
T; continue
|
|
(progn
|
|
(alert (strcat "Block " bname " not found."))
|
|
nil
|
|
); end progn
|
|
); end if block found?
|
|
); end progn check for block
|
|
(setq scf (getreal "\nInsertion scale factor: "))
|
|
(setq rotang (getangle "\nInsertion rotation angle: "))
|
|
(setq
|
|
ss1 (ssget
|
|
'((0 . "POINT"); get points
|
|
(-4 . "<NOT"); not on
|
|
(8 . "DEFPOINTS"); layer DEFPOINTS
|
|
(-4 . "NOT>"); end not
|
|
); end the quoted filter list
|
|
); end ssget
|
|
temp (if (and ss1 (< 0 (sslength ss1))); was anything selected
|
|
T
|
|
(setq
|
|
ss1 (ssget
|
|
"X"
|
|
'((0 . "POINT"); get points
|
|
(-4 . "<NOT"); not on
|
|
(8 . "DEFPOINTS"); layer DEFPOINTS
|
|
(-4 . "NOT>"); end not
|
|
); end the quoted filter list
|
|
); end ssget
|
|
); end setq (nested)
|
|
); end if?
|
|
); end setq (outer)
|
|
(if (< 0 (sslength ss1))
|
|
T
|
|
(progn
|
|
(alert "No points found.")
|
|
nil
|
|
); end progn
|
|
); end if points found?
|
|
); end and
|
|
(progn
|
|
(setq
|
|
attreq (getvar "attreq"); value to restore
|
|
cmdecho (getvar "cmdecho"); value to restore
|
|
indx -1; a counter
|
|
sslen (sslength ss1); number of points selected
|
|
)
|
|
(setvar "attreq" 0)
|
|
(setvar "cmdecho" 0)
|
|
(while (> sslen (setq indx (1+ indx)))
|
|
(setq
|
|
ent (ssname ss1 indx); entity name
|
|
elist (entget ent); entity list
|
|
inspt (cdr (assoc 10 elist));location of the point
|
|
inspt (trans inspt ent 1)
|
|
); end setq
|
|
(entmake
|
|
(list
|
|
'(0 . "INSERT")
|
|
(cons 2 bname)
|
|
(assoc 8 elist)
|
|
(cons 10 inspt)
|
|
(cons 41 scf)
|
|
(cons 42 scf)
|
|
(cons 43 scf)
|
|
(cons 50 (* rotang (/ pi 180)))
|
|
(assoc 210 elist)
|
|
); end list
|
|
); end entmake
|
|
(entdel ent); get rid of the point
|
|
(princ "."); indicate progress
|
|
); end while
|
|
(setvar "attreq" attreq)
|
|
(princ (strcat "\t" (itoa sslen) " points replaced. "))
|
|
(command "_.redraw")
|
|
(setvar "cmdecho" cmdecho)
|
|
); end progn
|
|
); end if valid input?
|
|
(princ)
|
|
); end c:pt2block
|