Multiple Offsets

[satishrajdev]

Hi all,

as i shown in the drawings, i have centerlines and winglines,

now what i want is from centerline i want to draw winglines at different distances

(i.e.10m,25m,45m it could be any distance means not ON proper interval)

and corridor at the end

Is there any lisp that could solve my prob.

 

Thankx a lot in advance

1111.dwg

[MSasu]

An alternative solution is to draw that as multiline after define an apropriate style.

[Tharwat]

Try this piece of code .

 

(defun c:Test (/ *error* d e s k)
 (vl-load-com)
;;; Tharwat 09. Oct. 2012 ;;;
 (defun *error* (x)
   (princ "\n*Cancel*")
 )
 (if (and (not (tblsearch "LAYER" "SURVEY LIMIT"))
          (not (tblsearch "LAYER" "SURVEY LINES"))
     )
   (progn
     (alert " One or two layers [sURVEY LIMIT , SURVEY LINES] are not found in the drawing")
     (exit)
   )
 )
 (if (and (setq s (ssget "_+.:S:L" '((0 . "LINE"))))
          (progn
            (initget "WINGLINES CORRIDOR")
            (setq k
                   (cond ((getkword
                            "\n Choose one [Winglines/Corridor] <Winglines> :"
                          )
                         )
                         ("Winglines")
                   )
            )
          )
     )
   (while
     (setq d (getdist "\n Specify offset distance :"))
      (progn
        (foreach x (list d (- d))
          (vla-offset
            (vlax-ename->vla-object (ssname s 0))
            x
          )
          (vla-put-layer
            (vlax-ename->vla-object (entlast))
            (if (eq k "Winglines")
              "SURVEY LIMIT"
              "SURVEY LINES"
            )
          )
        )
      )
   )
 )
 (princ)
)

Edited October 9, 2012 by Tharwat
name of layers added to alert function

[satishrajdev]

OMG......Thanx a lot tharwat

that is working beautifully...........but still need little correction

when i m trying to draw corridor, the line which is drawn must have corridor line properties (i.e. Layer-Survey limit, Color-Blue, Line type-dashed)

but corridor it draws has wingline properties (i.e. Layer-Survey lines, Color-magenta, Line type-conti.)

 

other than this it is working fabulously.....This what i was looking for

[Tharwat]

OMG......Thanx a lot tharwat

that is working beautifully...

 

 

You're welcome .

 

when i m trying to draw corridor, the line which is drawn must have corridor line properties (i.e. Layer-Survey limit, Color-Blue, Line type-dashed)

but corridor it draws has wingline properties (i.e. Layer-Survey lines, Color-magenta, Line type-conti.)

 

 

It does that , and when you have the prompt of [Winglines/Corridor] , just enter Corridor or the first letter C is enough .

[satishrajdev]

i tried that...

i entered C after that prompt but still magenta line is appearing

can u tell why it is happening?

 

i have modified this routine, which is as follow

(defun c:Test (/ *error* d e s k)
 (vl-load-com)
;;; Tharwat 09. Oct. 2012 ;;;
 (defun *error* (x)
   (princ "\n*Cancel*")
 )
 (if (and (not (tblsearch "LAYER" "SURVEY LIMIT"))
          (not (tblsearch "LAYER" "SURVEY LINES"))
     )
(command "layer" "m" "Survey Limit" "lt" "dashed" "" "c" "5" "" "")
(command "layer" "m" "Survey Lines" "lt" "continuous" "" "c" "6" "" "")
 )
 (if (and (setq s (ssget "_+.:S:L" '((0 . "LINE"))))
          (progn
            (initget "WINGLINES CORRIDOR")
            (setq k
                   (cond ((getkword
                            "\n Choose one [Winglines/Corridor] <Winglines> :"
                          )
                         )
                         ("Winglines")
                   )
            )
          )
     )
   (while
     (setq d (getdist "\n Specify offset distance :"))
      (progn
        (foreach x (list d (- d))
          (vla-offset
            (vlax-ename->vla-object (ssname s 0))
            x
          )
          (vla-put-layer
            (vlax-ename->vla-object (entlast))
            (if (eq k "Winglines")
              "SURVEY LIMIT"
              "SURVEY LINES"
            )
          )
        )
      )
   )
 )
 (princ)
)

 

but still same error is coming

[Tharwat]

i entered C after that prompt but still magenta line is appearing

can u tell why it is happening?

 

 

Check the Color Control of the current layer , it might be changed to others than ByLayer .

[pBe]

(defun c:Test (/ *error* d e s k)
 (vl-load-com)
;;; Tharwat 09. Oct. 2012 ;;;
 (defun *error* (x)
   (princ "\n*Cancel*")
 )
(setvar 'cmdecho 0)  
[color="#4169e1"](defun Lyr (/ x)
    (initget "WINGLINES CORRIDOR")
    (setq x
           (cond ((getkword
                    "\n Choose one [Winglines/Corridor] <Winglines> :"
                  )
                 )
                 ("Winglines")
           )
    ) x
  )[/color]
[color="#4169e1"](foreach lyr '(("SURVEY LIMIT" "5" "DASHED")
       ("SURVEY LINES" "6" "CONTINUOUS"))
 	(if (not (tblsearch "LAYER" (car lyr)))
 	(command "_Layer" "_N"
		 (car lyr)  "_Color"
		 (cadr lyr) (car lyr)
		 "_Ltype"
		 (last lyr) (car lyr)
		 ""
	)))[/color]
     
 (if (and (setq s (ssget "_+.:S:L" '((0 . "LINE"))))
          (setq k (lyr))
     )
   (while
     [color="#4169e1"](progn (initget "L")[/color]
    [color="#4169e1"] (setq d (getdist "\n Specify offset distance/L To change layer :")))[/color]
	(cond
	 [color="#4169e1"] ((eq d "L")(setq k (lyr)))[/color]	
     		  [color="#4169e1"]((eq (Type d) 'Real)[/color] 
	         (foreach x (list d (- d))
	           (vla-offset
	             (vlax-ename->vla-object (ssname s 0))
	             x
	           )
	           (vla-put-layer
	             (vlax-ename->vla-object (entlast))
	             (if (eq k "Winglines")
	               "SURVEY LIMIT"
	               "SURVEY LINES"
	             )
	           )
	         )
	   )
      )
   )
 )
 (princ)
)

[satishrajdev]

it working perfectly now for me without any error

 

@pBe and Tharwat.....you guys are real genius.... thankx a lot for your interest and help..... your work is really appreciated.

 

I want one more help from u (Sorry for making u to work again)

 

In winglines segment, i want the prompt of Specify Distance [same/Different]

1. at same distance i want to specify distance once and then it should draw line at proper interval of that distance.

(e.g. If i specified distance 2 then

1st offset will be @- 2,

2nd offset will be @- 4,

3rd offset will be @- 6.

 

Just like Offset command (after selecting object it ask Specify through point or [Exit/Multiple/Undo] :

When we give Multiple command it draws line at proper interval of that specified distance)

 

2.For different distance it should work how it is working now.

i.Select object

ii. specify distance

iii. offsetting the line

[pBe]

That sounds like fun. But its tharwats' code really

 

Cheers

[crisraj99]

hi,

 

i need same lisp but i don't want to mention the layers, irrespective of layers i need tool please help me.

[Tharwat]

hi,

 

i need same lisp but i don't want to mention the layers, irrespective of layers i need tool please help me.

 

Are these layers CONFIDENTIAL ?

 

Can you please stop reviving threads and start a new thread showing what you are looking for and if anyone has the willing to help , that would be great and we should thank them .

[crisraj99]

HI Tharwat ,

 

Autually in each drawing i found different layer names thats why i don't mentioned the names.

for example find the attachment and can you please help me to make center lines for HVAC pipes.

Example.dwg

[Tharwat]

HI Tharwat ,

 

Autually in each drawing i found different layer names thats why i don't mentioned the names.

for example find the attachment and can you please help me to make center lines for HVAC pipes.

 

 

Try this draft and select only two lines to create center line between both of them ( if I understood your goal well )

 

(defun c:cl (/ _Mid ss i sn e1 e2 p1 p2 p3 p4)
 (defun *error* (x) (princ "\n *Cancel*"))
 (if
   (eq
     4
     (logand 4
             (cdr
               (assoc 70 (entget (tblobjname "LAYER" (getvar 'clayer))))
             )
     )
   )
    (progn
      (alert "<!> Current layer is LOCKED <!>")
      (exit)
    )
 )
 (defun _Mid (pt1 pt2)
   (mapcar (function (lambda (j k) (* (+ j k) 0.5))) pt1 pt2)
 )
 (if (and (setq ss (ssget "_:L" '((0 . "LINE"))))
          (if (eq 2 (setq i (sslength ss)))
            t
            (progn
              (alert "Please select only two lines , OKAY ? ")
              nil
            )
          )
     )
   (progn
     (setq e1 (entget (ssname ss 0))
           e2 (entget (ssname ss 1))
           p1 (cdr (assoc 10 e1))
           p2 (cdr (assoc 11 e1))
           p3 (cdr (assoc 10 e2))
           p4 (cdr (assoc 11 e2))
     )
     (if (not (inters p1 p3 p2 p4))
       (entmakex (list '(0 . "LINE")
                       (cons 10 (_Mid p1 p3))
                       (cons 11 (_Mid p2 p4))
                 )
       )
       (entmakex (list '(0 . "LINE")
                       (cons 10 (_Mid p1 p2))
                       (cons 11 (_Mid p3 p4))
                 )
       )

     )
   )
 )
 (princ "\n Written By Tharwat Al Shoufi")
 (princ)
)

[crisraj99]

Wow thanks a lot Tharwat,

 

it's working well but i need centre lines for "LWPOLYLINE" closed also what i have to do for those closed LWPOLYLINE's. any help..???

 

and one more request

 

i need total count of the drawing file by each layer... could you please help me on this.

[Tharwat]

Wow thanks a lot Tharwat,

 

You're welcome .

 

it's working well but i need centre lines for "LWPOLYLINE" closed also what i have to do for those closed LWPOLYLINE's. any help..???

 

Explode them if you don't need them as polylines and use my code to center them .

 

i need total count of the drawing file by each layer... could you please help me on this.

 

Although that is not clear , I would leave the chance to the other to help you with it .

 

Tharwat

[crisraj99]

once again thanks a lot but for polylines u r code is not working.

[Tharwat]

but for polylines u r code is not working.

I know that , that's why I said explode them if you don't want them as polylines in my previous reply .

[alanjt]

Here's one I wrote a while back...

 

(defun c:LBL (/ foo AT:GetSel _pnts _pline _lwpline _dist e1 e2)
 ;; Draw (LW)Polyline between two selected curves (at midpoint of vertices).
 ;; Alan J. Thompson, 09.29.10

 (vl-load-com)

 (defun foo (e)
   (and (wcmatch (cdr (assoc 0 (entget (car e)))) "LINE,*POLYLINE,SPLINE")
        (not (vlax-curve-isClosed (car e)))
   )
 )

 (defun AT:GetSel (meth msg fnc / ent)
   ;; meth - selection method (entsel, nentsel, nentselp)
   ;; msg - message to display (nil for default)
   ;; fnc - optional function to apply to selected object
   ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
   ;; Alan J. Thompson, 05.25.10
   (while
     (progn (setvar 'ERRNO 0)
            (setq ent (meth (cond (msg)
                                  ("\nSelect object: ")
                            )
                      )
            )
            (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                  ((eq (type (car ent)) 'ENAME)
                   (if (and fnc (not (fnc ent)))
                     (princ "\nInvalid object!")
                   )
                  )
            )
     )
   )
   ent
 )

 (defun _pnts (e / p l)
   (if e
     (cond ((wcmatch (cdr (assoc 0 (entget e))) "ARC,LINE,SPLINE")
            (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
           )
           ((wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")
            (repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
              (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
            )
           )
     )
   )
 )

 (defun _pline (lst)
   (if (and (> (length lst) 1)
            (entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . ))
            (foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
       )
     (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
   )
 )

 (defun _lwpline (lst)
   (if (> (length lst) 1)
     (entmakex (append
                 (list '(0 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                       (cons 90 (length lst))
                       (cons 70 (* (getvar 'plinegen) 128))
                 )
                 (mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst)
               )
     )
   )
 )

 (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

 (if
   (and
     (setq e1 (_pnts (car (AT:GetSel entsel "\nSelect first open curve: " foo))))
     (setq e2 (_pnts (car (AT:GetSel entsel "\nSelect next open curve: " foo))))
     (not (initget 0 "Lwpolyline Polyline"))
     (setq *LBL:Opt* (cond ((getkword (strcat "\nSpecify line to draw: [Lwpolyline/Polyline] <"
                                              (cond (*LBL:Opt*)
                                                    ((setq *LBL:Opt* "Lwpolyline"))
                                              )
                                              ">: "
                                      )
                            )
                           )
                           (*LBL:Opt*)
                     )
     )
   )
    ((if (eq *LBL:Opt* "Lwpolyline")
       _lwpline
       _pline
     )
      (vl-remove nil
                 (mapcar (function (lambda (a b)
                                     (if (and a b (not (grdraw (trans a 0 1) (trans b 0 1) 1 1)))
                                       (mapcar (function (lambda (a b) (/ (+ a b) 2.))) a b)
                                     )
                                   )
                         )
                         e1
                         (if (< (_dist (car e1) (car e2))
                                (_dist (car e1) (last e2))
                             )
                           e2
                           (reverse e2)
                         )
                 )
      )
    )
 )
 (princ)
)

[crisraj99]

Wow thank you very much alanjt it's working now.