topic Re: ADD VERTICE TO POLYLINE in Visual LISP, AutoLISP and General Customization Forum

ADD VERTICE TO POLYLINE

rolisonfelipe — Wed, 06 Feb 2019 19:34:42 GMT

ADD POINT IN ALL VERTICE POLYLINE/LINE/ARC WHICH COMMND POINT
(DEFUN C:VV () (C:VERTEX))
;============================================================
(defun c:VERTEX (/ SS1 SS2 ang ctr)
(setq ctr -1
       SS1 (ssget '((0 . "LWPOLYLINE" "LINE" "ARC") (-4 . "&") (70 . 1)))
       SS2 (ssadd)
       ang (getreal "\n SELECT POLYLINE:"))
(repeat (sslength SS1)
(command ".chprop" "p" "" "la" "POINT" "LT" "BYLAYER" "C" "RED" ""))
(command "._POINT" (ssname SS1 (setq ctr (1+ ctr))) ""_ptype "_t" "0.2")
(setq SS2 (ssadd (entlast) SS2)))
(command "._union" SS2 "")
)

Re: ADD VERTICE TO POLYLINE

Kent1Cooper — Wed, 06 Feb 2019 21:22:41 GMT

Is there a question? I see several problems with that code, but I'm not sure what you're asking, or even exactly what the code is intended to do.

Re: ADD VERTICE TO POLYLINE

rolisonfelipe — Wed, 06 Feb 2019 21:45:40 GMT

Hello @Kent1Cooper,
This lisp serves to ADD points in vertices of objects such as line, Arch and polylines,

but I can not load the style of dots to choose the point and configuration of the point size that will stay in the drawing.

Re: ADD VERTICE TO POLYLINE

Kent1Cooper — Wed, 06 Feb 2019 22:07:17 GMT

@Kent1Cooper wrote:

.... I see several problems with that code ....

Quickly:

(defun c:VERTEX (/ SS1 SS2 ang ctr)
  (setq
    ctr -1
    SS1 (ssget '((0 . "LWPOLYLINE" "LINE" "ARC") (-4 . "&") (70 . 1)))
      ;;;;; Not separate entity types -- put together with comma separators,
      ;;;;;   i.e. "LWPOLYLINE,LINE,ARC".
      ;;;;; Lines/Arcs have no 70 entry in entity data, so none will be seen;
      ;;;;;   that will see only closed LWPolylines.
    SS2 (ssadd)
    ang (getreal "\n SELECT POLYLINE:")
      ;;;;; Never used, and selecting an object is not appropriate for (getreal),
      ;;;;;   and 'ang' is an odd variable name for either a real number or a
      ;;;;;   Polyline entity.  What is it meant to be for?
  ) ;;;;; [moved]
  (repeat (sslength SS1)
    (command ".chprop" "p" "" "la" "POINT" "LT" "BYLAYER" "C" "RED" "")
      ;;;;; This will change the Polyline(s) [and/or Line(s)/Arc(s) if corrected];
      ;;;;;   is it meant to be setting up a Layer for Points?
  ) ;;;;; This [moved here] ends (repeat), so below will happen only once.
  (command "._POINT" (ssname SS1 (setq ctr (1+ ctr))) ""_ptype "_t" "0.2")
    ;;;;; An entity name is not appropriate input for a Point command.
    ;;;;; Even if _ptype had quotes around it instead of both before it,
    ;;;;;   what is the "_t" about?
  (setq SS2 (ssadd (entlast) SS2)))
    ;;;;; Extra ) at end; otherwise OK, but can be simply (ssadd (entlast) SS2),
    ;;;;;   without (setq) around it -- (ssadd) returns the set with the addition.
  (command "._union" SS2 "")
    ;;;;; Union is for 3D Solids/Surfaces/Regions, not Point entities. What is the intent?
)

For the Point appearance, you can skip the PTYPE command and just use (setvar 'pdmode 35) or whatever number gives you the look you prefer. But that's not the only problem -- see above.

What are the "vertices" of a Line or Arc? Both ends? Also the midpoint, since a grip appears there when it's selected? Maybe also the center of an Arc?

[And by the way, the singular of "vertices" is "vertex."]

Re: ADD VERTICE TO POLYLINE

rolisonfelipe — Wed, 06 Feb 2019 22:38:11 GMT

;The vertices in the plural refers to the set of objects (arc, line, polyline),
;the demarção of them will be made in the junctions,. Endpoint....
;independent if they are connected as polyline, or if it is a disconnected object free arc or line

;I found a better lsp to be edited, and add some elements that wanted, but it is limited to polylines

(DEFUN C:VV () (C:VERTEX))
;============================================================
(defun C:VERTEX (/   AERR     AOSMD     ADECH SGPOLY
  NUMOBJ   NAMENT    ENTGT     TIPENT ENPOLYA
  TSEXTRA   SSLENP    VALPOLY   FIRSTEL PTZVERT
  PTVERTICE ENPOLYB   VERTIC    TESSPL TSEXTRB
  ENVERTB   TSVCONT   PTVERTICE TEMPA VERTIC
  TESTVER   VERTIC
        )
(command "_.undo" "begin")
(setq AERR *error*)
(setq AOSMD (getvar "osmode")
ADECH (getvar "cmdecho")
)
(setvar "cmdecho" 0)
(command "layer" "m" "POINT" "lt" "continuous" "" "c" "1" "" "") ;;;;;;layer control
(command "_.ptype") ;;;;;;point control
(princ "\n»» Select a Polyline(s):\n")
(setq SGPOLY (ssget))
(if SGPOLY
    (progn (setq NUMOBJ (sslength SGPOLY))
    (while (> NUMOBJ 0)
      (setq NAMENT (ssname SGPOLY (setq NUMOBJ (1- NUMOBJ)))
     ENTGT (entget NAMENT)
     TIPENT (cdr (assoc 0 ENTGT))
      )
      (if (equal TIPENT "LWPOLYLINE") ;;; job only polyline, i need work wich "LWPOLYLINE" "LINE" "ARC"
        (DFLWPOLY)
      )
      (if (equal TIPENT "POLYLINE")
        (DFPOLY)
      )
    )
    )
    (princ "\n»» Nenhuma entidade seleccionada!\n")
)
(command "_.undo" "end")
)
;;; ;;; ;;;
(defun DFLWPOLY ()
(setq ENPOLYA (entget NAMENT)
TSEXTRA (car (cdr (assoc 210 ENPOLYA)))
)
(if (= TSEXTRA 0.0)
    (progn (setvar "osmode" 0)
    (setq SSLENP (length ENPOLYA))
    (while (> SSLENP 0)
      (setq SSLENP (1- SSLENP)
     VALPOLY (nth SSLENP ENPOLYA)
     FIRSTEL (car VALPOLY)
     PTZVERT (cdr (assoc 38 ENPOLYA))
      )
      (if (= FIRSTEL 10)
        (progn (setq PTVERTICE (list (nth 1 VALPOLY)
         (nth 2 VALPOLY)
         (cdr (assoc 38 ENPOLYA))
          )
        )
        (command "_.point" PTVERTICE)
        )
      )
    )
    (setvar "osmode" AOSMD)
    )
)
)
;;;;
;;;;
(defun DFPOLY ()
(setq ENPOLYB (entget NAMENT)
VERTIC (entnext NAMENT)
TESSPL (cdr (assoc 70 ENPOLYB))
TSEXTRB (car (cdr (assoc 210 ENPOLYB)))
)
(if (= TSEXTRB 0.0)
    (progn (setvar "osmode" 0)
    (while VERTIC
      (setq ENVERTB (entget VERTIC)
     TSVCONT (cdr (assoc 70 ENVERTB))
      )
      (if (/= TSVCONT 16)
        (progn (setq PTVERTICE (cdr (assoc 10 ENVERTB)))
        (command "_.point" PTVERTICE)
        )
      )
      (setq TEMPA   VERTIC
     VERTIC (entnext TEMPA)
     TESTVER (cdr (assoc 0 ENVERTB))
      )
      (if (/= TESTVER "VERTEX")
        (setq VERTIC nil)
      )
    )
    (setvar "osmode" AOSMD)
    )
)
)
;;;;
;;;;
(defun *error* (msg)
(setq *error* AERR)
(setvar "cmdecho" ADECH)
(setvar "osmode" AOSMD)
(command "_.undo" "end")
(princ (strcat "»» Aplicação interrompida com erro: " msg))
)
;;; ;;; ;;;
(terpri)
(princ "\n»» start VV \n")

Re: ADD VERTICE TO POLYLINE

dbhunia — Thu, 07 Feb 2019 09:10:22 GMT

Try this..... (Only few addition)

(DEFUN C:VV () (C:VERTEX))
;============================================================
(defun C:VERTEX (/   AERR     AOSMD     ADECH SGPOLY
  NUMOBJ   NAMENT    ENTGT     TIPENT ENPOLYA
  TSEXTRA   SSLENP    VALPOLY   FIRSTEL PTZVERT
  PTVERTICE ENPOLYB   VERTIC    TESSPL TSEXTRB
  ENVERTB   TSVCONT   PTVERTICE TEMPA VERTIC
  TESTVER   VERTIC
        )
  (command "_.undo" "begin")
  (setq AERR *error*)
  (setq AOSMD (getvar "osmode")
        ADECH (getvar "cmdecho")
  )
  (setvar "cmdecho" 0)
  (command "layer" "m" "POINT" "lt" "continuous" "" "c" "1" "" "");;;;;;layer control
  (command "_.ptype");;;;;;point control
  (princ "\n»» Select a Polyline(s):\n")
  (setq SGPOLY (ssget))
  (if SGPOLY
    (progn (setq NUMOBJ (sslength SGPOLY))
    (while (> NUMOBJ 0)
      (setq NAMENT (ssname SGPOLY (setq NUMOBJ (1- NUMOBJ)))
            ENTGT  (entget NAMENT)
            TIPENT (cdr (assoc 0 ENTGT))
      )
      (if (equal TIPENT "LWPOLYLINE");;;  job only polyline, i need work wich  "LWPOLYLINE" "LINE" "ARC"
        (DFLWPOLY)
      )
      (if (equal TIPENT "POLYLINE")
        (DFPOLY)
      )
      (if (or (equal TIPENT "LINE") (equal TIPENT "ARC"))
        (DFLINE)
      )
    )
    )
    (princ "\n»» Nenhuma entidade seleccionada!\n")
  )
  (command "_.undo" "end")
)
(defun DFLWPOLY ()
  (setq ENPOLYA (entget NAMENT)
        TSEXTRA (car (cdr (assoc 210 ENPOLYA)))
  )
  (if (= TSEXTRA 0.0)
    (progn (setvar "osmode" 0)
    (setq SSLENP (length ENPOLYA))
    (while (> SSLENP 0)
      (setq SSLENP  (1- SSLENP)
     	    VALPOLY (nth SSLENP ENPOLYA)
            FIRSTEL (car VALPOLY)
            PTZVERT (cdr (assoc 38 ENPOLYA))
      )
      (if (= FIRSTEL 10)
        (progn (setq PTVERTICE (list (nth 1 VALPOLY) (nth 2 VALPOLY) (cdr (assoc 38 ENPOLYA))))
               (command "_.point" PTVERTICE)
        )
      )
    )
    (setvar "osmode" AOSMD)
    )
  )
)
(defun DFPOLY ()
  (setq ENPOLYB (entget NAMENT)
 VERTIC (entnext NAMENT)
 TESSPL (cdr (assoc 70 ENPOLYB))
 TSEXTRB (car (cdr (assoc 210 ENPOLYB)))
  )
  (if (= TSEXTRB 0.0)
    (progn (setvar "osmode" 0)
    (while VERTIC
      (setq ENVERTB (entget VERTIC)
     TSVCONT (cdr (assoc 70 ENVERTB))
      )
      (if (/= TSVCONT 16)
        (progn (setq PTVERTICE (cdr (assoc 10 ENVERTB)))
        (command "_.point" PTVERTICE)
        )
      )
      (setq TEMPA   VERTIC
     VERTIC  (entnext TEMPA)
     TESTVER (cdr (assoc 0 ENVERTB))
      )
      (if (/= TESTVER "VERTEX")
        (setq VERTIC nil)
      )
    )
    (setvar "osmode" AOSMD)
    )
  )
)
(defun DFLINE ()
   (setvar "osmode" 0)
   (command "_.point" (vlax-curve-getStartPoint NAMENT))
   (command "_.point" (vlax-curve-getEndPoint NAMENT))
   (setvar "osmode" 1)
)
(defun *error* (msg)
  (setq *error* AERR)
  (setvar "cmdecho" ADECH)
  (setvar "osmode" AOSMD)
  (command "_.undo" "end")
  (princ (strcat "»» Aplicação interrompida com erro: " msg))
)
(terpri)
(princ "\n»» start VV \n")

Re: ADD VERTICE TO POLYLINE

rolisonfelipe — Thu, 07 Feb 2019 09:25:57 GMT

@dbhunia, very good, hit the first.
Thank you very much for your help.

Re: ADD VERTICE TO POLYLINE

dbhunia — Thu, 07 Feb 2019 10:07:40 GMT

@rolisonfelipe Its my mistake, change the Red line......

............
(defun DFLINE ()
   (setvar "osmode" 0)
   (command "_.point" (vlax-curve-getStartPoint NAMENT))
   (command "_.point" (vlax-curve-getEndPoint NAMENT))
   (setvar "osmode" AOSMD)
)
............

Re: ADD VERTICE TO POLYLINE

Kent1Cooper — Thu, 07 Feb 2019 12:38:34 GMT

@rolisonfelipe wrote:

…. ;I found a better lsp to be edited, and add some elements that wanted, but it is limited to polylines ….

You have a solution, but I'd simplify and shorten and update it as below [lightly tested]. That routine has some inefficiencies, problems, etc.:
Would you ever type out the whole command name "VERTEX," when you can use "VV" (and the code tells you to)? I just defined the name as VV directly. [But if it were up to me, I'd name it differently -- VV doesn't seem to be "about" what it does.]
It uses an old-fashioned way of setting up error handling, and defines *error* outside the command, and does not restore the original unless there is an error -- without one, this routine's *error* handler will be imposed on AutoCAD operations in general, and if it is triggered by something unrelated, it will encounter a variable that doesn't exist! And if there's an error within running it, in Acad2015 and beyond you'll be scolded for using (command) in the *error* handler [for the Undo End part].
There's no need to specify Continuous linetype -- that is always the default for new Layers; and non-continuous linetypes are not applicable to Points, anyway, so the linetype doesn't matter.
It does not return the current Layer to what it was.
You can use (vlax-curve...) functions and Parameters to process LW Polylines the same way as "heavy" ones, so there's no need for separate sub-routines [which also removes a lot of variables].
It can limit the object types it will "see" in selection, rather than let you select just anything, and then go through and check each one's entity type.
I can't figure out why it's checking one coordinate only of the extrusion direction. If that was about handling them in different UCS's, mine does that in a different and much simpler way.
Variables that are used only once have been eliminated, and whatever was setting them used directly. I kept variable names that are still there as they were, and most prompts, but prompts I added or changed are in English, so you'll want to translate them. [And I changed SGPOLY to SGPLA for Polyline/Line/Arc.]

(defun C:VV
  (/ *error* doc svnames svvals SGPLA NUMOBJ NAMENT ENTGT TIPENT)
;;;
  (defun *error* (errmsg)
    (princ (strcat "\n»» Aplicação interrompida com erro: " errmsg))
    (mapcar 'setvar svnames svvals); reset System Variables
    (vla-endundomark doc)
    (princ)
  ); defun - *error*
;;;
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq ; System Variable saving/resetting without separate variables for each:
    svnames '(osmode cmdecho clayer); System Variable names
    svvals (mapcar 'getvar svnames); starting System Variable values
  ); setq
  (mapcar 'setvar svnames '(0 0)); Osnap & command echoing off
  (command "_.layer" "_thaw" "POINT" "_make" "POINT" "c" "1" "" "")
  (setvar 'pdmode 35); <--EDIT for preferred Point display style
  (prompt "\nTo draw Points at Polyline/Line/Arc vertices & endpoints,")
  (while (not (setq SGPLA (ssget '((0 . "*POLYLINE,LINE,ARC")))))
    (prompt "\n»» Nenhuma Polyline/Line/Arc entidade seleccionada!\n")
  ); while
  (repeat (setq NUMOBJ (sslength SGPLA))
    (setq
      NAMENT (ssname SGPLA (setq NUMOBJ (1- NUMOBJ)))
      TIPENT (cdr (assoc 0 (entget NAMENT)))
    ); setq
    (if (wcmatch TIPENT "*POLYLINE")
      (repeat ; then
        (setq n
          (+ (fix (vlax-curve-getEndParam NAMENT)) (if (vlax-curve-isClosed NAMENT) 0 1))
        ); setq
        (command "_.point" (trans (vlax-curve-getPointAtParam NAMENT (setq n (1- n))) 0 1))
      ); repeat
      (command ; else [Line or Arc]
        "_.point" (trans (vlax-curve-getStartPoint NAMENT) 0 1)
        "_.point" (trans (vlax-curve-getEndPoint NAMENT) 0 1)
      ); command
    ); if
  ); repeat
;;;
  (mapcar 'setvar svnames svvals); reset System Variables
  (vla-endundomark doc)
  (princ)
); defun -- C:VV
(princ "\n»» start VV \n")