Jump to content

Modified match properties lisp

Stryder

By Stryder
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Stryder Explorer

Stryder

Posted
Posted

I hate to say this all the time but, I am not sure if this is even possible. However, I would like a lisp file that does a match properties but also includes the elevation of a pline in the properties it will match. There may be something out there like this already, if not, can it be written?

 

Thanks,

Stryder

Lee Mac Grand Master

Lee Mac

Posted
Posted

Give this a shot:

 

;; ============ PolyMatch.lsp ===============
;;
;;  FUNCTION:
;;  Will match the elevation, layer, colour
;;  Linetype, linetype scale, and lineweight
;;  of a selected 3Dpolyline to every 3dPolyline
;;  in a selection set.
;;
;;  (Will unlock any locked layers)
;;
;;  SYNTAX: pmtch
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  PLATFORMS:
;;  No Restrictions,
;;  only tested in ACAD 2004.
;;
;;  RESTRICTIONS:
;;  Selected Polylines must have equal number
;;  of vertices.
;;
;;  VERSION:
;;  1.0  ~  14.04.2009
;;
;; ====================================

(defun c:pmtch  (/ ent cObj pLst vLst lay col lt lts lw
                  ss nullss oLst pLen nLst nVar)
 (vl-load-com)
 (if (and (setq ent (car (entsel "\nSelect Polyline to Match: ")))
        (eq "AcDb3dPolyline" (vla-get-ObjectName
                               (setq cObj (vlax-ename->vla-object ent)))))
   (progn
    (setq pLst (vlax-safearray->list
                 (vlax-variant-value
                   (vla-get-Coordinates cObj)))
          pLen (length pLst))
   (while (not (zerop (length pLst)))
     (setq vLst (cons (caddr pLst) vLst)
           pLst (cdddr pLst)))
   (setq lay (vla-get-layer cObj)
         col (vla-get-color cObj)
         lt  (vla-get-linetype cObj)
         lts (vla-get-linetypescale cObj)
         lw  (vla-get-lineweight cObj))
   (if (setq ss (ssget (list (cons 0 "POLYLINE")
                    (if (getvar "CTAB")(cons 410 (getvar "CTAB"))
                      (cons 67 (- 1 (getvar "TILEMODE")))))))
     (progn
       (vlax-for lay (vla-get-layers
                       (vla-get-ActiveDocument
                         (vlax-get-acad-object)))
         (vla-put-lock lay :vlax-false))
       (setq nullss (ssadd))
       (foreach Obj (mapcar 'vlax-ename->vla-object
                            (vl-remove-if 'listp
                              (mapcar 'cadr (ssnamex ss))))
         (setq oLst (vlax-safearray->list
                      (vlax-variant-value
                        (vla-get-Coordinates Obj))))
         (if (= pLen (length oLst))
           (progn
             (foreach vTx vLst
               (setq nLst (append (list (car oLst) (cadr oLst) vTx) nLst)
                     oLst (cdddr oLst)))
             (setq nVar (vlax-make-variant
                          (vlax-safearray-fill
                            (vlax-make-safearray
                              vlax-vbdouble
                              (cons 0 (1- (length nLst)))) nLst)))
             (vla-put-Coordinates Obj nVar)
             (vla-put-layer Obj lay)
             (vla-put-color Obj col)
             (vla-put-linetype Obj lt)
             (vla-put-linetypescale Obj lts)
             (vla-put-lineweight Obj lw))
           (ssadd (vlax-vla-object->ename Obj) nullss)))
       (if (not (zerop (sslength nullss)))
         (progn
           (sssetfirst nil nullss)
           (princ "\n<!> Selected Polylines could not be Matched <!>"))))
     (princ "\n<!> No Polylines Selected <!>")))
 (princ "\n<!> No Polyline Selected <!>"))
 (princ))

Stryder Explorer

Stryder

Posted
  • Author
Posted

Tells me No Polyline Selected Could this have something to do with different types of polylines?

Lee Mac Grand Master

Lee Mac

Posted
Posted
Tells me No Polyline Selected Could this have something to do with different types of polylines?

 

Yes, I am assuming you are using 3d-poly?

Stryder Explorer

Stryder

Posted
  • Author
Posted

Nope, I am using a 2d poly. I just used the pline command to draw it and then changed the elevation of it in properties.

eldon Grand Master

eldon

Posted
Posted

What you are actually after is a Lisp that changes a 2D polyline into a 3D Polyline. That should get Lee Mac going :shock:

 

A 2D polyline is just that. If you set up a front view and try and change any node to a different elevation, it just will not budge. Draw a 3D polyline in the first place.

Stryder Explorer

Stryder

Posted
  • Author
Posted

I have a lisp that will change a 2d poly to a 3d poly. :? That isn't what I want to do. We are dealing with contours and they are 2d polylines and they have the same elevation through the whole polyline. To be a little more descriptive I will give an exact example.

 

I have some existing polylines that are contours and I want to manually draw some proposed contours. Let's take the contour with the elevation 1050. When I draw a proposed contour using the pline command (2d poly) the elevation that AutoCAD gives it is 0, unless I start drawing it from a point on the contour. So, for the use of this lisp, lets say I didn't start it from a point on the pline with the elev. 1050 so the elevation is 0 and I didn't notice that I was on the TEXT layer. What I want to do is match properties from the pline with an elev. of 1050 on layer EX-5 to the pline with the elev. 0 so it would then have an elev. of 1050. Also, since it is a match prop. it would change it to the same layer as the source contour (from TEXT to EX-5).

 

Does this clear most things up?

eldon Grand Master

eldon

Posted
Posted

That clears it up beautifully. I deal with contours as well, and would never dream of needing a lisp routine to do what you are doing. If you draw the new polyline as before, then move it to the existing polyline. It would take longer to start a lisp and follow the prompts than just using Move.

 

But if you need a lisp, don't let me stop Lee Mac :D

Lee Mac Grand Master

Lee Mac

Posted
Posted
Nope, I am using a 2d poly. I just used the pline command to draw it and then changed the elevation of it in properties.

 

How can a 2D poly have elevation??? :unsure::huh::huh:

 

 

EDIT...

>>

eldon Grand Master

eldon

Posted
Posted
How can a 2D poly have elevation??? :unsure::huh::huh:

 

It can as long it only has one elevation throughout. Contours are one elevation 2D polylines. :D

Lee Mac Grand Master

Lee Mac

Posted
Posted
I have a lisp that will change a 2d poly to a 3d poly. :? That isn't what I want to do. We are dealing with contours and they are 2d polylines and they have the same elevation through the whole polyline. To be a little more descriptive I will give an exact example.

 

I have some existing polylines that are contours and I want to manually draw some proposed contours. Let's take the contour with the elevation 1050. When I draw a proposed contour using the pline command (2d poly) the elevation that AutoCAD gives it is 0, unless I start drawing it from a point on the contour. So, for the use of this lisp, lets say I didn't start it from a point on the pline with the elev. 1050 so the elevation is 0 and I didn't notice that I was on the TEXT layer. What I want to do is match properties from the pline with an elev. of 1050 on layer EX-5 to the pline with the elev. 0 so it would then have an elev. of 1050. Also, since it is a match prop. it would change it to the same layer as the source contour (from TEXT to EX-5).

 

Does this clear most things up?

 

I see now - but, yes I must admit, this is a bit of a "lazy-man's LISP" lol :lol:

 

But I will see what I can do

 

Such a shame - that first LISP should perform perfectly for 3Dpoly's... :P

Lee Mac Grand Master

Lee Mac

Posted
Posted
It can as long it only has one elevation throughout. Contours are one elevation 2D polylines. :D

 

Good Point - my mistake :oops:

Lee Mac Grand Master

Lee Mac

Posted
Posted

Try this Stryder:

 

;; ============ PolyMatch.lsp ===============
;;
;;  FUNCTION:
;;  Will match the Elevation, layer, colour
;;  Linetype, linetype scale, and lineweight
;;  of a selected Polyline to every Polyline
;;  in a selection set.
;;
;;  (Will unlock any locked layers)
;;
;;  SYNTAX: pmtch
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  PLATFORMS:
;;  No Restrictions,
;;  only tested in ACAD 2004.
;;
;;
;;  VERSION:
;;  1.0  ~  14.04.2009
;;
;; ====================================

(defun c:pmtch  (/ ent cObj lay col lt lts lw el ss)
 (vl-load-com)
 (if (and (setq ent (car (entsel "\nSelect Polyline to Match: ")))
          (eq "AcDbPolyline" (vla-get-ObjectName
                               (setq cObj (vlax-ename->vla-object ent)))))
   (progn
     (setq lay (vla-get-layer cObj)
           col (vla-get-color cObj)
           lt  (vla-get-linetype cObj)
           lts (vla-get-linetypescale cObj)
           lw  (vla-get-lineweight cObj)
           el  (vla-get-Elevation cObj))
     (if (setq ss (ssget (list (cons 0 "*POLYLINE")
                               (if (getvar "CTAB")
                                 (cons 410 (getvar "CTAB"))
                                 (cons 67 (- 1 (getvar "TILEMODE")))))))
       (progn (vlax-for lay  (vla-get-layers
                               (vla-get-ActiveDocument
                                 (vlax-get-acad-object)))
                (vla-put-lock lay :vlax-false))
              (foreach Obj  (mapcar 'vlax-ename->vla-object
                                    (vl-remove-if 'listp
                                      (mapcar 'cadr (ssnamex ss))))
                (vla-put-elevation Obj el)
                (vla-put-layer Obj lay)
                (vla-put-color Obj col)
                (vla-put-linetype Obj lt)
                (vla-put-linetypescale Obj lts)
                (vla-put-lineweight Obj lw)))
       (princ "\n<!> No Polylines Selected <!>")))
   (princ "\n<!> No Polyline Selected <!>"))
 (princ))

  • Like 1
Stryder Explorer

Stryder

Posted
  • Author
Posted

I have no use for this lisp personally. A guy here at work has a reason for using it and I may not be able to explain why he wants it properly. I think I agree with what Lee Mac said above that it is a "lazy-man's lisp". Thanks for the help anyway Lee, I will try this out and see if it works.

 

Thanks,

Stryder

Lee Mac Grand Master

Lee Mac

Posted
Posted
Works GREAT!!! Thanks!!! :D

 

No Probs, -- you could tell your mate at work that he is using a "lazy-man's LISP", and see what he says... :D

Stryder Explorer

Stryder

Posted
  • Author
Posted

:lol: I told him and the whole office busted up laughing! :lol:

 

 

He said "It is working smarter not harder." :P

 

 

Thank you very much for the help once again Lee!

  • 1 year later...
cadpros Newbie

cadpros

Posted
Posted

Lee Mac, I see you are a fan of the 3D polyline. Your lisp routine is actually quite brilliant for matching the various elevations througout a 3D polyline. I've never seen this done before.

 

I started to reply after reading the first page of comments and then realized the second page had the solution lisp. I tried it in Civil 3D 2008 and it works very well. This will save me a lot of time.

 

Below is what I first started writing when I saw your question

"how can a 2D polyline have an elevation?"
. You can ignore the following statements since the problem is solved, or you can read it to understand why we need this "lazy" man's lisp. :)

 

I think what the OP was trying to convey is that many of us, like myself, are in the civil engineering industry who have to use the lowly 2D polyline for creating things like contoured surfaces for making a 3D topography model. We have hundreds of these "flat" 2D polyline contours that have an "elevation" even though they are still technically flat. The same goes for the 3D cutting industry that uses similar methods for their robotic router tables that can cut things in 3D but from a file that is made up of these flat 2D polylines that are stacked up a differing "elevations". The 3D cutting industry calls this "2.5D".

 

The same method is what civil engineering uses to create a 3D surface from many 2D polylines at various elevations. We then cut profiles through this surface to get a profile of the ground through those 2D polylines at elevation. The resulting line would be the closest analogue to your 3D polyline. (ignoring 3D polys and featurelines for walls, curbs, etc.)

 

This application of your modified lisp would allow us to quickly clean up drawings that have multiple segments that are often at "0" elevation or the wrong elevation due to various factors but most frequently poor surface drafting practices. The "0" elevation polyline will often be right next to a polyline with the correct elevation. The lisp would eliminate the constant need to select the adjacent polyline, read it's elevation, deselect the polyline, select the "0" polyline, and type in the new elevation. After hundreds of these, you can see the need for the lisp. Until you have to correct hundreds of these "0" elevation polylines, it seems to be a silly request.

 

I hope this helps you understand our position and gives you some ideas for solving this problem.

Lee Mac Grand Master

Lee Mac

Posted
Posted

Hi CADPros,

 

Firstly, welcome to CADTutor :)

 

You realise this thread is almost 2 years old right? I'm pleased to say my coding has thankfully moved on since then :D

 

Thanks for your explanation all the same.

 

Lee

  • 8 years later...
CADWORKER Enthusiast

CADWORKER

Posted
Posted
On 4/14/2009 at 9:51 PM, Lee Mac said:

Try this Stryder:

 

  


;; ============ PolyMatch.lsp ===============
;;
;;  FUNCTION:
;;  Will match the Elevation, layer, colour
;;  Linetype, linetype scale, and lineweight
;;  of a selected Polyline to every Polyline
;;  in a selection set.
;;
;;  (Will unlock any locked layers)
;;
;;  SYNTAX: pmtch
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  PLATFORMS:
;;  No Restrictions,
;;  only tested in ACAD 2004.
;;
;;
;;  VERSION:
;;  1.0  ~  14.04.2009
;;
;; ====================================

(defun c:pmtch  (/ ent cObj lay col lt lts lw el ss)
 (vl-load-com)
 (if (and (setq ent (car (entsel "\nSelect Polyline to Match: ")))
          (eq "AcDbPolyline" (vla-get-ObjectName
                               (setq cObj (vlax-ename->vla-object ent)))))
   (progn
     (setq lay (vla-get-layer cObj)
           col (vla-get-color cObj)
           lt  (vla-get-linetype cObj)
           lts (vla-get-linetypescale cObj)
           lw  (vla-get-lineweight cObj)
           el  (vla-get-Elevation cObj))
     (if (setq ss (ssget (list (cons 0 "*POLYLINE")
                               (if (getvar "CTAB")
                                 (cons 410 (getvar "CTAB"))
                                 (cons 67 (- 1 (getvar "TILEMODE")))))))
       (progn (vlax-for lay  (vla-get-layers
                               (vla-get-ActiveDocument
                                 (vlax-get-acad-object)))
                (vla-put-lock lay :vlax-false))
              (foreach Obj  (mapcar 'vlax-ename->vla-object
                                    (vl-remove-if 'listp
                                      (mapcar 'cadr (ssnamex ss))))
                (vla-put-elevation Obj el)
                (vla-put-layer Obj lay)
                (vla-put-color Obj col)
                (vla-put-linetype Obj lt)
                (vla-put-linetypescale Obj lts)
                (vla-put-lineweight Obj lw)))
       (princ "\n<!> No Polylines Selected <!>")))
   (princ "\n<!> No Polyline Selected <!>"))
 (princ))
 

 

How to match the elevation between the points.

  • Confused 1

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...