Add coordinate at verticies

[RepCad]

Hello everyone, 
I'm trying to write a program to add coordinate at each vertex of a polyline as leader automatically, Like attached file. I have written a piece of code, but it requests second point for each leader, while it should be inserted automatically.

 

(defun C:PCL ()

  (setq pl (car (entsel "\nSelect Polyline to label its vertices: ")))
  (setq l (lwp-points pl))

  (foreach a l
    (setq txt (strcat (rtos (car a) 2 3) "\\P" (rtos (cadr a) 2 3)))
    (command "_.leader" "_none" a pause "" txt "")
  )

)


(defun lwp-points (ele)
  (mapcar
    'cdr
    (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ele))
  )
)

 

Leader.dwg

[devitg]

2 hours ago, RepCad said:

Hello everyone, 
I'm trying to write a program to add coordinate at each vertex of a polyline as leader automatically, Like attached file. I have written a piece of code, but it requests second point for each leader, while it should be inserted automatically.

 

(defun C:PCL ()

  (setq pl (car (entsel "\nSelect Polyline to label its vertices: ")))
  (setq l (lwp-points pl))

  (foreach a l
    (setq txt (strcat (rtos (car a) 2 3) "\\P" (rtos (cadr a) 2 3)))
    (command "_.leader" "_none" a pause "" txt "")
  )

)


(defun lwp-points (ele)
  (mapcar
    'cdr
    (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ele))
  )
)

 

Leader.dwg 78.06 kB · 1 download

@RepCad mean while , change it 

 

    (setq txt (strcat "x = " (rtos (car a) 2 3) "\\P"  "y = " (rtos (cadr a) 2 3)))

 

 

Quote

but it requests second point for each leader, while it should be inserted automatically.

 

How do you think it will choose te second point , maybe by   polar from vertex , but which angle ?

 

 

 

 

Edited July 8, 2023 by devitg
add quote

[RepCad]

22 minutes ago, devitg said:

@RepCad mean while , change it 

 

    (setq txt (strcat "x = " (rtos (car a) 2 3) "\\P"  "y = " (rtos (cadr a) 2 3)))

 

 

 

How do you think it will choose te second point , maybe by   polar from vertex , but which angle ?

 

 

 

 

Thank you,

I don't have any idea about angle of the second point, but the important thing is that leaders not be on the polyline.

[BIGAL]

If its a pline then the leader angle can be considered as the 1/2 difference of angle between vertices 1-2-3,  2-3-4,  3-4 -1, 4-1-2. The other thing is need to check is pline CW CCW. Controls wether it goes in or out. The other check is which quadrant is leader in, so text goes out also.

Edited July 8, 2023 by BIGAL

[devitg]

@RepCad @BIGAL, how to let ACAD to work by himself?

It is what it is for was made.

 

 

 

leader @ vertex.lsp new - Leader.dwg

[mhupp]

@devitg that lisp has two short comings like bigal said you need to check the CW or CCW of the polyline because depending on that if the polyline is offset in or out the VLAX-CURVE-GETCLOSESTPOINTTO will find a different point. it will be on the polyline but not the vertex XY cords. using the vl-sort with lambda searches the already found points of the polyline and picks the closest one to the offset point. (still not 100% but pretty close) see my drawing blue is below points white is your lisp. it was offset to the inside

 

(DEFUN C:PCL (/ A ADOC MODEL PL L OFF OFF-PL-L PL PL-OBJ TEXTSIZE TXT pts )
  (VL-LOAD-COM)
  (setq ADOC (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (setq mspace (vla-get-modelspace ADOC))
  (setq PL (car (entsel "\nSelect Polyline to label its vertices: ")))
  (setq PL-OBJ (vlax-ename->vla-object PL))
  (setq L (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget PL))))
  (setq TEXTSIZE (getvar 'TEXTSIZE))
  (setq off (vlax-invoke PL-OBJ 'offset (if (CW PL-OBJ) (* -2 TEXTSIZE) (* 2 TEXTSIZE)))) ;offset to outside 
  (setq OFF-PL-L (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (vlax-vla-object->ename (car off))))))
  (vla-delete (car off))
  (foreach pt OFF-PL-L
    (setq A (car (vl-sort L (function (lambda ( a b ) (< (distance pt a) (distance pt b))))))) ;finds cloest point of polyline to pt
    (setq txt (strcat "X:" (rtos (car A) 2 3) "\\P" "Y:" (rtos (cadr A) 2 3)))
    (COMMAND "_.leader" "_non" A pt "" txt "")
  )  ;end FOREACH
)    ;END LEADER-VERTX

;;----------------------------------------------------------------------------;;
; Checking if pline drawn CW or CCW - Writer Evgeniy Elpanov By Bill Gilliss
(defun CW (poly / lw lst LL UR)
  (if (= poly vla-item)
    (setq lw poly)
    (setq lw (vlax-ename->vla-object poly))
  )
  (vla-GetBoundingBox lw 'LL 'UR)
  (setq LL (vlax-safearray->list LL)
        UR (vlax-safearray->list UR)
        lst (mapcar
              (function
                (lambda (x)
                        (vlax-curve-getParamAtPoint poly
                                                    (vlax-curve-getClosestPointTo poly x)
                        )
                )
              )
              (list LL (list (car LL) (cadr UR))
                    UR (list (car UR) (cadr LL))
              )
            )
  )
  (if
    (or
      (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
      (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
      (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
      (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
    ) ;_ or
    t
  )
)

points.dxf

Edited July 10, 2023 by mhupp

[devitg]

3 hours ago, mhupp said:

it was offset to the inside

@mhupp. ok, naturally offset is going outside.

Instead checking for CCW or CW ,  it is easy to check if the new offset poly has a bigger area than the original, then it is outside

Edited July 9, 2023 by devitg
add comment

[Tsuky]

@RepCad

I have this for the definition points of LINE,MLINE,POLYLINE,POINT,ARC,CIRCLE,ELLIPSE or INSERT.

If some placements are incorrect it is easy to redirect them with the grips

(vl-load-com)
(defun l-coor2l-pt (lst flag / )
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (if flag
          (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst))
          (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
        )
      )
      (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
    )
  )
)
(defun make_lead (pt / obj ptlst arr nw_obj)
  (setq
    obj (entlast)
    ptlst (append pt (polar pt o_lead d_lead))
    arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
  )
  (vlax-safearray-fill arr ptlst)
  (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
  (vla-put-contenttype nw_obj acMTextContent)
  (vla-put-textstring nw_obj (strcat "\\fArial|b0|i0|c0|p34;X = " (rtos (car pt) 2 3) "\\PY = " (rtos (cadr pt) 2 3)))
  (vla-put-layer nw_obj "Id-XY")
  (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
  (vla-put-DoglegLength nw_obj (getvar "TEXTSIZE"))
  (vla-put-LandingGap nw_obj (getvar "TEXTSIZE"))
  (vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
  (if (> (car (getvar "VIEWCTR")) (car pt_lead))
    (progn
      (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0)))
      (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight)
      (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr))
    )
    (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft)
  )
)
(defun c:ptdef-xy2lead ( / js htx rtx rtx0 pt_lead d_lead o_lead AcDoc Space dxf_cod n lremov ent ename l_pt l_pr)
  (princ "\nSelect an object for filtering model: ")
  (while
    (null
      (setq js
        (ssget "_+.:E:S"
          (list
            '(0 . "LINE,MLINE,*POLYLINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nIsn't an availaible object for this function!")
  )
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive field height <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nGive field orientation <0.0>: "))) (setq rtx 0.0))
  (setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx))
  (initget 1)
  (setq pt_lead (getpoint (getvar "VIEWCTR") "\nGive general orientation and distance for guide: "))
  (setq d_lead (distance (getvar "VIEWCTR") pt_lead))
  (setq o_lead (angle (getvar "VIEWCTR") pt_lead))
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (vla-startundomark AcDoc)
  (cond
    ((null (tblsearch "LAYER" "Id-XY"))
      (vlax-put (vla-add (vla-get-layers AcDoc) "Id-XY") 'color 174)
    )
  )
  (setq dxf_cod (entget (ssname js 0)))
  (initget "Single Multiple")
  (if (eq (getkword "\nSelection filtering [Single/Multiple]<M>: ") "Single")
    (setq n -1)
    (setq
      dxf_cod (entget (ssname js 0))
      js
      (ssget "_X" 
        (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
          (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
        )
      )
      n -1
    )
  )
  (repeat (sslength js)
    (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))) l_pt nil)
    (setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints))
    (foreach n l_pr
      (if (vlax-property-available-p ename n)
        (setq l_pt
          (if (eq n 'Coordinates)
            (progn
              (append
                (if (eq (vla-get-ObjectName ename) "AcDbPolyline")
                  (l-coor2l-pt (vlax-get ename n) nil)
                  (l-coor2l-pt (vlax-get ename n) T)
                )
                l_pt
              )
            )
            (cons (vlax-get ename n) l_pt)
          )
        )
      )
    )
    (mapcar 'make_lead l_pt)
  )
  (vla-regen AcDoc acactiveviewport)
  (vla-endundomark AcDoc)
  (prin1)
)

 

[1958]

The above codes don't work for me. I wrote my version.

 

coor_vert.LSP

Edited July 11, 2023 by 1958

[thecocuk07]

On 7/11/2023 at 2:52 PM, 1958 said:

The above codes don't work for me. I wrote my version.

 

coor_vert.LSP 1,39 kB · 3 indirme

Hi 

 

(strcat "\nx = " (rtos (car p1) 2 3) "\ny = " (rtos (cadr p1)))

Edited July 25, 2023 by thecocuk07