Finding vertices of a polyline inside a block

[Anonymous]

Hi; I'm looking for a code/function/solution that gives the vertices of a polyline inside a block relatively to its position,rotation or something else. I write a code but when i copy the block to another place, and then the code gives me the same list. (point list that relatively to its basepoint) (sorry my language mistakes) Thanks...

[pbejse]

---

@Anonymous wrote:
........... of a polyline inside a block relatively to its position,rotation or something else. I write a code but when i copy the block to another place, and then the code gives me the same list.....

---

Show us the code then we'll pick up from there.

[Anonymous]

(defun c:trimpoint()
(setq obje(entsel "\nLütfen bir blok seçin"))
(setq tur (cdr(assoc 0 (entget (car obje)))))
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(while (/= tur "INSERT")
(setq obje(entsel "\nLütfen geçerli bir blok seçin"))
(setq tur (cdr(assoc 0 (entget (car obje)))))
)
(setq blockname (cdr (assoc 2 (entget(car obje)))))
(setq entlist(get-block-entities blockname))
(foreach ent entlist
(setq entvla (vlax-ename->vla-object ent))
(setq layer (vlax-get-property entvla 'Layer))
(if (= "Trimpoint" layer)
(progn
(setq noktalar (poly-pts ent))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;This Code gives the points but another block with the same name, the points are same again. Because selected polyline entity name is same in every block with the same name.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(princ noktalar)
)

)
)
)

;;; Selection Set => ordered list of entities
(defun STD-SSLIST (ss / n lst)
;|#+ STANDALONE nil END #+ STANDALONE|;
;|#- STANDALONE|;
(if (eq 'PICKSET (type ss))
(repeat (setq n (fix (sslength ss))) ; fixed
(setq lst (cons (ssname ss (setq n (1- n))) lst))))
;|END #- STANDALONE|;
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun get-block-entities ( blk / ent lst )
;; Define the function, declare local variables

(if ;; If the following returns a non-nil value
;; i.e. if the block exists in the drawing

(setq ent (tblobjname "block" blk)) ;; get the BLOCK entity

(while (setq ent (entnext ent))
;; Step through the entities in the block definition

(setq lst (cons ent lst))
;; Construct a list of the block components

) ;; end WHILE

) ;; end IF

(reverse lst) ;; Return the list

) ;; end DEFUN

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Poly-Pts (gile) (X-Y Modified)
;;; Returns the vertices list of any type of polyline (WCS coordinates)
;;;
;;; Argument
;;; pl : a polyline (ename or vla-object)

(defun Poly-Pts (pl / pa pt lst)
(vl-load-com)
(setq pa (if (vlax-curve-IsClosed pl)
(vlax-curve-getEndParam pl)
(+ (vlax-curve-getEndParam pl) 1)
)
)
(while (setq pt (vlax-curve-getPointAtParam pl (setq pa (- pa 1))))
(setq pt (list (car pt) (cadr pt)))
(setq lst (cons pt lst))
)
)

[Kent1Cooper]

Welcome to these Forums!

If:

1) the nested Polyline [from (nentsel)] entity data list is in a variable, let's call it 'pldata'

2) the Block is Inserted at scale factors of 1 [but at any rotation]

3) you set the User Coordinate System to match the Block insertion [UCS, OBject option]

then this:

(setq verts (mapcar '(lambda (x) (trans x 1 0)) (mapcar 'cdr (vl-remove-if-not '(lambda (y) (= (car y) 10)) pldata))))

will return the locations of the nested Polyline's vertices in that insertion, in World Coordinate System coordinates, and store them in a list in the 'verts' variable.

It doesn't account for scale factors other than 1.  That could perhaps be done, but I think it would be very complicated.  But this may have come up before -- you might find something with a Search.

I was expecting that the 1 in that (trans) function [the 'from' argument for the current Coordinate System] could be replaced by the Block's entity name, without changing the UCS to match the Block, but though that seems to be the way Help describes it, it doesn't seem to work that way -- maybe I'm misunderstanding what it means.

[Ranjit_Singh]

Can you post a drawing with subject blocks? It might make easier to understand the problem. I tried using your LISP to test some blocks at my end but I get no output at all. Basically, I am trying to recreate the issue to see if I can help.

[Anonymous]

Sorry for late reply cause I' m on holiday. I've change the lisp like this. You can use this lisp with the attachment.

I'm trying to find the coordinates of the polylines in that block, relatively to the block's position, rotation, scale etc.

Thanx for replies.

(defun c:trimpoint()
(setq secim (ssget "_:L" '((0 . "INSERT"))))
(foreach objevla (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex secim)))) ;_ end of mapcar
(setq blockname (vla-get-effectivename objevla))
(setq entlist(get-block-entities blockname))
(foreach ent entlist
(setq entvla (vlax-ename->vla-object ent))
(setq layer (vlax-get-property entvla 'Layer))
(if (= "Trimpoint" layer)
(progn
(setq noktalar (poly-pts ent))
(Princ "\n")
(princ noktalar)
(Princ)
); Progn
);If
);Foreach
);Foreach
);Defun

[Anonymous]

Thanks for the reply. I can use this code if there is not better solution. (scale, dynamic blocks etc.) The truth is I want to trim some lines or polylines for each block but the specific points. And i will use dynamic blocks. I know its complicated, but there must be some ways to do this. I thougth if i could find the vertices of the polyline i can do the trim job with fence or something else.

[SeeMSixty7]

One thing you can do is use trans function and basically use a UCS based on the Block insert you are dealing with and translate those point back to the WCS. This would provide you with your actual points. If the block scale is anything other than 1.0, Then you can apply the blocks scale to those points and then translate them to the world coordinates system to get the actual points.

Hope that helps.

[Kent1Cooper]

---

@SeeMSixty7 wrote:

One thing you can do is use trans function ... use a UCS based on the Block insert ... and translate those point back to the WCS. .... If the block scale is anything other than 1.0, Then you can apply the blocks scale to those points ....

---

That's exactly my suggestion in Post 4.  The tricky part would be how to "apply the block's scale to those points."  I think it would require a combination of (polar) based off the Block's insertion point, (angle) between that and the vertex location as defined in the Block, and a multiplier of (distance) from the insertion to that vertex times the scale factor.  But it gets far more complicated if the X and Y scale factors might not always be equal, because the (angle) calculation will be throw off by that [the angle in the Block definition will not be the same as the angle in an unequally-scaled insertion of it, except in the parallel-to-XY-axis directions].  There might need to be some trigonometry thrown in if that's something that needs to be accounted for.

So, @Anonymous, is this approach likely to be able to give you what you want?  Is it worth pursuing to develop the necessary code?  Before anyone gets carried away, do you ever use scale factors other than 1 for the Blocks you're talking about?  Do you ever use unequal X and Y scale factors?

[Anonymous]

I dont like unequal scales 🙂 so i don't use them. I'l try the trans function or something else to find these points. I thought there is an easier way. But I realize there is none. I'll share the lisp if I can succeed. Thanks for your attention. (note: if you find an easier way... please share.)

[SeeMSixty7]

Kent, Sorry I didn't notice your post, I skimmed through the other posts. I should have read a bit more.

I believe just applying a scale factor to the points from the pline would be sufficient for finding the new points without having to worry about using trig. the points are points just with a multiplier. If the block has different x and y scale factor points then you would need to break apart the x and y points and multiply them by the scale values, that includes a varied Z factor as well then use the new point list to run through trans and get all the WCS points.

Thanks and hopefully that makes sense.

[SeeMSixty7]

I don't use blocks with inconsistent x,y,z scale factors either, but keep in mind if someone mirrors your block you will get a negative value in one of your values and you will need to compensate for that as well.

good luck with the routine.

[Ranjit_Singh]

Try the attached, something very basic but you can improve on it. It works on your drawing. I scaled the blocks and tested as well.

Spoiler

(defun c:blpl (/ entlst entmat entnew entlst)
 (setq entlst (nentsel "\nSelect Line/Polyline in Block :"))
 (apply 'append
        (mapcar '(lambda (x)
                  (if (or (= 10 (car x)) (= 11 (car x)))
                   (list (append (list (+ (* (car (nth 0 (setq entmat (caddr entlst)))) (cadr x))
                                          (* (car (nth 1 entmat)) (caddr x))
                                          (car (nth 3 entmat))
                                       ) ;_ end +
                                 ) ;_ end list
                                 (list (+ (* (cadr (nth 0 entmat)) (cadr x))
                                          (* (cadr (nth 1 entmat)) (caddr x))
                                          (cadr (nth 3 entmat))
                                       ) ;_ end +
                                 ) ;_ end list
                         ) ;_ end append
                   ) ;_ end list
                  ) ;_ end if
                 ) ;_ end lambda
                (if (= "POLYLINE" (cdr (assoc 0 (entget (car entlst)))))
                 (progn (setq entnew (car (entlst)))
                        (while (/= "SEQEND" (cdr (assoc 0 (entget entnew))))
                         (setq entnew (entnext entnew))
                         (setq entlst (cons (assoc 10 (entget entnew)) entlst))
                        ) ;_ end while
                 ) ;_ end progn
                 (entget (car entlst))
                ) ;_ end if
        ) ;_ end mapcar
 ) ;_ end apply
) ;_ end defun

[SeeMSixty7]

Nice! I completely forgot that nentsel would return the transformation, matrix.

[Ranjit_Singh · Accepted solution]

Spoiler

(defun c:blpl (/ entlst entmat entnew entlst entlst2 entlst3)
 (setq entlst (nentsel "\nSelect Line/Polyline in Block :"))
 (apply 'append
        (mapcar '(lambda (x)
                  (if (or (= 10 (car x)) (= 11 (car x)))
                   (list (append (list (+ (* (car (nth 0 (setq entmat (caddr entlst)))) (cadr x))
                                          (* (car (nth 1 entmat)) (caddr x))
                                          (car (nth 3 entmat))
                                       ) ;_ end +
                                 ) ;_ end list
                                 (list (+ (* (cadr (nth 0 entmat)) (cadr x))
                                          (* (cadr (nth 1 entmat)) (caddr x))
                                          (cadr (nth 3 entmat))
                                       ) ;_ end +
                                 ) ;_ end list
                         ) ;_ end append
                   ) ;_ end list
                  ) ;_ end if
                 ) ;_ end lambda
                (if (= "POLYLINE" (cdr (assoc 0 (entget (setq entlst2 (cdr (assoc 330 (entget (car entlst)))))))))
                 (progn (setq entnew entlst2)
                        (while (/= "SEQEND" (cdr (assoc 0 (entget entnew))))
                         (setq entnew (entnext entnew))
                         (setq entlst3 (cons (reverse (cdr (reverse (assoc 10 (entget entnew))))) entlst3))
                        ) ;_ end while
                 ) ;_ end progn
                 (entget (car entlst))
                ) ;_ end if
        ) ;_ end mapcar
 ) ;_ end apply
) ;_ end defun

 The last one just retrieved one vertex when it was on old style polyline. This one will catch all vertices.

[Anonymous]

Thanks for the code... It works great at different scales, rotation even dynamic blocks. At least I will use this code to do my job. But i wonder if it can done by using ssget function and foreach loop. Because the thing I want to do is by selecting a block and i will get the vertices of plines in all blocks at the same name (seperately lists of vertices in for each block)

[Anonymous]

Good Day,

Thank you Ranjit for providing your solution, as I find it very useful. Much like the OP, I have the need to extract the vertices of a polyline inside of a block reference (INSERT), but would like to do so using the nentselp function as to eliminate the need for user input.  As I am new to AutoLISP programming attempting to accomplish this, I am not sure how to modify the above code to work with nentselp's returned 4x4 transformation matrix.

The below code is the beginning of what I'm working with.

(setq ss (ssget "X" '((8 . "Plate_Outline"))))
	
(repeat (sslength ss)

	(setq ent (vlax-ename->vla-object (ssname ss 0)))
	
	(cond 
		((= (vlax-get-property ent 'EntityName) "AcDbBlockReference")
		
			;need to obtain vertices of a polylines inside of a block here

		)
		
		((= (vlax-get-property ent 'EntityName) "AcDbPolyline") 
		
			(setq coordlist (vlax-safearray->list  (variant-value (vlax-get-property ent 'coordinates))))
			
			(setq n 0)
			
			(repeat (/ (length coordlist) 2 )
			
				(setq x (rtos (nth n coordlist) 2 2))

				(setq n (+ n 1))

				(setq y (rtos (nth n coordlist) 2 2))

				(setq n (+ n 1))

				(setq pointlist (cons (strcat x "," y ";") pointlist))
				
			)

			(print (apply 'strcat pointlist))
			
			(setq pointlist '())
			
			(princ "\n")
		)

	)
	(ssdel (ssname ss 0) ss)
)

Thank you for any feedback!

- Charl

[Kent1Cooper]

You don't need to worry about the "matrix" aspect of (nentselp) -- you can use (car (nentselp YourPoint)) to get an entity name, just as with (entsel), from which you can extract information.  But if you want to "eliminate the need for user input," (nentselp) does want a point to pick at.  Do the Polylines in the Blocks have some reliable relationship to the insertion point [preferably passing through it ] that could be used to come up with a point that is guaranteed to "hit" the Polyline?  Then there's the complication that the nested Polyline's vertex location information is going to be in relation to the Block's insertion point, not in relation to the surrounding drawing, so there will be conversion to be done.  Are these Blocks ever inserted at scale factors other than 1?  That would greatly complicate things....

[Ranjit_Singh]

Try below code

;;;written by Ranjit Singh
;;;@ https://forums.autodesk.com/t5/forums/replypage/board-id/130/message-id/352525
;;;04/21/17
(defun c:blvert ( / ang ent etdata inpt xfac yfac)
(mapcar '(lambda (x)
(setq ent (cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 (setq etdata (entget x))))))) inpt (cdr (assoc 10 etdata)) ang (cdr (assoc 50 etdata)) xfac (cdr (assoc 41 etdata)) yfac (cdr (assoc 42 etdata)))
(while ent
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
(print (mapcar '(lambda (x) (mapcar '+ inpt (polar '(0 0) (+ ang (angle '(0 0) (mapcar '* (list xfac yfac) x))) (distance '(0 0) (mapcar '* (list xfac yfac) x))))) (vl-remove nil (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) (entget ent))))))
(setq ent (entnext ent)))
(princ "\n========"))
(mapcar 'cadr (ssnamex (ssget "_x" '((0 . "INSERT") (8 . "Plate_Outline"))))))
(princ))

[Anonymous]

Thank you Kent and Ranjit for the quick responses. I am grateful for the support you both provide and am constantly using your posts as references as I begin my career with this application.

This solution is brilliant and works perfectly for my needs. And although it provided a "quick-fix" to my problem - which is exactly what I was looking for - I don't fully understand its every line and so it reminded me just how much I have yet to learn. Particularly, about the mapcar + lambda functions. I am currently reading Lee Ambrosius's AutoCAD Platform Customization (AutoLISP) book and understand the power of these functions but have had little actual experience with them... 

I look forward to dissecting this one as to truly understand its brilliance!

Keep up the great work.

Regards!