;; SubDivide.lsp [command name: SD]
;; To SubDivide a finite linear object into a specified
;; number of equal-length contiguous sections.
;; Option: numerical quantity of sections, or Maximum
;; length of sections, however many are required.
;; Can also place Points at subdivision locations, if
;; desired [see commented-out Divide command].
;; Remembers choices and offers as defaults.
;; Works on anything of finite length that Break can
;; be used on [not Xlines or Rays].
;; Kent Cooper, last edited 30 December 2016
;
(defun C:SD
(/ *error* subdiv doc obj cmde blips osm esel ent etype
entlen secdef sectemp maxtemp secs seclen ent2 secs1 secs2)
;
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(setvar 'osmode osm)
(setvar 'blipmode blips)
(setvar 'cmdecho cmde)
(vla-endundomark doc)
); defun - *error*
;
(defun subdiv (obj brks)
(repeat brks
(command
"_.break"
obj
(trans (vlax-curve-getPointAtDist obj seclen) 0 1)
"@"
); command
(setq obj (entlast))
); repeat
); defun - subdiv
;
(vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
(setq
cmde (getvar 'cmdecho)
blips (getvar 'blipmode)
osm (getvar 'osmode)
); setq
(setvar 'cmdecho 0)
;
(while
(not
(and
(setq esel (ssget ":S" '((0 . "LINE,ARC,CIRCLE,*POLYLINE,ELLIPSE,SPLINE"))))
(= (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 (entget (ssname esel 0))))))) 0)
; 0 for Unlocked, 4 for Locked
); and
); not
(prompt "\nNothing selected, or not a finite path type, or on a Locked Layer; try again:")
); while
(setvar 'osmode 0)
(setvar 'blipmode 0)
(setq
ent (ssname esel 0)
etype (if ent (cdr (assoc 0 (entget ent))))
entlen (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
); setq
;
(initget 6 "Maximum"); no zero, no negative
(setq
secdef (if _sdsec_ _sdsec_ "Maximum")
; once set, _sdsec_ is either integer or "Maximum" [first-use default]
sectemp
(getint ; [returns nil on Enter]
(strcat
"\nEnter number of Sections, or M for Maximum length : "
); strcat
); getint and sectemp
_sdsec_ (if sectemp sectemp secdef)
; what User typed if other than Enter - if Enter, use default
); setq
(if (= _sdsec_ "Maximum")
(while
(not
(and
(progn
(if _sdmax_ (initget 38) (initget 39)); returns nil, so need (progn) wrapper
; no Enter on first use, no 0, no negative, dashed rubber-band if picked on-screen
(setq
maxtemp
(getdist
(strcat
"\nMaximum length of Sections"
(if _sdmax_ (strcat " ") ""); no default on first use
": "
); strcat
); getdist & maxtemp
_sdmax_ (cond (maxtemp) (_sdmax_))
; if User typed/picked something other than Enter, then - use it; else - default
); setq
); progn
(<= _sdmax_ entlen); Maximum length shorter than or equal to length of object
); and
); not
(prompt "\nObject is no longer than Maximum length.")
); while
); if
(setq secs
(if (numberp _sdsec_)
_sdsec_ ; then [number]
(if (zerop (rem entlen _sdmax_)); else [Maximum]
(fix (/ entlen _sdmax_))
(1+ (fix (/ entlen _sdmax_)))
); if and else
); if
seclen (/ entlen secs)
); setq
;
; (command "_.divide" ent secs) ; remove leading semicolon and this comment if Points are desired along with subdivision
(cond
( ; Circle or closed Ellipse/Spline [can't break at one point]
(and (wcmatch etype "CIRCLE,ELLIPSE,SPLINE") (vlax-curve-isClosed ent))
(command "_.copy" ent "" "0,0" "0,0"); make a copy in place
(setq
ent2 (entlast)
secs1 (/ secs 2)
secs2 (- secs secs1)
); setq
(command
"_.break"
ent
(trans (vlax-curve-getStartPoint ent) 0 1)
(trans (vlax-curve-getPointAtDist ent (* seclen secs1)) 0 1)
"_.break"
ent2
(trans (vlax-curve-getPointAtDist ent2 (* seclen secs1)) 0 1)
(trans (vlax-curve-getStartPoint ent2) 0 1)
); command
(subdiv ent (1- secs2))
(subdiv ent2 (1- secs1))
); Circle or closed Ellipse/Spline condition
(T ; everything else
(subdiv ent (1- secs))
); everything-else condition
); cond
;
(setvar 'osmode osm)
(setvar 'blipmode blips)
(setvar 'cmdecho cmde)
(vla-endundomark doc)
(princ)
); defun
(vl-load-com)
(prompt "Type SD to SubDivide a linear object.")

Advertisements