So far I have a lisp that will offset from the centerline 2 directions at a keyed in distance, then change the original centerline to a different layer & linetype. I would like to be able to change the layername of the original object to something similar to the original but with CL in it.....see the following.
;if LAYERNAME= "R-UTIL-CATV-LINES" create & change to "R-UTIL-CATV-CL-LINES"
;if LAYERNAME= "R-UTIL-ELEC-LINES" create & change to "R-UTIL-ELEC-CL-LINES"
;if LAYERNAME= "R-UTIL-GAS-LINES" create & change to "R-UTIL-GAS-CL-LINES"
;if LAYERNAME= "R-UTIL-IRR-LINES" create & change to "R-UTIL-IRR-CL-LINES"
;if LAYERNAME= "R-UTIL-SD-LINES" create & change to "R-UTIL-SD-CL-LINES"
;if LAYERNAME= "R-UTIL-SS-LINES" create & change to "R-UTIL-SS-CL-LINES"
;if LAYERNAME= "R-UTIL-TELE-LINES" create & change to "R-UTIL-TELE-CL-LINES"
;if LAYERNAME= "R-UTIL-WTR-LINES" create & change to "R-UTIL-WTR-CL-LINES"
Any help would be appreciated
Question for you
The original (source) object are named under he layers listed below?
"R-UTIL-CATV-LINES"
"R-UTIL-ELEC-LINES"
"R-UTIL-GAS-LINES"
"R-UTIL-IRR-LINES"
"R-UTIL-SD-LINES"
"R-UTIL-SS-LINES"
"R-UTIL-TELE-LINES"
"R-UTIL-WTR-LINES"
and the newly created (after offset) objects will inherit this name and convert the source to
R-UTIL-CATV- CL-LINES"
"R-UTIL-ELEC-CL-LINES"
"R-UTIL-GAS-CL-LINES"
"R-UTIL-IRR-CL-LINES"
"R-UTIL-SD-CL-LINES"
"R-UTIL-SS-CL-LINES"
"R-UTIL-TELE-CL-LINES"
"R-UTIL-WTR-CL-LINES"
and if the soures;' layer name is other than the one listed, it will not push thorugh?
Is this correct?
Try this
(defun C:UTOL (/ adoc lyrs ltypes objSelection fr_nm nlyr) (vl-load-com) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) lyrs (vla-get-layers adoc) ltypes (vla-get-linetypes adoc)) (while (not (setq objs (ssget '((8 . "*-LINES")(8 . "~*CL-LINES")))))) (setq sngDistance (cond ((getint (strcat "\nEnter Offset Distance <" (rtos (setq sngDistance (cond ( sngDistance ) ( 1.00 )) ) 2 3 ) ">: "))) (sngDistance))) (foreach objSelection (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr(ssnamex objs))) ) (vla-offset objSelection sngDistance) (vla-offset objSelection (- sngDistance)) (vla-add lyrs (setq nlyr (strcat (substr (setq fr_nm (vla-get-layer objSelection)) 1 (- (strlen fr_nm ) 6)) "-CL-LINES"))) (vla-add ltypes "Center") (vla-put-linetype (vla-item lyrs nlyr) "Center") (vla-put-layer objSelection nlyr) ) (princ) )
fonts in BLUE are the modified/additional codes
Modifications from the original code
And for the other way around (objects on R-UTIL-XXXX- CL_LINES" layers)
(defun C:LOTU (/ chlyr adoc lyrs ltypes objSelection fr_nm nlyr) (vl-load-com) (defun chlyr (ob lyrnm ) (vla-put-layer (car (vlax-safearray->list (vlax-variant-value ob))) lyrnm) ) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) lyrs (vla-get-layers adoc) ltypes (vla-get-linetypes adoc)) (while (not (setq objs (ssget '((8 . "*CL-LINES")))))) (setq sngDistance (cond ((getint (strcat "\nEnter Offset Distance <" (rtos (setq sngDistance (cond ( sngDistance ) ( 1.00 )) ) 2 3 ) ">: "))) (sngDistance))) (foreach objSelection (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr(ssnamex objs))) ) (vla-add lyrs (setq nlyr (strcat (substr (setq fr_nm (vla-get-layer objSelection)) 1 (- (strlen fr_nm) 8)) "LINES"))) (chlyr (vla-offset objSelection sngDistance) nlyr) (chlyr (vla-offset objSelection (- sngDistance)) nlyr) ) (princ) )
Hope this helps
The below lisp works great, only one issue. Value must be an integer, or to go even urther we work in Decimal units. Can it take the value of the offset and divide it by 24 so If I type 36 instead of entering 1.5 (which would be 18" each side) I would get a 36" (3ft) offset from line to line.
(defun C:UTOL (/ adoc lyrs ltypes objSelection fr_nm nlyr)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
lyrs (vla-get-layers adoc) ltypes (vla-get-linetypes adoc)) (while (not
(setq objs (ssget '((8 . "*-LINES")(8 . "~*CL-LINES"))))))
(setq sngDistance (cond ((getint (strcat "\nEnter Offset Distance <"
(rtos (setq sngDistance
(cond ( sngDistance ) ( 1.00 )) ) 2 4 ) ">: ")))
(sngDistance)))
(foreach objSelection (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex objs)))
)
(vla-offset objSelection sngDistance)
(vla-offset objSelection (- sngDistance))
(vla-add lyrs (setq nlyr (strcat (substr (setq fr_nm (vla-get-layer objSelection)) 1 (- (strlen fr_nm ) 6)) "-CL-LINES")))
(vla-add ltypes "Center")
(vla-put-linetype (vla-item lyrs nlyr) "Center")
(vla-put-layer objSelection nlyr)
)
(princ)
)
Thank you again for your help.
@kelam999 wrote:So far I have a lisp that will offset from the centerline 2 directions at a keyed in distance, then change the original centerline to a different layer & linetype. I would like to be able to change the layername of the original object to something similar to the original but with CL in it.....see the following.
;if LAYERNAME= "R-UTIL-CATV-LINES" create & change to "R-UTIL-CATV-CL-LINES"
....
A few comments:
A great majority of threads on this forum are asking for help with Lisp routines--that doesn't tell anyone much. To increase the odds of catching the attention of someone who has an answer in the future, check out:
http://catb.org/~esr/faqs/smart-questions.html
Would it be useful to restrict object selection to things that can be offset to prevent the routine from crashing? Here's how I do that in another routine, in a select-one-at-a-time situation:
....
(while
(not
(and
(setq offent (ssget ":S" '((0 . "LINE,ARC,CIRCLE,ELLIPSE,LWPOLYLINE,SPLINE,XLINE,RAY"))))
(= (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 (entget (ssname offent 0))))))) 0); 0 for Unlocked, 4 for Locked
); end and
); end not
(prompt "\nSelected Entity cannot be Offset, or is on a Locked Layer; try again: ")
); end while
...... do your thing with 'offent' ......
Something similar could be used on individual entities in a selection set to ignore un-offsettable ones, rather than try to offset them and run into a problem.
And another way to build a layer name with -CL in it from one that ends with -LINES without the -CL:
(if (not (wcmatch oldlayer "*-CL-*"))
(setq newlayer (vl-string-subst "-CL-LINES" "-LINES" oldlayer))
)
@kelam999 wrote:.... Value must be an integer, or to go even urther we work in Decimal units. Can it take the value of the offset and divide it by 24 so If I type 36 instead of entering 1.5 (which would be 18" each side) I would get a 36" (3ft) offset from line to line.
.....
Let me get this straight -- you work in decimal units with a drawing unit being a foot, but you want to enter the width in inches? That seems like an invitation to trouble, but you could do it that way if you change the prompt to make it clear:
(setq
sngDistance
(/ ; <--- added
(cond
(
(getint
(strcat
"\nEnter Overall Width IN INCHES <" ; <--- edited
(rtos
(setq sngDistance
(cond
( sngDistance )
( 1.00 )
); end cond
); end setq
2 4
); end rtos
">: "
); end strcat
); end getint
); end first condition
(sngDistance); second condition
); end cond
24.0 ; <--- added
); end / ; <--- added
); end setq
But I confess to being confused as to why it's been changed to (getint) from the (getdist) in the original. If you're asking about entering 36 and dividing it by 24 only because (getint) requires an integer, then just don't use (getint). Using (getdist) instead means, of course, that if you want to type in a number, it needs to be in the proper drawing units [presumably feet in this case], but A) it isn't restricted to an integer value, and B) it allows the User the option of either typing something or specifying the distance by picking two points on-screen if they prefer.
But if you want to give a number that represents the total width between the resulting sides, not the offset distance of each of those from the center, then even if you go back to (getdist) and get input in feet, you'll still need to divide by 2, rather than by 24.
Thank you to everyone that helped. Below is the actual lisp that works for my use.
(defun C:UTOL (/ adoc lyrs ltypes objSelection fr_nm nlyr)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
lyrs (vla-get-layers adoc) ltypes (vla-get-linetypes adoc)) (while (not
(setq objs (ssget '((8 . "*-LINES")(8 . "~*CL-LINES"))))))
(setq sngDistance (/
(cond ((getdist (strcat "\nDiameter of Pipe <"
(rtos (setq sngDistance
(cond ( sngDistance ) ( 1.00 )) ) 2 4 ) ">: ")))
(sngDistance))24.0))
(foreach objSelection (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex objs)))
)
(vla-offset objSelection sngDistance)
(vla-offset objSelection (- sngDistance))
(vla-add lyrs (setq nlyr (strcat (substr (setq fr_nm (vla-get-layer objSelection)) 1 (- (strlen fr_nm ) 6)) "-CL-LINES")))
(vla-add ltypes "Center")
(vla-put-linetype (vla-item lyrs nlyr) "Center")
(vla-put-layer objSelection nlyr)
)
(princ)
)
@Kent1Cooper wrote:
And another way to build a layer name with -CL in it from one that ends with -LINES without the -CL:
(if (not (wcmatch oldlayer "*-CL-*"))
(setq newlayer (vl-string-subst "-CL-LINES" "-LINES" oldlayer))
)
Nice suggestion Kent