PDA

View Full Version : Extend/Lengthen MLINES



jake77777
7th Oct 2010, 11:28 pm
Hi,
I hope I'm not far off..trying to quick select all mlines and extend all 2"...Unfortunately, I soon discovered I couldn't use a lisp Lee generously provided to post studs/point loads (shown 4" solid blocks) at the end of all the beams/hdrs very effectively unless they extended 2" over the wall. I did finally worked out my first lisp first lisp ever while trying to work this out! It quick selects all mlines..haha. Below is the code I was hoping to modify for the 2" extend on both ends..Appreciate all help.




---------------------------------------------------------------------

(defun c:EXTENDMLINES (/ lSet tmp doMode objLst actDoc)
;; *lDel global variable remembered during session
(or *lDel (setq *lDel 2.0)) ; default value
(princ "\n>>> Select lines to extend/reduce <<< ")
(if (setq lSet
(ssget ":L" ; reject locked layers
'((0 . "*,MLINE")
(8 . "str-txt")
)
)
)

(progn
;; Get length to extend, Enter uses default length
(initget (+ 2 4)) ; No zero, no negitive
(cond
((setq tmp (getdist (strcat "\nSpecify delta: <" (rtos *lDel 2 2) "> ")))
(setq *lDel tmp))
)


;; Get Mode, default to "Both"
(initget "Positive Negative Both")
(cond
((null
(setq doMode (getkword "\nSpecify direction [Positive/Negative/Both] <Both>: ")))
(setq doMode "Both"))
)
;; Convert selection set to a list of objects
(setq objLst (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex lSet)))))
(vla-startundomark
(setq actDoc (vla-get-activedocument (vlax-get-acad-object))))
;; Lengthen the lines
(foreach ln objLst
(if (member doMode '("Negative" "Both"))
(vlax-put ln
'startpoint
(polar (vlax-get ln 'startpoint) (vlax-get ln 'angle) (- *lDel))
)
)
(if (member doMode '("Positive" "Both"))
(vlax-put ln
'endpoint
(polar (vlax-get ln 'endpoint) (vlax-get ln 'angle) *lDel)
)
)
)
(vla-endundomark actDoc)
)
)
(princ)
)
(prompt "\nLengthen Lines Loaded, Enter extendmlines to run.")
(princ)/



(defun c:QSML2 (/ ss)
(sssetfirst nil (setq ss (ssget '((0 . "MLINE")))))
(princ)
)