Numbering Break-even point on polylines (parcels)

Hi to all,

I'm working on urban planning, and i need to put block (point+number) on evry vertex of polyline. Is there lsp that can do this automatic? So far I do this on the hard vay. I find CoorN.lsp on this forum and that is a closed what Im looking...but coorn.lsp put on 4 cornes polyline 5 points, and for the next polyline do same thing and I get a lot of duplicate points that do not need.

If anyone can help me, I would be grateful.

attached image is what I need.

Thanks!

Upload a drawing as an example showing ( before and after ) in dwg format .

Try this

(defun c:test (/ *error* a at cs e i j l n pt ss)
;;;  (setq *error* (err))
 (setq cs (vlax-get
            (vla-get-activedocument
              (vlax-get-acad-object
                (if (= (getvar 'cvport) 1)
                  'paperspace
                  'modelspace
                )
              )
            )
          )
 )
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq i 0
            n 1
      )
      (repeat (sslength ss)
        (setq e (ssname ss i)
              i (1+ i)
              j (vlax-curve-getstartparam e)
        )
        (while
          (setq pt (vlax-curve-getpointatparam e j))
           (if
             (not (vl-some '(lambda (x) (equal pt x 1e-5)) l))
              (progn
                (setq a (vla-insertblock
                          cs
                          (vlax-3d-point pt)
                          "PCT"        ;block name
                          1.0          ;X scale
                          1.0          ;Y scale
                          1.0          ;Z scale
                          0.0          ;rotation
                        )
                )
                (foreach at (vlax-invoke a 'GetAttributes)
                  (if
                    (eq (vla-get-tagstring at) "PCT_NO");attribute name
                    (vla-put-textstring at (itoa n))
                  )
                )
                (setq l (cons pt l)
                      n (1+ n)
                )
              )
           )
           (setq j (1+ j))
        )
      )
    )
 )
;;;  (*error* nil)
 (princ)
)

You have to edit this lisp and change block name and attribute name (Tag string) to match your block definition.

The numbering sequence depends on selection order and polyline's direction.

Upload a drawing as an example showing ( before and after ) in dwg format .

here are the DVG file with polylines, can be joined or broken, it is important when you select them and activate lsp to be mark vertex as in the image...

Drawing1.dwg

Try this

(defun c:test (/ *error* a at cs e i j l n pt ss)
;;;  (setq *error* (err))
 (setq cs (vlax-get
            (vla-get-activedocument
              (vlax-get-acad-object
                (if (= (getvar 'cvport) 1)
                  'paperspace
                  'modelspace
                )
              )
            )
          )
 )
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq i 0
            n 1
      )
      (repeat (sslength ss)
        (setq e (ssname ss i)
              i (1+ i)
              j (vlax-curve-getstartparam e)
        )
        (while
          (setq pt (vlax-curve-getpointatparam e j))
           (if
             (not (vl-some '(lambda (x) (equal pt x 1e-5)) l))
              (progn
                (setq a (vla-insertblock
                          cs
                          (vlax-3d-point pt)
                          "PCT"        ;block name
                          1.0          ;X scale
                          1.0          ;Y scale
                          1.0          ;Z scale
                          0.0          ;rotation
                        )
                )
                (foreach at (vlax-invoke a 'GetAttributes)
                  (if
                    (eq (vla-get-tagstring at) "PCT_NO");attribute name
                    (vla-put-textstring at (itoa n))
                  )
                )
                (setq l (cons pt l)
                      n (1+ n)
                )
              )
           )
           (setq j (1+ j))
        )
      )
    )
 )
;;;  (*error* nil)
 (princ)
)

You have to edit this lisp and change block name and attribute name (Tag string) to match your block definition.

The numbering sequence depends on selection order and polyline's direction.

; error: too many arguments

; error: too many arguments

Oh... my mistake

(defun c:test (/ *error* a at cs e i j l n pt ss) (vl-load-com)
;;;  (setq *error* (err))
 (setq cs
   (vlax-get
     (vla-get-activedocument
       (vlax-get-acad-object)
     )
     (if
       (= (getvar 'cvport) 1)
       'paperspace
       'modelspace
     )
   )
 )
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq i 0
            n 1
      )
      (repeat (sslength ss)
        (setq e (ssname ss i)
              i (1+ i)
              j (vlax-curve-getstartparam e)
        )
        (while
          (setq pt (vlax-curve-getpointatparam e j))
           (if
             (not (vl-some '(lambda (x) (equal pt x 1e-5)) l))
              (progn
                (setq a (vla-insertblock
                          cs
                          (vlax-3d-point pt)
                          "BLOK337"    ;block name
                          1.0          ;X scale
                          1.0          ;Y scale
                          1.0          ;Z scale
                          0.0          ;rotation
                        )
                )
                (foreach at (vlax-invoke a 'GetAttributes)
                  (if
                    (eq (vla-get-tagstring at) "BROJ");attribute name
                    (vla-put-textstring at (itoa n))
                  )
                )
                (setq l (cons pt l)
                      n (1+ n)
                )
              )
           )
           (setq j (1+ j))
        )
      )
    )
 )
;;;  (*error* nil)
 (princ)
)

Works perfectly!!!

I owe you!

I do not know whether it makes sense to ask for the code to extract the coordinates of points on these numbers that this code out?

Works perfectly!!!

I owe you!

 

I do not know whether it makes sense to ask for the code to extract the coordinates of points on these numbers that this code out?

You're welcome rakunat!

For the extras, you can use DataExtraction.

A lisp for this task is not complicated at all, but there are many things to consider (text height, style and more) and all depends on your dwg settings.

Anyway, for your sample dwg only, here is a little add to my previous lisp.

Please try it.

(defun c:test (/ *error* a at cs e i j l n pt ss p1 str) (vl-load-com)
;;;  (setq *error* (err))
 (setq cs
   (vlax-get
     (vla-get-activedocument
       (vlax-get-acad-object)
     )
     (if
       (= (getvar 'cvport) 1)
       'paperspace
       'modelspace
     )
   )
 )
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq i 0
            n 1
      )
      (repeat (sslength ss)
        (setq e (ssname ss i)
              i (1+ i)
              j (vlax-curve-getstartparam e)
        )
        (while
          (setq pt (vlax-curve-getpointatparam e j))
           (if
             (not (vl-some '(lambda (x) (equal pt x 1e-5)) l))
              (progn
                (setq a (vla-insertblock
                          cs
                          (vlax-3d-point pt)
                          "BLOK337"    ;block name
                          1.0          ;X scale
                          1.0          ;Y scale
                          1.0          ;Z scale
                          0.0          ;rotation
                        )
                )
                (foreach at (vlax-invoke a 'GetAttributes)
                  (if
                    (eq (vla-get-tagstring at) "BROJ");attribute name
                    (vla-put-textstring at (itoa n))
                  )
                )
                (setq l (cons pt l)
                      n (1+ n)
                )
              )
           )
           (setq j (1+ j))
        )
      )
      (if
        (setq p1 (getpoint "\nPick point to insert text: "))
        (progn
          (setq str "")
          (foreach x l
            (setq str
              (strcat
                "\n"
                 (itoa (setq n (1- n)))
                "\t"
                (rtos (cadr x) 2 3);y first ??
                "\t"
                (rtos (car x) 2 3) ;x
                str
                )
            )
          )
          (vla-put-height
            (vla-addmtext cs (vlax-3d-point p1) 50.0 (strcat "\\pxtr9,r18;" (substr str 2)))
            2
            )
          )
        )
    )
 )
;;;  (*error* nil)
 (princ)
)

Thanks Stefan, this is what I need.

When paste code in command line it works, and when load lsp through cad show error

error: bad argument type: numberp: #

On 12/20/2014 at 12:32 AM, Stefan BMR said:

Hi Stefan,

Nice work.

I just saw this today and somehow I need this as well but with Arc or Bulge on Arc. We need to add a point or in this case the block in the middle of arc on a polyline bulge/arc.

I hope you can find time to add this and thanks in advance.

On 12/20/2014 at 12:32 AM, Stefan BMR said:

 

 

You're welcome rakunat!

For the extras, you can use DataExtraction.

A lisp for this task is not complicated at all, but there are many things to consider (text height, style and more) and all depends on your dwg settings.

Anyway, for your sample dwg only, here is a little add to my previous lisp.

Please try it.

 

(defun c:test (/ *error* a at cs e i j l n pt ss p1 str) (vl-load-com)
;;;  (setq *error* (err))
 (setq cs
   (vlax-get
     (vla-get-activedocument
       (vlax-get-acad-object)
     )
     (if
       (= (getvar 'cvport) 1)
       'paperspace
       'modelspace
     )
   )
 )
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq i 0
            n 1
      )
      (repeat (sslength ss)
        (setq e (ssname ss i)
              i (1+ i)
              j (vlax-curve-getstartparam e)
        )
        (while
          (setq pt (vlax-curve-getpointatparam e j))
           (if
             (not (vl-some '(lambda (x) (equal pt x 1e-5)) l))
              (progn
                (setq a (vla-insertblock
                          cs
                          (vlax-3d-point pt)
                          "BLOK337"    ;block name
                          1.0          ;X scale
                          1.0          ;Y scale
                          1.0          ;Z scale
                          0.0          ;rotation
                        )
                )
                (foreach at (vlax-invoke a 'GetAttributes)
                  (if
                    (eq (vla-get-tagstring at) "BROJ");attribute name
                    (vla-put-textstring at (itoa n))
                  )
                )
                (setq l (cons pt l)
                      n (1+ n)
                )
              )
           )
           (setq j (1+ j))
        )
      )
      (if
        (setq p1 (getpoint "\nPick point to insert text: "))
        (progn
          (setq str "")
          (foreach x l
            (setq str
              (strcat
                "\n"
                 (itoa (setq n (1- n)))
                "\t"
                (rtos (cadr x) 2 3);y first ??
                "\t"
                (rtos (car x) 2 3) ;x
                str
                )
            )
          )
          (vla-put-height
            (vla-addmtext cs (vlax-3d-point p1) 50.0 (strcat "\\pxtr9,r18;" (substr str 2)))
            2
            )
          )
        )
    )
 )
;;;  (*error* nil)
 (princ)
)

 

BR/Emmanuel

Food for thought just pick inside each lot and it numbers the corners or a vertex in case of arcs so can be lines and plines etc. Ok I can hear but will end up with 2 numbers at a corner, so when selecting a new lot check if a number already exists and skip. The only rule is no gaps in the lots.

No code just an idea, like all the other ideas add to list.

Just a snippet

(setq pt (getpoint "\nPick point inside lot "))
(command "bpoly" pt "")
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(command "erase" (entlast) "")

; You now have  a list of points making up the lot

Make a block circle or square with a number in it see attached.

Pt num bubble.lsp

1 hour ago, BIGAL said:

error: LOAD failed: "Multi Getvals.lsp".

 

Maybe it will work like as shown by Stefan.

His lisp works fine, except I need to have an additional point in the midpoint of an arc, it's not an actual vertext of the polyline bust a computed middle point of the arc or bulge.

 

Also, is there a better way to check an insertion of blocks in the same point? somehow my routine fails to check this but works fine most of the time.

    (setq angle225r (dtr 225.0))   

    (setq c1 (polar p 0.7853981633974483 1.5))
    (setq c2 (polar p angle225r 1.5))
    (setq Exist_ent (ssget "_C" c1 c2 '((2 . "CRBLK")) ) )     ; check if there is any existing CRBLK block inside a box (c1, c2) around the point

I process the point list and skips if there is an existing block. A bit slow as well compared to Stefan.

 

Thanks in advance!

1 hour ago, BIGAL said:

 

1 hour ago, BIGAL said:

 

Food for thought just pick inside each lot and it numbers the corners or a vertex in case of arcs so can be lines and plines etc. Ok I can hear but will end up with 2 numbers at a corner, so when selecting a new lot check if a number already exists and skip. The only rule is no gaps in the lots.

 

No code just an idea, like all the other ideas add to list.

 

Just a snippet

 

(setq pt (getpoint "\nPick point inside lot "))
(command "bpoly" pt "")
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(command "erase" (entlast) "")

; You now have  a list of points making up the lot

Make a block circle or square with a number in it see attached.

 

Pt num bubble.lsp 3.48 kB · 0 downloads

9 hours ago, mannybmanago said:

Hi Stefan,

Nice work.

I just saw this today and somehow I need this as well but with Arc or Bulge on Arc. We need to add a point or in this case the block in the middle of arc on a polyline bulge/arc.

I hope you can find time to add this and thanks in advance.

Hi

Don't forget to change the block name, attribute name and text height if necessary

;Stefan M. - 2014.12.19
;Added extra point on arcs middle - 2020.12.13
(defun c:test (/ *error* acdoc a at cs e i j l n pt ss p1 str arc f)
  (vl-load-com)
  
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        cs (vlax-get acdoc
             (if
               (= (getvar 'cvport) 1)
               'paperspace
               'modelspace
             )
           )
  )
  
  (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
  (vla-startundomark acdoc)
  
  (defun *error* (msg)
    (and msg
      (not (wcmatch (strcase msg) "*EXIT*,*CANCEL*,*ABORT*"))
      (princ (strcat "\nERROR: " msg))
    )
    (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
    (princ)
  )
  
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq i 0
            n 1
      )
      (repeat (sslength ss)
        (setq e (ssname ss i)
              i (1+ i)
              j (vlax-curve-getstartparam e)
        )
        (while
          (setq pt (vlax-curve-getpointatparam e j))
          
           (if
              (not (vl-some '(lambda (x) (equal pt x 1e-5)) l))
              (progn
                (setq a (vla-insertblock
                          cs
                          (vlax-3d-point pt)
                          "BLOK337"    ;block name
                          1.0          ;X scale
                          1.0          ;Y scale
                          1.0          ;Z scale
                          0.0          ;rotation
                        )
                )
                (foreach at (vlax-invoke a 'GetAttributes)
                  (if
                    (eq (vla-get-tagstring at) "BROJ");attribute name
                    (vla-put-textstring at (itoa n))
                  )
                )
                (setq l (cons pt l)
                      n (1+ n)
                )
              )
           )
           
           (cond
             (arc (setq j (+ 0.5 j) arc nil)) 
             ((setq f (vlax-curve-getsecondderiv e (+ j 0.1)))
              (if
                (equal f '(0 0 0) 1e-5)
                (setq j (+ 1.0 j) arc nil)
                (setq j (+ 0.5 j) arc T)
              )
             )
             (T (setq j (+ 1.0 j) arc nil))
          )
        )
      )
      (if
        (setq p1 (getpoint "\nPick point to insert text: "))
        (progn
          (setq str "")
          (foreach x l
            (setq str
              (strcat
                "\n"
                 (itoa (setq n (1- n)))
                "\t"
                (rtos (cadr x) 2 3);y first ??
                "\t"
                (rtos (car x) 2 3) ;x
                str
                )
            )
          )
          (vla-put-height
            (vla-addmtext cs (vlax-3d-point p1) 50.0 (strcat "\\pxtr9,r18;" (substr str 2)))
            2
            )
          )
        )
     )
  )
  (*error* nil)
  (princ)
)

If you go to "Downloads" here at cadtutor the two multi lisps are there. The Pt num bubble code can be used as an example of make a block on the fly if it does not exist, in that code it can be a circle or a square. Just look for the relevant bits (defun make_circle () (defun make_sq () (defun Make_bubble ( )

Stefan has provided a solution to the 1/2 arc. 

Re find existing block at point my method is use a polygon around the point and SSGET "F" to see if say a block is there. 

May have time soon to look at pick inside. Lee-macs great polyline information would provide all the answers just adding the mid point of the arc as an extra point to a bpoly that has been created.

Also add the 2 options table and csv export.

Re pick points if you label the lots then it can all happen automatically, look here for "label lots" just find  text label for pick point.

14 hours ago, Stefan BMR said:

Good Morning Stefan,

 

It works perfectly. I have been searching for this solution for quite a while.

Thank you so much!

If you have time again, would make some comments on this program.

I can understand one some of the logic, but I am not really good using vla functions.

I will dig-into this vla functions once I get some of the tasks off my hands. 

Again, thank you so much!

 

BR/Emmanuel

14 hours ago, Stefan BMR said:

 

Hi

Don't forget to change the block name, attribute name and text height if necessary

;Stefan M. - 2014.12.19
;Added extra point on arcs middle - 2020.12.13
(defun c:test (/ *error* acdoc a at cs e i j l n pt ss p1 str arc f)
  (vl-load-com)
  
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        cs (vlax-get acdoc
             (if
               (= (getvar 'cvport) 1)
               'paperspace
               'modelspace
             )
           )
  )
  
  (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
  (vla-startundomark acdoc)
  
  (defun *error* (msg)
    (and msg
      (not (wcmatch (strcase msg) "*EXIT*,*CANCEL*,*ABORT*"))
      (princ (strcat "\nERROR: " msg))
    )
    (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
    (princ)
  )
  
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq i 0
            n 1
      )
      (repeat (sslength ss)
        (setq e (ssname ss i)
              i (1+ i)
              j (vlax-curve-getstartparam e)
        )
        (while
          (setq pt (vlax-curve-getpointatparam e j))
          
           (if
              (not (vl-some '(lambda (x) (equal pt x 1e-5)) l))
              (progn
                (setq a (vla-insertblock
                          cs
                          (vlax-3d-point pt)
                          "BLOK337"    ;block name
                          1.0          ;X scale
                          1.0          ;Y scale
                          1.0          ;Z scale
                          0.0          ;rotation
                        )
                )
                (foreach at (vlax-invoke a 'GetAttributes)
                  (if
                    (eq (vla-get-tagstring at) "BROJ");attribute name
                    (vla-put-textstring at (itoa n))
                  )
                )
                (setq l (cons pt l)
                      n (1+ n)
                )
              )
           )
           
           (cond
             (arc (setq j (+ 0.5 j) arc nil)) 
             ((setq f (vlax-curve-getsecondderiv e (+ j 0.1)))
              (if
                (equal f '(0 0 0) 1e-5)
                (setq j (+ 1.0 j) arc nil)
                (setq j (+ 0.5 j) arc T)
              )
             )
             (T (setq j (+ 1.0 j) arc nil))
          )
        )
      )
      (if
        (setq p1 (getpoint "\nPick point to insert text: "))
        (progn
          (setq str "")
          (foreach x l
            (setq str
              (strcat
                "\n"
                 (itoa (setq n (1- n)))
                "\t"
                (rtos (cadr x) 2 3);y first ??
                "\t"
                (rtos (car x) 2 3) ;x
                str
                )
            )
          )
          (vla-put-height
            (vla-addmtext cs (vlax-3d-point p1) 50.0 (strcat "\\pxtr9,r18;" (substr str 2)))
            2
            )
          )
        )
     )
  )
  (*error* nil)
  (princ)
)

 

On 12/14/2020 at 1:25 AM, BIGAL said:

If you go to "Downloads" here at cadtutor the two multi lisps are there. The Pt num bubble code can be used as an example of make a block on the fly if it does not exist, in that code it can be a circle or a square. Just look for the relevant bits (defun make_circle () (defun make_sq () (defun Make_bubble ( )

 

Stefan has provided a solution to the 1/2 arc. 

 

Re find existing block at point my method is use a polygon around the point and SSGET "F" to see if say a block is there. 

 

May have time soon to look at pick inside. Lee-macs great polyline information would provide all the answers just adding the mid point of the arc as an extra point to a bpoly that has been created.

 

Also add the 2 options table and csv export.

 

Re pick points if you label the lots then it can all happen automatically, look here for "label lots" just find  text label for pick point.

Thanks Bigal!

Got it working and no duplicates using Stefan's code.

However, I wanted to be able to understands his code which I can't understand the logic well.

I wanted to be able collect the vertices of the polygon with the additional arc midpoint so I will have a list of points for that specific land/parcel.

Moving to the next land/parcel, do the same to add points and collect the points.

Two possible situations here, collect all points by "fence" crossing but this will include adjacent points too.

Collect only the parcel points without the adjacent parcels points.

Both required for flexibility.

See illustration below:

Regards/Emmanuel

Did you have a look at Lee-mac Polyline information lisp it includes xy and arc details, as a starting point for method. 

Using bpoly makes a new pline representing the internal shape

What happens here it would not necessarily be plines

Need some time to do something.

This is real rough but its just a start and will handle the shape like a court bowl. Shows how to use bpoly. I added a direction to the point label. It is no where finished but thought I would post any way next step is check for duplicate blocks.

In code  (setq ptpl (polar pt (angle pt pt2) 10)) change the 10 to suit its the offset value.

; bubble pt num for lot corners 
; BY ALAN H AUG 2020
 
(defun make_circle ()
  (entmake (list (cons 0 "CIRCLE")
  (cons 8 "0") ; layr
  (cons 10 (list 0 0 0)) ; cen pt
  (cons 40 3.25)     ; rad
  (cons 210 (list 0 0 1))
  (cons 62 256) 
  (cons 39 0)
  (cons 6 "BYLAYER")
   )
  )
) ; DEFUN
 
(defun make_sq ()
; 4 cnr points
  (setq   vertexList
  (list
  (list -3.25 -3.25 0.)
  (list 3.25 -3.25 0.)
  (list 3.25 3.25 0.)
  (list -3.25 3.25 0.)
  ))
  (entmake
    (append 
    (list '(0 . "LWPOLYLINE")
    '(100 . "AcDbEntity")
    '(100 . "AcDbPolyline")
    (cons 90 (length vertexList))
    (cons 70 1)   ; 1 closed : 0 open
    (cons 8 "0")
    (cons 38 0.0)
    (cons 210 (list 0.0 0.0 1.0))
    )
    (mapcar '(lambda (pt) (cons 10 pt)) vertexList)
    )
  ) ; entmake
) ; defun
 
(defun Make_bubble ( )
 
  (entmake (list (cons 0 "BLOCK")
    (cons 2 Blkname)
    (cons 70 2)
    (cons 10 (list 0 0 0))
    (CONS 8 "0")
  ))
 
  (if (= resp "C")
  (make_circle)
  (make_sq)
  )
 
  (entmake (list (cons 0 "ATTDEF")
       (cons 8 "0")
       (cons 10 (list 0 0 0))
       (cons 1 "1")    ; default value
       (cons 2 blkname) ; nblock name
       (cons 3 "Ptnum") ; tag name
       (cons 6 "BYLAYER")
       (cons 7 "STANDARD")             ;text style
       (cons 8 "0")    ; layer
       (cons 11 (list 0.0 0.0 0.0)) ; text insert pt
       (cons 39 0)
       (cons 40 3.5)           ; text height
       (cons 41 1)     ; X scale
       (cons 50 0)     ; Text rotation
       (cons 51 0)     ; Oblique angle
       (cons 62 256)          ; by layer color 
       (cons 70 0)
       (cons 71 0)     ;Text gen flag
       (cons 72 1)     ; Text Justify hor 1 center
       (cons 73 0)     ; field length
       (cons 74 2)     ; Text Justify ver 2 center
       (cons 210 (list 0 0 1))
  ))
 
  (entmake (list (cons 0 "ENDBLK")))
(command "erase" "L" "") ; do not need linework etc so erase
  (princ)

)
 
(defun C:bub (/ ptnum ptnumb pt pt2 oldsnap chrnum sc curspace)
  
  (setq oldsnap (getvar "osmode"))
  (setvar "textstyle" "standard")
 
  (setq ptnumb (getint "\nEnter Pt Number "))
  
 

(initget 6 "S s C c")
(setq resp (strcase (Getkword "\nDo you want Circle or Square C or S <C> ")))
(if (or (= resp "C") (= resp nil))
  (setq blkname "SETOUT_POINT_NO")
  (setq blkname "SETOUT_POINT_NOSQ")
)

(if (/= (tblsearch "BLOCK" blkname) NIL)
(PRINC "FOUND")    ; block exists
(Make_bubble)
)

(while (setq pt (getpoint "\Pick inside lot  Enter to exit"))
(command "bpoly" pt "")
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(command "erase" (entlast) "")

(setvar "osmode" 0)
	
(repeat (setq x (length co-ord))
(setq pt (nth (setq x (- x 1)) co-ord))
(setq pt2 (getpoint pt "\nPick direction for blk "))
(setq ptpl (polar pt (angle pt pt2) 10))
(command "-insert" blkname ptpl 1 1 0 (rtos ptnumb 2 0))
(setq ptnumb (+ ptnumb 1))
 )
	
(setvar "osmode" 1)
)
)
(setvar "osmode" oldsnap)
(princ)
)
(alert "Type Bub to repeat\nSquare or circles")
(C:BUB)

On 12/14/2020 at 7:21 AM, mannybmanago said:

Good Morning Stefan,

 

It works perfectly. I have been searching for this solution for quite a while.

Thank you so much!

If you have time again, would make some comments on this program.

I can understand one some of the logic, but I am not really good using vla functions.

I will dig-into this vla functions once I get some of the tasks off my hands. 

Again, thank you so much!

 

BR/Emmanuel

On 12/15/2020 at 1:02 PM, mannybmanago said:

Thanks Bigal!

 

Got it working and no duplicates using Stefan's code.

However, I wanted to be able to understands his code which I can't understand the logic well.

I wanted to be able collect the vertices of the polygon with the additional arc midpoint so I will have a list of points for that specific land/parcel.

Moving to the next land/parcel, do the same to add points and collect the points.

Two possible situations here, collect all points by "fence" crossing but this will include adjacent points too.

Collect only the parcel points without the adjacent parcels points.

Both required for flexibility.

See illustration below:

 

Regards/Emmanuel

Hi

The order in which the polylines are processed is the order in the selection set. If you pick them one at the time, they are processed in the picking order.

If you select them by windows or cross, the order in the selection set is the creation order, reversed, so the newest one is processed first.

Selection by fence order is more like picking, first selected, first processed.

A sorting algorithm would be a better solution, maybe someone already have such a routine.

The idea behind the bpoly is that I would look for the lot number and do in sequence all required in one go no picking. Need time doing some other stuff at moment.