2d lines/polylines to 3d polylines

[iain9876]

you are truly a god amongst men!

[eldon]

Well iain, you can see in kpblc's latest post why I was hesitating to publish my offering of lisp.

[iain9876]

lol, nevermind eldon, yours is still miles better than mine!

Have you tried out his lisp routine yet?

[kpblc]

I changed code. Now it will check the type of entity where from code should get the elevation. And it could works some more accurately (i hope).

(defun c:3dp (/ adoc pt_prev h_prev pt_lst vla_pline vla_pt_lst answer)
;;; Written by kpblc at 2006 Oct 11 by req of iain9876
;;; at cadtutor.net forum 
 (vl-load-com)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark adoc)
 (if (setq pt_prev (getpoint "\nSelect start point <Exit> : "))
   (vl-catch-all-apply
     '(lambda ()
        (setq h_prev (cond
                       ((setq h_prev
                               (car
                                 (entsel
                                   (strcat
                                     "\nSelect the TEXT (or MTEXT) to get elevation <"
                                     (rtos (caddr pt_prev))
                                     "> : "
                                     ) ;_ end of strcat
                                   ) ;_ end of entget
                                 ) ;_ end of car
                              ) ;_ end of setq
                        (if (vlax-property-available-p
                              (vlax-ename->vla-object h_prev)
                              'textstring
                              ) ;_ end of vlax-property-available-p
                          (atof
                            (vla-get-textstring (vlax-ename->vla-object h_prev))
                            ) ;_ end of rtos
                          ) ;_ end of if
                        )

                       (t (caddr pt_prev))
                       ) ;_ end of cond
              pt_lst (list (list (car pt_prev) (cadr pt_prev) h_prev))
              ) ;_ end of setq
        (while
          (setq cur_pt (getpoint pt_prev "\nSelect next point <Enough> : "))
           (setq pt_prev    cur_pt
                 h_prev     (cond
                              ((setq h_prev
                                      (car
                                        (entsel
                                          (strcat
                                            "\nSelect the TEXT (or MTEXT) to get elevation <"
                                            (rtos (caddr pt_prev))
                                            "> : "
                                            ) ;_ end of strcat
                                          ) ;_ end of entget
                                        ) ;_ end of car
                                     ) ;_ end of setq
                               (if (vlax-property-available-p
                                     (vlax-ename->vla-object h_prev)
                                     'textstring
                                     ) ;_ end of vlax-property-available-p
                                 (atof
                                   (vla-get-textstring (vlax-ename->vla-object h_prev))
                                   ) ;_ end of rtos
                                 ) ;_ end of if
                               )
                              (t (caddr pt_prev))
                              ) ;_ end of cond
                 pt_lst     (append pt_lst
                                    (list (list (car pt_prev) (cadr pt_prev) h_prev))
                                    ) ;_ end of append
                 vla_pt_lst (vlax-make-variant
                              (vlax-safearray-fill
                                (vlax-make-safearray
                                  vlax-vbdouble
                                  (cons 1 (length (apply 'append pt_lst)))
                                  ) ;_ end of vlax-make-safearray
                                (apply 'append pt_lst)
                                ) ;_ end of vlax-safearray-fill
                              ) ;_ end of vlax-make-variant
                 ) ;_ end of setq
           (if (not vla_pline)
             (setq
               vla_pline (vla-add3dpoly (vla-get-modelspace adoc) vla_pt_lst)
               ) ;_ end of setq
             (vla-put-coordinates vla_pline vla_pt_lst)
             ) ;_ end of if
           ) ;_ end of while
        (initget "Yes No _ Y N")
        (if (= (cond ((getkword "Close it [Yes/No] <Yes> : ")
                      )
                     (t "Y")
                     ) ;_ end of cond
               "Y"
               ) ;_ end of =
          (vla-put-closed vla_pline :vlax-true)
          ) ;_ end of if
        ) ;_ end of lambda
     ) ;_ end of vl-catch-all-apply
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

[iain9876]

would it be possible to tweak the code to also check if the entity is a block, then pick the elevation text associated with the block?

[kpblc]

Yes, why not? But i have to know - the text is attribute (ang i have to know the tag of attribute)? Or the text is "text (mtext) inserted in block"?

[iain9876]

the text would be the attribute, and the tag would be: LEVEL

 

Would it matter if level were in upper or lower case?.. in this case it is upper.

[kpblc]

It doesn't matter - "LEVEL" or "Level" or "level". I exclude this kind of errors also automatically

Test this:

;|
I didn't remove operation with text - It could be useful
|;
(defun c:3dp (/ adoc pt_prev h_prev pt_lst vla_pline vla_pt_lst loc:getvalue)
;;; Written by kpblc at 2006 Oct 11 by req of iain9876
;;; at cadtutor.net forum 

 (defun loc:getvalue (def / res ent att)
   (setq ent (car
               (entsel
                 (strcat
                   "\nSelect the BLOCK or TEXT (or MTEXT) to get elevation <"
                   (rtos (caddr pt_prev))
                   "> : "
                   ) ;_ end of strcat
                 ) ;_ end of entget
               ) ;_ end of car
         ) ;_ end of setq
   (cond
     ((and (= (cdr (assoc 0 (entget ent))) "INSERT")
           (= (cdr (assoc 66 (entget ent))) 1)
           ) ;_ end of and
      (setq att (car
                  (vl-remove-if
                    '(lambda (x)
                       (/= (strcase (vla-get-tagstring x)) (strcase tag))
                       ) ;_ end of lambda
                    (vlax-safearray->list
                      (vlax-variant-value
                        (vla-getattributes (vlax-ename->vla-object ent))
                        ) ;_ end of vlax-variant-value
                      ) ;_ end of vlax-safearray->list
                    ) ;_ end of vl-remove-if-not
                  ) ;_ end of car
            res (atof (vla-get-textstring att))
            ) ;_ end of setq
      )
     ((member (cdr (assoc 0 (entget ent))) '("TEXT" "MTEXT"))
      (setq res (atof (vla-get-textstring (vlax-ename->vla-object ent))))
      )
     (t def)
     ) ;_ end of cond
   res
   ) ;_ end of defun

 (vl-load-com)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object))
       tag  "level"
       ) ;_ end of setq
 (vla-startundomark adoc)
 (if (setq pt_prev (getpoint "\nSelect start point <Exit> : "))
   (vl-catch-all-apply
     (function
       (lambda ()
         (setq h_prev (loc:getvalue (caddr pt_prev))
               pt_lst (list (list (car pt_prev) (cadr pt_prev) h_prev))
               ) ;_ end of setq
         (while
           (setq cur_pt (getpoint pt_prev "\nSelect next point <Enough> : "))
            (setq pt_prev    cur_pt
                  h_prev     (loc:getvalue (caddr pt_prev))
                  pt_lst     (append pt_lst
                                     (list (list (car pt_prev) (cadr pt_prev) h_prev))
                                     ) ;_ end of append
                  vla_pt_lst (vlax-make-variant
                               (vlax-safearray-fill
                                 (vlax-make-safearray
                                   vlax-vbdouble
                                   (cons 1 (length (apply 'append pt_lst)))
                                   ) ;_ end of vlax-make-safearray
                                 (apply 'append pt_lst)
                                 ) ;_ end of vlax-safearray-fill
                               ) ;_ end of vlax-make-variant
                  ) ;_ end of setq
            (if (not vla_pline)
              (setq
                vla_pline (vla-add3dpoly (vla-get-modelspace adoc) vla_pt_lst)
                ) ;_ end of setq
              (vla-put-coordinates vla_pline vla_pt_lst)
              ) ;_ end of if
            ) ;_ end of while
         (initget "Yes No _ Y N")
         (if (= (cond ((getkword "Close it [Yes/No] <Yes> : ")
                       )
                      (t "Y")
                      ) ;_ end of cond
                "Y"
                ) ;_ end of =
           (vla-put-closed vla_pline :vlax-true)
           ) ;_ end of if
         ) ;_ end of lambda
       ) ;_ end of function
     ) ;_ end of vl-catch-all-apply
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

[iain9876]

thank you very much, it works perfectly.

 

i think a lot of people will like this....

[kpblc]

Not at all

[matt27]

Hi guy's sorry to relaunch this thread but I'm using AutoCad 2010 and have a 2D topigraphical survey made from polylines that I wish to turn into 3D polylines and give a 'Z' value too. The 2D drawing has text referencing the elevation so I tried using the lisp provided but all I get is this error:

 

error: extra right paren on input

 

I use PDMS usually so a total AutoCad novice and even more novice about lisp files. could someone tell me what I'd doing wrong?

 

Many thanks

 

Matt

[Lee Mac]

You have an extra ")" in the code.

 

For future reference, I have written a brief overview of common error messages here.

[matt27]

You have an extra ")" in the code.

 

For future reference, I have written a brief overview of common error messages here.

 

Thats Great, problem solved - thankyou very much Lee Mac

[Lee Mac]

You're welcome Matt

[d2w_tomee]

Hello,

 

Sorry to revive this again but this is just about exactly what I've been wanting for ages but have never managed to find. In fact the last time I complained to my workmate about it was only an hour ago!

I've already attempted to change myself but no luck..

 

This lisp runs by first selecting an X,Y by mouse then asking for you to select a block of text containing a number which is will use.

 

However for me I would like to be able to first click the place where I want the X,Y (whether or not this point has a Z value of nothing or something is no problem) then as soon as you click X,Y it asks you "what value for the Z?" and then either by entering a number or by selecting another point it will give it that Z value.

 

And then if that can be done, can the same thing except using the spline function be done as well??

 

I do a lot of dynamic 3d surfaces and at first glance it may seem backward doing it manually like this but honestly when you are trying to make a ground surface just work as you can visualise it on the screen it'd be very very helpful.

 

Thanks in advance