Jump to content

Modified match properties lisp


Stryder

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

>>

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

: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!

Link to comment
Share on other sites

  • 1 year later...

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 8 years later...
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
Link to comment
Share on other sites

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.

×
×
  • Create New...