Need a lisp for polyline to connect same text points

[kajanthangavel]

Hi. 

This is a road topography points.

I want a lisp program for draw polyline same name of text,

Polyline want to connect every "GE" Text base point. (GE means - Gravel Edge, Road Edge)

if this is possible, provide me a lisp. I have more than hundred drawing.

Sorry for bad English.

Thank you

[3wood]

You can try following steps.

Step 1, use QSELECT to select all text contain "GE".

Step 2, use LINKPOINTS to link these text with polyline(s).

[john.uhden]

One vexing question is how to know in what order to connect them.  I'm afraid that connectivity is in the eye of the beholder.

[Sea-Haven]

There may be a way as GE is left and right, get GE points, 3 values dist along C/L and offset hopefully + & - and insertion point so dbl sort offset then dist. Then just join pline points, as 1st go make 1 pline ignore join.

; left or right by Lee-mac
(defun ISL-R ( / ent pnt cpt der )
(if (and (setq ent (car (entsel)))
             (setq pnt (getpoint "\nPoint: "))
        )
		(progn
		(setq pnt (trans pnt 1 0))
    (setq cpt (vlax-curve-getclosestpointto ent pnt)
          der (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent cpt))
    )
    (if (minusp (sin (- (angle cpt pnt) (angle '(0.0 0.0) der))))
        (princ "\nPoint is on the right.")
        (princ "\nPoint is on the left.")
    )
    (princ)
)
)
)

[kajanthangavel]

Hi @Sea-Haven , I changed your lisp. 

I don't know, how to sort this polyline direction. If you can, give me a idea.

(setq plst (vl-sort ptLst '(lambda(a b)(<(car a)(car b)))))

; left or right by Lee-mac
(defun c:ISL-R ( / ent pnt cpt der ss hnd rhs lhs i)
(setq ent (car (entsel "\nSelect Center line : ")))
(prompt "\nSelect Text : ")
(if (setq ss (ssget '((0 . "*TEXT") (1 . "GE"))))
	(repeat (setq i (sslength ss))
		(setq hnd (ssname ss (setq i (1- i))))
		(setq pnt (cdr (assoc 10 (entget hnd))))
		(setq pnt (trans pnt 1 0))
		(setq cpt (vlax-curve-getclosestpointto ent pnt)
			  der (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent cpt))
		)
		(if (minusp (sin (- (angle cpt pnt) (angle '(0.0 0.0) der))))
			(setq rhs (cons pnt rhs)); Right Side
			(setq lhs (cons pnt lhs)); Left Side
		)
		(princ)
	)
)
(makepoly rhs)
(makepoly lhs)
)

(defun makepoly (allpoint / plst ptLst)
(setq ptLst (reverse allpoint))
(setq plst (vl-sort ptLst '(lambda(a b)(<(car a)(car b)))))
	(entmakex
		(apply 'append
			(list
				(list
				'(0 . "LWPOLYLINE")
				'(100 . "AcDbEntity")
				'(8 . "GE")
				'(100 . "AcDbPolyline")
				(cons 90 (length ptLst))
				(cons 38 (caddr (trans '(0 0 0) 1 (trans '(0. 0. 1.) 1 0))))
				'(70 . 0)
				)
			(mapcar '(lambda (x) (list 10 (car x) (cadr x)))
			(mapcar '(lambda (x) (trans x 1 (trans '(0. 0. 1.) 1 0))) plst)
			)
			(list (cons 210 (trans '(0. 0. 1.) 1 0)))
			)
		)
	)
)

My result

 Thank You

[kajanthangavel]

I need side by side.

[kajanthangavel]

😆😆😆

[Sea-Haven · Accepted solution]

Try this it sorts etc,

Pick pline

Pick a text this is for layer and text string.

Please note there is 1 point that is "spaceGE" so does not get picked up but could add *GE to ssget.

There will always be some mistakes as some EG are side shots rather than just on edge.

; Joinpts based on tex string and layer
; By Alanh June 2021

(defun c:joinpts ( / isl-r ahpllst obj ss ent ins cpt dist pts)

; left or right by lee-mac
(defun ISL-R ( ent pnt cpt / der )
	(setq pnt (trans pnt 1 0)
          der (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent cpt))
    )
    (if (minusp (sin (- (angle cpt pnt) (angle '(0.0 0.0) der))))
        (setq offs (distance cpt ins))
        (setq offs (- (distance cpt ins)))
    )
    (princ)
)

(defun LWPoly (lst cls)
 (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 cls))
                   (mapcar (function (lambda (p) (cons 10 p))) lst))))

(setq obj (vlax-ename->vla-object (car  (entsel "\nPick pline obj"))))
(setq ent (entget (car (entsel "\nPick a text"))))

(setq lay (cdr (assoc 8 ent)))
(setq txt (cdr (assoc 1 ent)))
(setq ss (ssget (list (cons 0 "TEXT")(cons 8 lay)(cons 1 txt))))

(setq lst '())

(repeat (setq x (sslength ss))
  (setq ent (ssname ss (setq x (- x 1))))
  (setq ins (cdr (assoc 10 (entget ent))))
  (setq cpt (vlax-curve-getclosestpointto obj ins))
  (ISL-R  obj ins  cpt)
  (setq dist (vlax-curve-getdistatpoint obj cpt))
  (setq lst (cons (list dist offs (list (car ins)(cadr ins))) lst))
)

(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))

(setq lst1 '() lst2 '())
(foreach pts lst
  (if (< (nth 1 pts) 0.0)
    (setq lst1 (cons (nth 2 pts) lst1))
    (setq lst2 (cons (nth 2 pts) lst2))
  )
)

(Lwpoly lst1 0)
(Lwpoly lst2 0)

(princ)
)

[3wood]

From the example file we can see the 'GE' actually is on both sides of the road.

Fortunately the road has a center polyline. If there is no road center line, please refer to my previous post and link all 'CL' into a road center line.

We can use this line to separate the GEs into 2 groups, one group for each side of the road.

For each group, use steps below to link GEs:

Step 1, Close the road center polyline and add a few more nodes to create a closed polyline enclosing all GEs on one side of the road.

Step 2, use SMARTSEL to select objects within the polyline.

Step 3, use QSELECT to exclude texts which content are not 'GE' from the selection.

Now all GEs on one side of the road are selected.

Step 4, use LINKPOINTS to link above GEs.

Step 5, repeat Step 2 to 4 to link GEs on the other side of the road. Result:

[kajanthangavel]

Wow. 😘, Excellent work @Sea-Haven , You solved my problem, what I need.

Thank You so much. It is save lots of time⏲.  😀😀

[Sea-Haven]

Having todo a lot of work around I have worked with field surveys for like 40 years the dwg provided is not a good survey, it needs string code or at least a, GEL GER or GE01 GE02 and so on. Our guys pick up like 10,000 points and would never do a multi gravel edges as GE. 

Newer survey instruments have a cross section feature so will auto GE1 CL1 GE2 as 3 consecutive points.

I have been looking at doing a string points in this case would have ended up with a zig zag pline joining GE.

[Dan-Rod]

amazing

It also served me well.

It is possible to use a similar code but for the lines to join blocks with the same name?

[Dan-Rod]

Sorry, it would actually be the same case but to link blocks that have exactly the same attribute, not the name of the block, since I have a file with many blocks with the same name but with different attributes and what I would like is for them to be linked with a polyline the blocks with the same attribute.

[Sea-Haven]

Post a dwg much easier to work with have blocknames and tag names.

[Dan-Rod]

I attach an example.

in it there are 6 blocks, they all have the same name, each one has 2 attributes, I would like them to be linked by the value of the attribute that is the same regardless of whether the name of the block is the same, I hope I can support myself.