I often need to break a line but not with a gap in between,just so that I can then set different parts of one line for different colours and linetypes.Ive found some lisp that will do what I wnat but how do I combine these two lisps so that all I need is to use one defun please?I'll then want to combine another lisp to these new combined lisp,which I'll do myself once someone has hopefully showed me how.
;;CADALYST 12/03 AutoLISP Solutions SPLINE-TO-PLINE.LSP
;;(c) 2003 Tony Hotchkiss
(defun spline-to-pline (/ i)
(vl-load-com)
(setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
) ;_ end of vla-get-activedocument
*modelspace* (vla-get-ModelSpace *thisdrawing*)
) ;_ end of setq
(setq spline-list (get-spline))
(setq i (- 1))
(if spline-list
(progn
(setq msg "\nNumber of segments <100>: ")
(initget 6)
(setq num (getint msg))
(if (or (= num 100) (= num nil))
(setq num 100)
) ;_ end of if
(repeat (length spline-list)
(setq splobj (nth (setq i (1+ i)) spline-list))
(convert-spline splobj num)
) ;_ end of repeat
) ;_ end of progn
) ;_ end of if
) ;_ end of spline-to-pline
(defun get-spline (/ spl-list obj spline no-ent i)
(setq spl-list nil
obj nil
spline "AcDbSpline"
selsets (vla-get-selectionsets *thisdrawing*)
ss1 (vlax-make-variant "ss1")
) ;_ end of setq
(if (= (vla-get-count selsets) 0)
(setq ssobj (vla-add selsets ss1))
) ;_ end of if
(vla-clear ssobj)
(setq no-ent 1)
(while no-ent
(prompt "\nSelect splines: ")
(vla-Selectonscreen ssobj)
(if (> (vla-get-count ssobj) 0)
(progn
(setq no-ent nil)
(setq i (- 1))
(repeat (vla-get-count ssobj)
(setq
obj (vla-item ssobj
(vlax-make-variant (setq i (1+ i)))
) ;_ end of vla-item
) ;_ end of setq
(cond
((= (vlax-get-property obj "ObjectName") spline)
(setq spl-list
(append spl-list (list obj))
) ;_ end of setq
)
) ;_ end-of cond
) ;_ end of repeat
) ;_ end of progn
(prompt "\nNo entities selected, try again.")
) ;_ end of if
(if (and (= nil no-ent) (= nil spl-list))
(progn
(setq no-ent 1)
(prompt "\nNo splines selected.")
(quit)
) ;_ end of progn
) ;_ end of if
) ;_ end of while
(vla-delete (vla-item selsets 0))
spl-list
) ;_ end of get-spline
(defun convert-spline (splobj n / i)
(setq point-list nil
2Dpoint-list nil
z-list nil
spl-lyr (vlax-get-property splobj 'Layer)
startSpline (vlax-curve-getStartParam splobj)
endSpline (vlax-curve-getEndParam splobj)
i (- 1)
) ;_ end of setq
(repeat (+ n 1)
(setq i (1+ i))
(setq p (vlax-curve-getPointAtParam
splobj
(* i
(/ (- endspline startspline) n)
) ;_ end of *
) ;_ end of vlax-curve-getPointAtParam
) ;_ end of setq
(setq 2Dp (list (car p) (cadr p))
2Dpoint-list (append 2Dpoint-list 2Dp)
point-list (append point-list p)
z (caddr p)
z-list (append z-list (list z))
) ;_ end of setq
) ;_ end of repeat
(setq summ (apply '+ z-list))
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble ; element type
(cons 0
(- (length point-list) 1)
) ; array dimension
) ;_ end of vlax-make-safearray
) ;_ end of setq
(setq vert-array (vlax-safearray-fill arraySpace point-list))
(vlax-make-variant vert-array)
(if (and (= :vlax-true (vlax-get-property splobj 'IsPLanar))
(= summ 0.0)
) ;_ end of and
(setq plobj (add-polyline
2Dpoint-list
vla-AddLightweightPolyline
) ;_ end of add-polyline
) ;_ end of setq
(setq plobj (add-polyline
point-list
vla-Add3DPoly
) ;_ end of add-polyline
) ;_ end of setq
) ;_ end of if
(vlax-put-property plobj 'Layer spl-lyr)
(vla-delete splobj)
(vlax-release-object splobj)
) ;_ end of convert-spline
(defun add-polyline (pt-list poly-func)
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble
(cons 0
(- (length pt-list) 1)
) ; array dimension
) ;_ end of vlax-make-safearray
) ;_ end of setq
(setq vertex-array
(vlax-safearray-fill arraySpace pt-list)
) ;_ end of setq
(vlax-make-variant vertex-array)
(setq plobj (poly-func
*modelspace*
vertex-array
) ;_ end of poly-func
) ;_ end of setq
) ;_ end of add-polyline
(defun c:s2p ()
(spline-to-pline)
(princ)
) ;_ end of c:s2p
(prompt
"SPLINE-TO-PLINE by Tony Hotchkiss. Enter S2P to start"
) ;_ end of prompt
(defun c:flex (/ osm pw a90 a180 a269 a270 a360 dw
dw2 ent ens typ lay fset arc lin n
in cir circ c10 c40 dia c50 c51 ln
ln1 ln2 ln3 ln4 lngth feq ang1 ang2 fno
nof p1 p2 p3 p4 p5 p6 p7 rang
angl1 angl2 angx angy ast apt line lang l10
l11 flength la lb dist np rn11
)
(progn
(command "_undo" "m")
(prompt "\nCommand - Flexible Duct")
(setvar "cmdecho" 0)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(command "highlight" 0)
(command "ucs" "w")
(setq pw (getvar "plinewid"))
(setvar "plinewid" 0)
(setq clay1 (getvar "CLAYER"))
(setq elay1 (tblsearch "layer" "d-general"))
(if (= elay1 nil)
(command "layer" "m" "d-general" "c" "8" "" "")
)
(setq elay2 (tblsearch "layer" "d-hidden"))
(if (= elay2 nil)
(command "layer" "m" "d-hidden" "c" "8" "" "lt" "hidden2" "" "")
)
(setq elay3 (tblsearch "layer" "d-centre"))
(if (= elay3 nil)
(command "layer" "m" "d-centre" "c" "8" "" "lt" "center2" "" "")
)
(setq a90 (* (/ 90.000 180) Pi))
(setq a180 (* (/ 180.000 180) Pi))
(setq a269 (* (/ 269.999 180) Pi))
(setq a270 (* (/ 270.000 180) Pi))
(setq a360 (* (/ 360.0000 180) Pi))
;;ENTER DUCT DIAMETER
(setq dw (getdist "\nEnter duct diameter :"))
(setq dw2 (/ dw 2))
;;SELECT POLYLINE
(setq ent (entsel "\nSelect Polyline :"))
(setq ens (entget (car ent)))
(setq typ (cdr (assoc 0 ens)))
(setq lay (cdr (assoc 8 ens)))
;;; (command "layer" "set" lay "")
(if (or (= typ "LWPOLYLINE") (= typ "POLYLINE"))
(command "explode" ent)
(progn
(command "pedit" ent "y" "") (command "explode" "l")
)
)
(setq fset (ssget "p"))
;;SELECT ARCS
(setq arc (ssget "p" (list (cons 0 "ARC"))))
(command "chprop" fset "" "c" "bylayer" "")
;;SELECT LINES
(setq lin (ssget "p" (list (cons 0 "LINE"))))
;;CHECK IF ARC'S EXIST
(if (/= arc nil)
(progn
;;CALCULATE No. OF ARC'S
(setq n (sslength arc))
(setq in 0)
;;START ROUTINE LOOP (arc's)
(repeat n
(setq cir (ssname arc in))
;;GET ARC DATA
(setq circ (entget cir))
;;GET CENTRE POINT OF ARC
(setq c10 (cdr (assoc 10 circ)))
;;GET RADIUS OF ARC
(setq c40 (cdr (assoc 40 circ)))
;;SET DIAMETER OF ARC
(setq dia (* (+ c40 dw2) 2))
;;CALCULATE LENGTH OF ARC
(setq c50 (cdr (assoc 50 circ)))
(setq c51 (cdr (assoc 51 circ)))
;;CALC LENGTH OF CIRCUFRENCE Pi x Dia
(setq ln1 (* Pi dia))
(setq ln2 (/ (/ (* 360 Pi) 180) (- c51 c50)))
(if (> (- c50 c51) a269)
(progn
(setq ln3 (+ (- a360 c50) c51))
(setq ln2 (/ (/ (* 360 Pi) 180) ln3))
)
)
(setq lngth (/ ln1 ln2))
;;CALCULATE ANGLES
(setq feq (/ (* Pi dia) 74))
(setq ang1 (/ (/ a360 feq) 2))
(setq ang2 (/ ang1 2))
;;CALCULATE LENGTH OF CENTRE
(setq ln3 (/ (/ (* 360 Pi) 180) ang1))
(setq ln4 (/ ln1 ln3))
;;CALCULATE No. OF FLEX'S
(setq fno (fix (/ lngth ln4)))
(setq fno (abs fno))
(setq nof (- fno 1))
;;DRAW FLEX
(command "layer" "s" "d-general" "")
(setq p2 (polar c10 c50 (- c40 dw2)))
(setq p3 (polar p2 c50 dw))
(setq p4 (polar c10 (+ ang2 c50) (- c40 (+ dw2 25))))
(setq p5 (polar p4 (+ ang2 c50) (+ dw 50)))
(setq p6 (polar c10 (+ ang1 c50) (- c40 dw2)))
(setq p7 (polar p6 (+ ang1 c50) dw))
(command "pline" p2 p4 p6 "")
(setq apt (ssget "l"))
(command "pline" p7 p5 p3 "")
(setq ast (entlast))
(ssadd ast apt)
(command "color" "bylayer")
(command "layer" "s" "d-general" "")
(command "line" p4 p5 "")
(setq ast (entlast))
(ssadd ast apt)
(command "color" "bylayer")
;;ARRAY FLEX
(setq rang (/ (* ang1 180) Pi))
(command "array" apt "" "p" c10 fno (* nof rang) "y")
;;DRAW LAST SECTION OF FLEX
(setq angl1 (* rang fno))
(setq angl2 (/ (* angl1 Pi) 180))
(if (> (- c50 c51) a269)
(setq c50 (- a180 c50))
)
(setq angx (+ c50 angl2))
(setq angy (+ angx (/ (- c51 angx) 2)))
(setq p5 (polar c10 c51 (- c40 dw2)))
(setq p6 (polar c10 c51 (+ c40 dw2)))
(if (> (- c50 c51) a269)
(setq c51 (+ a180 c51))
)
(setq p1 (polar c10 angx (+ c40 dw2)))
(setq p2 (polar c10 angx (- c40 dw2)))
(setq p3 (polar c10 angy (- c40 dw2 25)))
(setq p4 (polar c10 angy (+ c40 (+ dw2 25))))
(command "pline" p1 p4 p6 "")
(command "pline" p2 p3 p5 "")
(command "color" "bylayer")
(command "layer" "s" "d-general" "")
(command "line" p3 p4 "")
(command "color" "bylayer")
(setq in (1+ in))
;;END (repeat n) ROUTINE LOOP (arc's)
)
;;END PROGN (arc's)
)
;;END WHAT IF (arc's)
)
;;CHECK IF LINE'S EXIST
(if (/= lin nil)
(progn
;;CALCULATE No. OF LINES
(setq n (sslength lin))
(setq in 0)
;;START ROUTINE LOOP (line's)
(repeat n
(setq line (ssname lin in))
(setq ln (entget line))
;;GET LINE LENGTH
(setq l10 (cdr (assoc 10 ln)))
(setq l11 (cdr (assoc 11 ln)))
(setq flength (distance l10 l11))
;;GET AMOUNT OF FLEX'S
(setq fno (fix (/ flength 37)))
;;GET LINE ANGLE
(setq lang (angle l10 l11))
;;DRAW FLEX
(setq la (polar l10 lang 18.5))
(setq lb (polar la lang 18.5))
(setq p1 (polar l10 (+ lang a90) dw2))
(setq p2 (polar la (+ lang a90) (+ dw2 25)))
(setq p3 (polar lb (+ lang a90) dw2)) (setq p4 (polar lb (+ lang a270) dw2))
(setq p5 (polar la (+ lang a270) (+ dw2 25)))
(setq p6 (polar l10 (+ lang a270) dw2))
(command "pline" p1 p2 p3 "")
(setq apt (ssget "l"))
(command "pline" p4 p5 p6 "")
(setq ast (entlast))
(ssadd ast apt)
(command "color" "bylayer")
(command "layer" "s" "d-general" "")
(command "line" p2 p5 "")
(setq ast (entlast))
(ssadd ast apt)
(command "color" "bylayer")
(setq dist 37)
(repeat fno
(command "copy" apt "" l10 np)
(setq np (polar l10 lang dist))
(setq dist (+ dist 37))
)
(setq np nil)
;;FILL REMAINDER OF LINE
(setq rnl1 (/ (- flength (* 37 fno)) 2))
;;DRAW LAST SECTION OF FLEX IF (> rnl1 5)
(if (> rnl1 5)
(progn
(setq la (polar l11 (+ lang a180) rnl1))
(setq lb (polar la (+ lang a180) rnl1))
(setq p1 (polar l11 (+ lang a90) dw2))
(setq p2 (polar la (+ lang a90) (+ dw2 25)))
(setq p3 (polar lb (+ lang a90) dw2))
(setq p4 (polar lb (+ lang a270) dw2))
(setq p5 (polar la (+ lang a270) (+ dw2 25)))
(setq p6 (polar l11 (+ lang a270) dw2))
(command "pline" p1 p2 p3 "")
(command "pline" p4 p5 p6 "")
(command "color" "bylayer")
(command "layer" "s" "d-general" "")
(command "line" p2 p5 "")
(command "color" "bylayer")
)
(progn
(setq p1 (polar l11 (+ lang a90) dw2))
(setq p2 (polar p1 (+ lang a180) (* rnl1 2)))
(setq p3 (polar p2 (+ lang a270) dw))
(setq p4 (polar p3 lang (* rnl1 2)))
(command "layer" "s" "d-general" "")
(command "line" p1 p2 "")
(command "line" p3 p4 "")
)
;;END IF
)
(setq in (1+ in))
;;END (repeat n) ROUTINE LOOP (line's)
)
;;END WHAT IF (line's)
)
)
;;TURN HIGHLIGHT ON
(command "highlight" 1)
;;ERASE CONSTRUCTION LINE
(command "erase" fset "")
(setvar "osmode" osm)
(command "ucs" "p")
(command "layer" "s" clay1 "")
(princ)
)
;;END ROUTINE
)
