Topic: AEC Contour Question

[Ken]

I've just changed companies and at my old company we used Polylines for all our contour data. My new company uses AEC contours and now that I've gotten used to them, I really like them and wish I had been using them before.

The only thing I would like to be able to do is insert individual vertices at specific points on the AEC contour. I know I can change it back to a polyline, add the vertice and convert it back. I'm just hoping somebody has an easier way or maybe a Lisp routine to automate the process and not lose any existing labels on the AEC contour?

Thanks in advance for any help.  

Ken

[Jeff_M]

Well this sounded like a good challenge. So without further adoo, we bring you the Contour vertex inserter! No error checking, super-duper functionality or anything else, but it does work and allows the labels to remain a part of the contour. You may want to change the command name to something easier to type. Tested in LDD3......

Code: [Select]


(defun c:add_contour_vertex (/ ent contour coords temp_pline pt closept param newcoords)
  (defun getspace ()
    (if (= (getvar "cvport") 1)
      (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
      (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
      )
    )
  (and (setq ent (car (entsel "\Select contour: ")))
       (eq (cdr (assoc 0 (entget ent))) "AECC_CONTOUR")
       (setq contour (vlax-ename->vla-object ent))
       (setq coords (vlax-get contour 'coordinates))
       (setq temp_pline (vlax-invoke (getspace) 'addpolyline coords))
       ;;need to add a temporary pline, as the vlax-curve functions return
       ;;odd results with aecc_contours
       (not (vla-put-visible temp_pline :vlax-false))
       (setq pt (getpoint "\nPick point for new vertex: "))
       (setq closePt (vlax-curve-getclosestpointto temp_pline pt))
       (setq param (fix (vlax-curve-getparamatpoint temp_pline closept)))
       (repeat (1+ param)
(setq newcoords (append newcoords (list (car coords)(cadr coords)(caddr coords))))
(setq coords (cdddr coords))
t
)
       (setq newcoords (append newcoords pt))
       (while coords
(setq newcoords (append newcoords (list (car coords)(cadr coords)(caddr coords))))
(setq coords (cdddr coords))
t
)
       (not (vlax-put contour 'coordinates newcoords))
       (vla-delete temp_pline)
       )
  (princ)
  )


[Ken]

Jeff,

You are the "MAN" or should I say "Programmer" ... just quickly tried it out and it works great. Should be a standard tool for LDD!!!

Thanks for the help!!

Ken

[Ken]

Jeff,

I have been using the routine you created to insert vertices and it works great. One thing that would make it even better, would be to make it possible to enter additonal vertices on the selected contour, without having to repick the contour each time.

I have tried to create a loop to accomplish this, but my programming skills are limited and I haven't been able to get it to work. If it's possible and sometime you can add that feature to the program, it would be much appreciated.

Thanks again for the program and it's still a GREAT little program just as it is!!

Ken

[Jeff_M]

Ken, you're quite welcome! I'm glad you like it and find it useful.

And just since you asked politely   here's the updated routine that allows multiple vertice to be added.

Code: [Select]


(defun c:add_contour_vertex (/ ent contour coords temp_pline pt closept param newcoords)
  (defun getspace ()
    (if (= (getvar "cvport") 1)
      (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
      (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
      )
    )
  (and (setq ent (car (entsel "\Select contour: ")))
       (eq (cdr (assoc 0 (entget ent))) "AECC_CONTOUR")
       (setq contour (vlax-ename->vla-object ent))
       (setq coords (vlax-get contour 'coordinates))
       (setq temp_pline (vlax-invoke (getspace) 'addpolyline coords))
       ;;need to add a temporary pline, as the vlax-curve functions return
       ;;odd results with aecc_contours
       (not (vla-put-visible temp_pline :vlax-false))
       (WHILE       (setq pt (getpoint "\nPick point for new vertex: "))
      (setq pt (list (car pt)(cadr pt)(caddr coords)))
      (setq closePt (vlax-curve-getclosestpointto temp_pline pt))
      (setq param (fix (vlax-curve-getparamatpoint temp_pline closept)))
      (repeat (1+ param)
(setq newcoords (append newcoords (list (car coords)(cadr coords)(caddr coords))))
(setq coords (cdddr coords))
)
      (setq newcoords (append newcoords pt))
      (while coords
(setq newcoords (append newcoords (list (car coords)(cadr coords)(caddr coords))))
(setq coords (cdddr coords))
)
      (vlax-put contour 'coordinates newcoords)
      (vlax-put TEMP_PLINE 'coordinates newcoords)
(SETQ COORDS NEWCOORDS
      NEWCOORDS NIL)
)
       (vla-delete temp_pline)
       )
  (princ)
  )


Note again, however, that there is no provison made for error trapping. If the user cancels out instead of finishing the command, the invisible temporary pline the routine creates will be left in the drawing. I leave it up to you to add the appropriate error control   (What is requires isn't that hard to add, that's why I leave it for you.....you gotta learn something here, right? )

[Ken]

Jeff,

The update is perfect!!  I was close, but just couldn't find the right place to end the While statement. And as you suggested before, I have shortened the run command to < acv >. This is now exactly what I was looking for and very much appreciated. I will work on the Error Trapping, which is an area I need to become better at and that is the best way for me to learn.

Great Job!!

Ken