Jump to content

Multiple offset from a centre line at bothside from the distance and layers of the sample set

laijumalias

By laijumalias
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

laijumalias Explorer

laijumalias

Posted
Posted 
(defun C:KOF ( )
(vl-load-com)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 1)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq pb (getvar "pickbox"))
(setvar "pickbox" 0)
(setq pta (getpoint "\nPick at oneside of object to offset :"))
(setq ptb (getpoint Pta "\nPick at otherside of object to offset :"))
(setq pt3 (getpoint "\nPick at Farside of objects for sample :"))
(setq pt4 (getpoint pt3 "\nPick at Closeside of objects for sample :"))
(setq dis 0)
(setq ss1 (ssget "F" (list pta ptb)))
(setq ss2 (ssget "F" (list pt3 pt4)))
(setq num (sslength ss2))
(setq num2 (sslength ss1))
(if (>= num2 2)
(progn
(alert "\nSorry more than one object selected to offset, Error The program terminates:  ")
(exit)
)
)
(repeat num
(setq en (ssname ss1 0))
(setq en2 (ssname ss2 0))
(setq tp1 (cons (vlax-curve-getClosestPointTo en2 pt3) tp1))
(ssdel en2 ss2)   ; Delete each measured entity from set  
)   ; end repeat
(setq pt1 (nth 0 tp1))
(setq num (- num 1))
(setq x 0)
(repeat  num
(setq pt1d (nth x tp1))
(setq pt2d (nth (+ x 1) tp1))
(setq dis (+ dis (distance pt1d pt2d)))   ;  Find Distance between lines
(setq pt1 (nth (+ x 1) tp1))
;(setq ss (ssget pt1))
;(setq lo (ssname ss 0))
;(setq lay (cadr (assoc 8 (entget (car ss2)))))
;(setq EL1 (tblsearch "layer" AA))
;(setq lay (cadr(assoc 2 EL1)))
(command "-layer" "s" lay "")
(command "Offset" "l" "c" dis en pta en ptb "" ) 
(setq x (+ x 1))
)     ; end repeat 

(setvar "CMDECHO" cm)
(setvar "osmode" oldsnap)
(setvar "pickbox"pb)
)
(princ)
(alert "\n  Enter                                       KOF                                   to start  ")
(princ)

 

Please Help.  I am trying to write a Lisp to make a multiple offset at both sides from a fence selected sample objects, but I don't know how to get the properties of sample to the newly offseted objects. 

 

laijumalias Explorer

laijumalias

Posted
  • Author
Posted

Please see a Sample drawing with the current and expected outputs for more details.

test.dwg

confutatis Enthusiast

confutatis

Posted
Posted (edited) 
(defun C:KOF2 ( )
(vl-load-com)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 1)
(setq oldsnap (getvar "osmode"))

(setq poly (vlax-ename->vla-object (car (entsel "\Select axis polyline: "))))
(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 3.20)))))
(vla-put-Layer pline1 "RD_PR-LOK")
(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -3.20)))))
(vla-put-Layer pline1 "RD_PR-LOK")

(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 3.65)))))
(vla-put-Layer pline1 "RD_PR-IOK")
(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -3.65)))))
(vla-put-Layer pline1 "RD_PR-IOK")

(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 3.80)))))
(vla-put-Layer pline1 "RD_PR-BOK & TP")
(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -3.80)))))
(vla-put-Layer pline1 "RD_PR-BOK & TP")

(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 5.40)))))
(vla-put-Layer pline1 "SERV_PR-WAT-DW")
(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -5.40)))))
(vla-put-Layer pline1 "SERV_PR-WAT-DW")

(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 5.90)))))
(vla-put-Layer pline1 "SERV_PR-GAS")
(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -5.90)))))
(vla-put-Layer pline1 "SERV_PR-GAS")

(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 6.45)))))
(vla-put-Layer pline1 "RD_PR-FP")
(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -6.45)))))
(vla-put-Layer pline1 "RD_PR-FP")

(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 7.95)))))
(vla-put-Layer pline1 "RD_PR-FP")
(setq pline1 (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -7.95)))))
(vla-put-Layer pline1 "RD_PR-FP")

(setvar "CMDECHO" cm)
(setvar "osmode" oldsnap)

)
(princ)
(alert "\nEnter KOF2 to start  ")
(princ)

 

Edited by confutatis
confutatis Enthusiast

confutatis

Posted
Posted 
(defun C:KOF2 ( )
 (vl-load-com)
 (setq cm (getvar "cmdecho"))
 (setvar "cmdecho" 1)
 (setq oldsnap (getvar "osmode"))

 (setq poly (vlax-ename->vla-object (car (entsel "\Select axis polyline: "))))
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 3.20)))) "RD_PR-LOK")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -3.20)))) "RD_PR-LOK")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 3.65)))) "RD_PR-IOK")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -3.65)))) "RD_PR-IOK")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 3.80)))) "RD_PR-BOK & TP")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -3.80)))) "RD_PR-BOK & TP")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 5.40)))) "SERV_PR-WAT-DW")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -5.40)))) "SERV_PR-WAT-DW")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 5.90)))) "SERV_PR-GAS")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -5.90)))) "SERV_PR-GAS")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 6.45)))) "RD_PR-FP")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -6.45)))) "RD_PR-FP")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly 7.95)))) "RD_PR-FP")
 (vla-put-Layer (car (vlax-safearray->list (vlax-variant-value (vla-offset poly -7.95)))) "RD_PR-FP")

 (setvar "CMDECHO" cm)
 (setvar "osmode" oldsnap)
 (princ)
)

(alert "\nEnter KOF2 to start")

 

A little more efficient...

ronjonp Grand Master

ronjonp

Posted
Posted

Give this a try:
  

(defun c:foo (/ a o s)
  ;; RJP » 2021-07-06
  (cond	((setq s (ssget ":L" '((0 . "LWPOLYLINE"))))
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   ;; Put offset object on correct layer
	   (entmod (append (entget e) '((8 . "RD_PR-CL"))))
	   (setq o (vlax-ename->vla-object e))
	   ;; List of layers and distances
	   (foreach i '(("RD_PR-LOK" 3.2)
			("RD_PR-IOK" 3.65)
			("RD_PR-BOK & TP" 3.8)
			("SERV_PR-WAT-DW" 5.4)
			("SERV_PR-GAS" 5.9)
			("RD_PR-FP" 6.45)
			("RD_PR-FP" 7.95)
		       )
	     ;; Offset both sides
	     (foreach n	(list (cadr i) (- (cadr i)))
	       (if (= 'list (type (setq a (vl-catch-all-apply 'vlax-invoke (list o 'offset n)))))
		 (entmod (append (entget (vlax-vla-object->ename (car a))) (list (cons 8 (car i)))))
	       )
	     )
	   )
	 )
	)
  )
  (princ)
)

 

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Something I have done in the past is to drag a line over multiple lines, you make a selection set, and use closestpointo to get a distance offset this is used in a sort list to make sure the order is correct. So your list would look like ((dist layer)(dist layer)(dist layer...... this way offsets do not matter v's hard coded in Ronjonp suggestion.

 

You can then use this to do the offset left and right. I would not try to convert the existing multi lines rather create from offset to a master line.

 

If you want this a lot, look into MLINE it supports layers. You can entmake a mline from scratch. Need to find an example. 

 

Thanks to Ronjonp saved me some coding providing solution to offset will use in future. 

; Multi offset copying existing multi lines
; By AlanH July 2021


(defun c:foooo ( / pt1 pt2 ss lst obj obj2 lay sub 1stoff)
(vl-load-com) ; just in case not loaded

(setq pt1 (getpoint "\nPick first point on inside of wall :"))
(setq pt2 (getpoint pt1 "\nPick second point on outside of wall :"))

(setq 1stoff (getreal "\nEnter 1st offset value "))

(setq obj2 (vlax-ename->vla-object (car (entsel "\nPick object to offset "))))

(setq ss (ssget "F" (list pt1 pt2)))

(setq lst '())

(repeat (setq x (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
    (setq lay (vla-get-layer obj))
    (setq pt2 (vlax-curve-getclosestpointto obj pt1))
    (setq dist (distance pt1 pt2))
    (setq lst (cons (list dist lay) lst))
)

(setq sub (car (nth 0 lst)))

(foreach n lst
    (vl-catch-all-apply 'vlax-invoke (list obj2 'offset (+ 1stoff (- (car n) sub))))
	(setq ent (entget (entlast)))
	(entmod (subst (cons 8 (nth 1 n)) (assoc 8 ent) ent))
	(vl-catch-all-apply 'vlax-invoke (list obj2 'offset (- (+ 1stoff (- (car n) sub)))))
	(setq ent (entget (entlast)))
	(entmod (subst (cons 8 (nth 1 n)) (assoc 8 ent) ent))
)

(princ)

)

 

 

 

Edited by BIGAL
  • Thanks 1
confutatis Enthusiast

confutatis

Posted
Posted (edited) 
(defun C:KOF2 (/ poly str1 str2)
 (setq poly (vlax-ename->vla-object (car (entsel "\Select axis polyline: ")))
       str1 '(3.20 3.65 3.80 5.40 5.90 6.45 7.95)
       str2 '("RD_PR-LOK" "RD_PR-IOK" "RD_PR-BOK & TP" "SERV_PR-WAT-DW" "SERV_PR-GAS" "RD_PR-FP" "RD_PR-FP")
 )      
 (mapcar '(lambda (elem1 elem2) (vla-put-Layer (car (safearray-value (variant-value (vla-offset poly elem1)))) elem2))
     (apply 'append (mapcar '(lambda (elem) (list elem (- elem))) str1))
     (apply 'append (mapcar '(lambda (elem) (list elem elem)) str2))
 )
)

(alert "\nEnter KOF2 to start")

 

This is an even more concise form...

Edited by confutatis
laijumalias Explorer

laijumalias

Posted
  • Author
Posted

Thank you all,

 

The program by BIGAL is working perfectly, but some times I only offset to one side of the CL so it will be good if we can select the object and select side for one side or enter for both side. Thank you BIGAL.

 

@confutatis and @ronjonp what I am trying to do is with out writing the layer names or offset distance  to code use the sample set to select and get the distance and layers as per sample. Thanks for your help guys.

laijumalias Explorer

laijumalias

Posted
  • Author
Posted
8 hours ago, BIGAL said:

Something I have done in the past is to drag a line over multiple lines, you make a selection set, and use closestpointo to get a distance offset this is used in a sort list to make sure the order is correct. So your list would look like ((dist layer)(dist layer)(dist layer...... this way offsets do not matter v's hard coded in Ronjonp suggestion.

 

You can then use this to do the offset left and right. I would not try to convert the existing multi lines rather create from offset to a master line.

 

If you want this a lot, look into MLINE it supports layers. You can entmake a mline from scratch. Need to find an example. 

 

Thanks to Ronjonp saved me some coding providing solution to offset will use in future. 


; Multi offset copying existing multi lines
; By AlanH July 2021


(defun c:foooo ( / pt1 pt2 ss lst obj obj2 lay sub 1stoff)
(vl-load-com) ; just in case not loaded

(setq pt1 (getpoint "\nPick first point on inside of wall :"))
(setq pt2 (getpoint pt1 "\nPick second point on outside of wall :"))

(setq 1stoff (getreal "\nEnter 1st offset value "))

(setq obj2 (vlax-ename->vla-object (car (entsel "\nPick object to offset "))))

(setq ss (ssget "F" (list pt1 pt2)))

(setq lst '())

(repeat (setq x (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
    (setq lay (vla-get-layer obj))
    (setq pt2 (vlax-curve-getclosestpointto obj pt1))
    (setq dist (distance pt1 pt2))
    (setq lst (cons (list dist lay) lst))
)

(setq sub (car (nth 0 lst)))

(foreach n lst
    (vl-catch-all-apply 'vlax-invoke (list obj2 'offset (+ 1stoff (- (car n) sub))))
	(setq ent (entget (entlast)))
	(entmod (subst (cons 8 (nth 1 n)) (assoc 8 ent) ent))
	(vl-catch-all-apply 'vlax-invoke (list obj2 'offset (- (+ 1stoff (- (car n) sub)))))
	(setq ent (entget (entlast)))
	(entmod (subst (cons 8 (nth 1 n)) (assoc 8 ent) ent))
)

(princ)

)

 

 

 

This Works as expected. Thank you very much.

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

If you would like to have  ago yourself you could add a question "L R or L+R" then use a cond to check and run the left and right etc. Where it does the foreach n lst make that two defuns a L and R save at top of code. Have a go if you can not work it out come back. A extra hint is use Multi radio buttons.lsp by me. It does rely on direction of say pline but again that can be added as a check also so L & R are always correct version 3.

  

(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (not but)(setq but 1))
(setq ans (ah:butts but "V"   '("Choose sides  " "  L" "  R" "  L+R")))

(cond
((= ans "L")(L))
((= ans "R")(R))
((= ans "L+R")((L)(R))
)

 

image.png.441401dc000b9575111856c1f295d9ad.png

 

Multi radio buttons.lsp

 

 

 

Edited by BIGAL
laijumalias Explorer

laijumalias

Posted
  • Author
Posted (edited) 
; Multi offset copying existing multi lines
; By AlanH July 2021


(defun c:foo ( / pt1 pt2 ss lst obj obj2 lay sub 1stoff l r)
(vl-load-com) ; just in case not loaded


(setq pt1 (getpoint "\nPick a point on oneside of Sample Set :"))
(setq pt2 (getpoint pt1 "\nPick a point on otherside of Sample Set :"))

(setq 1stoff 0)

(setq obj2 (vlax-ename->vla-object (car (entsel "\nPick object to offset "))))

(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (not but)(setq but 1))
(setq ans (ah:butts but "V"   '("Choose sides  " "Left" "Right" "Both")))

(setq ss (ssget "F" (list pt1 pt2)))

(setq lst '())

(cond
((= ans "Left")(repeat (setq x (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
    (setq lay (vla-get-layer obj))
    (setq pt2 (vlax-curve-getclosestpointto obj pt1))
    (setq dist (distance pt1 pt2))
    (setq lst (cons (list dist lay) lst))
)


(setq sub (car (nth 0 lst)))
(foreach n lst
    (vl-catch-all-apply 'vlax-invoke (list obj2 'offset (+ 1stoff (- (car n) sub))))
	(setq ent (entget (entlast)))
	(entmod (subst (cons 8 (nth 1 n)) (assoc 8 ent) ent))
	

))
((= ans "Right")(repeat (setq x (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
    (setq lay (vla-get-layer obj))
    (setq pt2 (vlax-curve-getclosestpointto obj pt1))
    (setq dist (distance pt1 pt2))
    (setq lst (cons (list dist lay) lst))
)


(setq sub (car (nth 0 lst)))
(foreach n lst
    
	(vl-catch-all-apply 'vlax-invoke (list obj2 'offset (- (+ 1stoff (- (car n) sub)))))
	(setq ent (entget (entlast)))
	(entmod (subst (cons 8 (nth 1 n)) (assoc 8 ent) ent))

))
((= ans "Both")(repeat (setq x (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
    (setq lay (vla-get-layer obj))
    (setq pt2 (vlax-curve-getclosestpointto obj pt1))
    (setq dist (distance pt1 pt2))
    (setq lst (cons (list dist lay) lst))
)


(setq sub (car (nth 0 lst)))
(foreach n lst

    (vl-catch-all-apply 'vlax-invoke (list obj2 'offset (+ 1stoff (- (car n) sub))))
	(setq ent (entget (entlast)))
	(entmod (subst (cons 8 (nth 1 n)) (assoc 8 ent) ent))
	(vl-catch-all-apply 'vlax-invoke (list obj2 'offset (- (+ 1stoff (- (car n) sub)))))
	(setq ent (entget (entlast)))
	(entmod (subst (cons 8 (nth 1 n)) (assoc 8 ent) ent)))

)

)

(princ)

Hi  BIGAL I managed to edit your file like the above one, I changed the request for 1st offset distance to set to zero and now  it works fine, there is one problem Which I don't know how to fix it, the center line is getting offset at a distance of zero i.e on top of it itself, how to eliminate that? Again thank you for your support.

Edited by laijumalias
BIGAL Grand Master

BIGAL

Posted
Posted

Some more this allows you to pick an end and set direction of the pline away from the end picked saves the pick in or out. You will get used to it just have to think clock wise. 

  

(setq ent  (entsel "Pick pline obj near end "))
(setq pt1 (cadr ent))
(setq obj (vlax-ename->vla-object (car ent)))
(setq pt2 (vlax-curve-getstartpoint obj))
(setq pt3 (vlax-curve-getendpoint obj))

(setq d1 (distance pt1 pt2)
	  d2 (distance pt1 pt3)
)
(if (> d1 d2)
(command "pedit" ent "R" "")
)

 

If your going to have a single line then similar method just check (vla-get-objectname obj line or pline for a line.

  

(if (> d1 d2)
    (progn 
    (setq temp pt2)
    (setq pt2 pt3)
    (setq pt3 temp)
    )
)

 

Not sure why you have a zero offset. If you use the drag method I posted make that a seperate defun so can run at start but once done can do many selections. You may also want a fillet multi lines and I guess a "T" version, to clean up ends.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...