Heres another:
;
; This routine joins two lines, two arcs, two 3dfaces, or two text items
; together. If arcs are selected, they must share a common center point and radius.
; For lines there is no such restriction. Two lines of different angles can be
; joined. The program loops to allow several pairs of objects to be joined.
;
; When gluing text together, the text value of the second selected text
; item is added on to the first. A space is inserted between text items.
;
;;**********Required Functions*******************
;
;replaces needing to use (cdr (assoc type number) functions
;
(defun dxf ( CODE ELIST / A)
(SETQ A (CDR (ASSOC CODE ELIST)))
(IF (NOT A)
(IF (OR (= CODE 38) (= CODE 39)) (SETQ A 0.0)
)
)A
)
;--------------------------------------------------------------
; Function that finds the max point between 2 point lists.
; Used to join 3dfaces. Subsequent calls can pass a test point not to match
;
(defun glue1 (pt1 pt2 dist testpt / n o retpt)
(foreach n pt1
(foreach o pt2
(if (> (distance n o) dist)
(progn
(if (and testpt (not (equal (distance o testpt) 0.0 0.001)))
(setq retpt o dist (distance n o))
)
(if (null testpt)
(setq retpt o dist (distance n o))
)
)
)
)
)
retpt
)
;--------------------------------------------------------------
; Main program
;
(defun c:glue ( / ent1 ent2 temp lpt1 lpt2 lpt3 lpt4 endpt endpt1 midpt midpt1 pt1 pt2 pt3 pt4
elist1 elist2 ang1 ang2 es)
(prompt "\nGlue arcs, lines, text, 3dfaces together...")
(while (/= "Done" (setq es (entsel "\nPick first entity")))
(setq ent1 (car es))
(eval '(if ent1 (redraw ent1)))
(redraw ent1 3)
(while (not (setq ent2 (car (entsel "\nPick second entity" ))))
(prompt "\nTry again.")
)
(setq elist1 (entget ent1) elist2 (entget ent2) pt1 nil pt2 nil pt3 nil pt4 nil)
(cond
;*************** BOTH ARCS **********************************
((and ent1 ent2 (not (equal ent1 ent2)) (= (dxf 0 elist1) "ARC")
(= (dxf 0 elist2) "ARC"))
(setq pt1 (dxf 10 elist1)
arclay (dxf 8 elist1); GET LAYER FROM FIRST ARC
pt3 (dxf 10 elist2)
)
(if (equal (distance pt1 pt3) 0.0 0.001)
(progn; SAME CENTER POINT
(setq lpt1 (polar pt1 (dxf 50 elist1) (dxf 40 elist1))
lpt2 (polar pt1 (dxf 51 elist1) (dxf 40 elist1))
lpt3 (polar pt3 (dxf 50 elist2) (dxf 40 elist2))
lpt4 (polar pt3 (dxf 51 elist2) (dxf 40 elist2))
thick (dxf 39 elist1)
)
(if (< (distance lpt1 lpt4) (distance lpt2 lpt3))
(command "_.arc" lpt3 lpt1 lpt2)
(command "_.arc" lpt1 lpt2 lpt4)
)
(command "_.erase" ent1 ent2 ""); ERASE BOTH EXISTING ARCS
(command "_.chprop" (entlast) "" "_la" arclay "_t" thick "")
)
(progn
(eval '(if ent1 (redraw ent1)) zz#t)
(prompt "\nArcs must have same center point")
)
)
)
;*************** BOTH LINES **********************************
((and ent1 ent2 (not (equal ent1 ent2))
(= (dxf 0 elist1) "LINE")
(= (dxf 0 elist2) "LINE"))
(setq lpt1 (dxf 10 elist1)
lpt3 (dxf 10 elist2)
lpt4 (dxf 11 elist2)
)
(command "_.erase" ent2 "")
(setvar "orthomode" 0)
(if (> (distance lpt1 lpt3) (distance lpt1 lpt4))
(command "_.change" ent1 "" (trans lpt3 0 1))
(command "_.change" ent1 "" (trans lpt4 0 1))
)
)
;
;*************** BOTH 3DFACES ********************************
((and ent1 ent2 (not (equal ent1 ent2))
(= (dxf 0 elist1) "3DFACE")
(= (dxf 0 elist2) "3DFACE"))
; create point list of each ent
(setq pt1 (cons (dxf 10 elist1) pt1)
pt1 (cons (dxf 11 elist1) pt1)
pt1 (cons (dxf 12 elist1) pt1)
pt1 (cons (dxf 13 elist1) pt1)
pt2 (cons (dxf 10 elist2) pt2)
pt2 (cons (dxf 11 elist2) pt2)
pt2 (cons (dxf 12 elist2) pt2)
pt2 (cons (dxf 13 elist2) pt2)
)
; eval point lists
(if (and pt1 pt2)
(progn
; find max points
(setq lpt1 (pp_glue1 pt1 pt2 0 nil)
lpt2 (glue1 pt1 pt2 0 lpt1)
lpt3 (glue1 pt2 pt1 0 nil)
lpt4 (glue1 pt2 pt1 0 lpt3)
)
; erase existing faces
(command "_.erase" ent1 ent2 "")
; create new face
(if (inters lpt1 lpt4 lpt3 lpt2)
(entmake
(list (assoc 0 elist1) (assoc 8 elist1) (append '(10) lpt1)
(append '(11) lpt3) (append '(12) lpt4) (append '(13) lpt2)
)
)
(entmake
(list (assoc 0 elist1)(assoc 8 elist1)(append '(10) lpt1)
(append '(11) lpt4)(append '(12) lpt3)(append '(13) lpt2)
)
)
)
)
)
);added 10-02-98
;*************** BOTH TEXT **********************************
((and ent1 ent2 (not (equal ent1 ent2))
(= (dxf 0 elist1) "TEXT")
(= (dxf 0 elist2) "TEXT"))
(setq text1 (strcat (dxf 1 elist1) " " (dxf 1 elist2))
elist1 (subst (cons 1 text1) (assoc 1 elist1) elist1)
)
(entdel ent2)
(entmod elist1)
)
;
;*************** SAME ENTITY *******************************
((equal ent1 ent2)
(eval '(if ent1 (redraw ent1)) zz#t)
(prompt "\nDon't pick the same entity twice!")
)
;
;*************** MISMATCH **********************************
((and ent1 ent2)
(eval '(if ent1 (redraw ent1)) zz#t)
(prompt "\nThe 2 entities must be the same type.")
)
); end cond
); end while
(princ)
); end defun
Does the Architects drawing look like its been hand drawn,sketch effect and loads of broken lines?If so Ive met their realtives
