Get attribute value and test for specific value

Get attribute value and test for specific value

Anonymous
Not applicable
3,022 Views
23 Replies
Message 1 of 24

Get attribute value and test for specific value

Anonymous
Not applicable

I would like to put all blocks collected into groups or arrays or lists... lisp is weird... by and attribute value... pole_id then I need to draw a polyline according to the "drop_order".  Please help me.

 

Here is the code I have so far which draws by "drop_order" all the blocks selected but I need it to sort them by the "pole_id" first then draw polylines for each group separately.

 

This code is taken from snippets from a Lee Mac answer a long time back.

 

(defun C:PP-CARDBIP ; = CONNECT BLOCKS BY INSERTION POINTS - ORIGINALLY LBS
  (/ *error* ent fmt idx ins ocs par sel spc txt typ uxa ss blk att blkinslist)
  ;(prompt "\nTo Link Blocks with Lines in Attribute Sequence,")(if (setq ss (ssget '((0 . "INSERT") (66 . 1) (2 . "ACMAP_ANN_TEMPLATE_PERMIT-FEATURES") ))); could omit (66 . 1)*
  (prompt "\nTo Link Blocks with Lines in Attribute Sequence,")
  (if (setq ss (ssget '((0 . "INSERT") (66 . 1) (2 . "ar_drop_point") ))); could omit (66 . 1)*
    (progn ; then
      (repeat (setq n (sslength ss)); step through selection set
        (setq
          blk (ssname ss (setq n (1- n))); Block entity name
          att (entnext blk); Attribute entity name
          blkinslist ; list of integer equivalents of Attribute values paired with insertion points
             (cons
              (list 
				;(atoi 
					;(princ(LM:getattributevalue att "COMMENT_1"))
					(princ(LM:getattributevalue att "drop_order"))
					;(cdr 
					;	(assoc 1 (entget att)
					;	); assoc
					;); cdr
				;); atoi - turns string into integer
				
				; gets the insertion point here
				(trans 
					(cdr 
						(assoc 10 
							(entget blk)
						); assoc
					); cdr
					0 1
				); trans
				; finish getting the insertion points
			  ); list
              blkinslist
            ); cons
        ); setq
      ); repeat
      (setq blkinslist ; replace former content
        (mapcar 'cadr ; keep only insertion points after:
          (vl-sort blkinslist '(lambda (a b) (< (car a) (car b)))); sorting in Attribute-value order
        ); mapcar
      ); setq	  
	  	  	  
	  (command "-COLOR" 6) 
	  (command "")
      (command "_.pline"); consider Polyline instead, possibly with specified width
      (apply 'command blkinslist); feed points to Line command
      (command ""); end Line command 		
	  
	  
	  ;(LM:inputfootage); call text input - might work on this later but have seperated the two
	  
    (princ)
    ); progn
	(prompt "\nNo PERMIT-FEATURE Blocks selected."); else
  ); if  ACMAP_ANN_TEMPLATE_PERMIT-FEATURES
); defun

 

0 Likes
Accepted solutions (1)
3,023 Views
23 Replies
Replies (23)
Message 2 of 24

Moshe-A
Mentor
Mentor

@Anonymous  hi,

 

without your "ar_drop_point" block i can not test this code.

 

try to change "drop_order" with "pole_id" on next code line and see if it work

(princ(LM:getattributevalue att "drop_order"))

 

note that (LM:getattributevalue) function is missing here

 

Moshe

 

Message 3 of 24

Anonymous
Not applicable

That did not work...   Here is a drawing with the block in it.

0 Likes
Message 4 of 24

Moshe-A
Mentor
Mentor

@Anonymous ,

 

if you want to sort them by "pole_id" then why "pole_id" has empty value?

 

 

0 Likes
Message 5 of 24

Anonymous
Not applicable

I meant "id" not pole_id

0 Likes
Message 6 of 24

Anonymous
Not applicable

What I need to do is have all the blocks selected and grouped by the id which corresponds to a drop coordinate group from field software, then I need them sorted by their drop_order so a polyline can be drawn for each group separately. 

 

The end goal is to be able to select every drop_point regardless of what drop it belongs to and have a polyline drawn for each drop without having to select each drops point group 1 at a time before running the command.

 

Currently, if I select each drop group by themselves it works as needed... It would be more time-efficient if I could select every ar_drop_point block in a drawing and run the command once to draw all drops.  I may end up having 50+ drops in a drawing.

0 Likes
Message 7 of 24

Moshe-A
Mentor
Mentor

@Anonymous ,

 

i see there are 7 ar_drop_point blocks, only 1 has attribute id=2 all other attribute id=3.

Are sure you want to sort them by id? it would be a miracle if you get want you want.

 

and frankly i do not understand at all want is you goal so prepare a dwg with a state before running the the lisp and the state after.

 

your lisp was not running at all so i fix it and make sort by id (which i still not sure if that what you want)

 

Moshe

 

 

 

 

0 Likes
Message 8 of 24

Anonymous
Not applicable

I'll do ya one better... here is a screencast link describing what I need it to do and what it does now.

 

Thanks for the help!

 

https://www.youtube.com/watch?v=_iBPN-797bQ

0 Likes
Message 9 of 24

Sea-Haven
Mentor
Mentor

So you want Id drop order X Y where xy is insert point. So the ids 3 join together, the 2 join together.

 

In survey/roads this is known stringing common codes. You could possibly throw a file at CIV3D and it would do all of it for you insert blocks and make line work. X Y 301 .... X Y 304.

 

3 1 X Y

3 2 X Y

3 3 X Y

3 4 X Y

2 5 X Y

2 6 X Y

 

Need a bit of time.

0 Likes
Message 10 of 24

Sea-Haven
Mentor
Mentor

This is much simpler and groups by block name but is doing I think what you want.

 

The remake list into sub list ie group them by Id number then the join is easy, this is similar method but rather than qty want sub lists. Some thing I am not real good at I use a crude method to do it sure others are better like  https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-sorting-strings/td-p/9848596

 

 

 

 

(princ "\nSelect block for name")
(setq ss (ssget "_+.:E:S" (list (cons 0 "Insert"))))
(setq bname (cdr (assoc 2 (entget (ssname ss 0)))))
(setq ss (ssget (list (cons 0 "Insert")(cons 2 bname))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq blk (ssname SS (setq x (- x 1) )))
(setq ins (vlax-get (vlax-ename->vla-object blk) 'insertionpoint))
(setq att (vlax-invoke (vlax-ename->vla-object  blk)'getattributes))
(setq lst (cons (list (vla-get-textstring (nth 1 att))(vla-get-textstring (nth 2 att)) ins ) lst))
)
(setq lst (vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b)) (< (cadr a) (cadr b)))
	    )
	  )
)
)
; get sub lists
;do plines next

 

 

 

 

List produced

(("2" "0" (1.11561e+07 6.3642e+06 0.0)) ("2" "1" (1.11561e+07 6.36415e+06 0.0)) ("3" "0" (1.11561e+07 6.3642e+06 0.0)) ("3" "1" (1.11561e+07 6.36425e+06 0.0)) ("3" "2" (1.11561e+07 6.36429e+06 0.0)) ("3" "3" (1.11561e+07 6.36431e+06 0.0)) ("3" "4" (1.11561e+07 6.36432e+06 0.0)) ("3" "5" (1.11561e+07 6.36433e+06 0.0)))

desired

((("2" "0" (1.11561e+07 6.3642e+06 0.0)) ("2" "1" (1.11561e+07 6.36415e+06 0.0)))

(("3" "0" (1.11561e+07 6.3642e+06 0.0)) ("3" "1" (1.11561e+07 6.36425e+06 0.0)) ("3" "2" (1.11561e+07 6.36429e+06 0.0)) ("3" "3" (1.11561e+07 6.36431e+06 0.0)) ("3" "4" (1.11561e+07 6.36432e+06 0.0)) ("3" "5" (1.11561e+07 .36433e+060.0))))

 

This alllows check for sub list is 1 only so no pline, and as sub list easy to do pline points as (nth (nth 

 

0 Likes
Message 11 of 24

Sea-Haven
Mentor
Mentor

Re thought the desired . This is the connecting pts in correct order.

 

 

 

(
((1.11561e+07 6.3642e+06 0.0)(1.11561e+07 6.36415e+06 0.0)(1.11561e+07 6.3642e+06 0.0))
((1.11561e+07 6.36425e+06 0.0)(1.11561e+07 6.36429e+06 0.0) (1.11561e+07 6.36431e+06 0.0)(1.11561e+07 6.36432e+06 0.0)(1.11561e+07 .36433e+060.0))
)

 

 

  I have been using a simple compare Nth x with Nth x +1 create a lst2 then cons that to list3 as shown above. But would prefer to use a lambda style function which would be more efficient hence asking for help, the pline bit is done.

0 Likes
Message 12 of 24

pbejse
Mentor
Mentor

Try with  replacing this

(setq blkinslist		
	(mapcar	'cadr			
		(vl-sort blkinslist '(lambda (a b) (< (car a) (car b))))
				
	)			
 )

To

(setq blkinslist		
       (mapcar 'caddr
	       (vl-sort	blkinslist
			'(lambda (a b)
			   (cond
			     ((< (cadr a) (cadr b)))
			     ((= (cadr a) (cadr b)) (< (car a) (car b)))
			   ) 
			 ) 
	       ) 
       )
)

 

0 Likes
Message 13 of 24

Sea-Haven
Mentor
Mentor
Accepted solution

Please try this, pick a pole block for name then select all poles. I have not set a layer etc if happy can add.

 

; join poles by AlanH Nov 2020

(defun c:joinpoles (/ ss lst lst2 lst3 x y ans ans2 poles)
  (princ "\nSelect block for name")
  (setq ss (ssget "_+.:E:S" (list (cons 0 "Insert"))))
  (setq bname (cdr (assoc 2 (entget (ssname ss 0)))))
  (setq ss (ssget (list (cons 0 "Insert") (cons 2 bname))))
  (setq lst '())
  (repeat (setq x (sslength ss))
    (setq blk (ssname SS (setq x (- x 1))))
    (setq ins (vlax-get (vlax-ename->vla-object blk) 'insertionpoint))
    (setq att (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
    (setq lst (cons (list (vla-get-textstring (nth 2 att)) (vla-get-textstring (nth 1 att)) ins) lst))
  )
  (setq lst (vl-sort lst
                     '(lambda (a b)
                        (cond
                          ((< (car a) (car b)))
                          ((= (car a) (car b)) (< (cadr a) (cadr b)))
                        )
                      )
            )
  )
  (setq x 0 lst3 '() lst2 '())
  (setq ans (car (nth x lst)))
  (setq lst2 (list (caddr (nth x lst))))
  (repeat (- (length lst) 1)
    (setq ans2 (car (nth (setq x (+ x 1)) lst)))
    (if (= ans ans2)
      (progn
        (setq lst2 (cons (caddr (nth x lst)) lst2))
        (setq ans ans2)
      )
      (progn
        (setq lst3 (cons lst2 lst3))
        (setq lst2 '())
        (setq lst2 (cons (caddr (nth x lst)) lst2))
        (setq ans ans2)
      )
    )
  )
  (setq lst3 (cons lst2 lst3))
  (foreach poles lst3
    (command "_pline")
    (while (= (getvar "cmdactive") 1)
      (repeat (setq x (length poles))
        (command (nth (setq x (- x 1)) poles))
      )
      (command "")
    )
  )
  (princ)
)
(c:joinpoles)

 I have not se 

0 Likes
Message 14 of 24

Anonymous
Not applicable

Bros you are all awesome as well.  Thank you for input... will be trying these out and see what happens.

0 Likes
Message 15 of 24

Anonymous
Not applicable

does not work

0 Likes
Message 16 of 24

Anonymous
Not applicable

i'ma try this but I was looking to just join the drops.

0 Likes
Message 17 of 24

Anonymous
Not applicable

That is excellent.  Thank you!

0 Likes
Message 18 of 24

Anonymous
Not applicable

Hey I forgot all about how the pole_id needs to interact!... I need to be able to globally call this and all aerial drops be drawn.

 

 

Each needs to be drawn via pole_id then id............ meaning they should all be grouped by POLE_ID, then be grouped by ID, then finally the pline drawn via drop order.

0 Likes
Message 19 of 24

pbejse
Mentor
Mentor

@Anonymous wrote:

does not work


Why thank you for that, that's good to know.

 

 

 

0 Likes
Message 20 of 24

pbejse
Mentor
Mentor

@Anonymous wrote:

...meaning they should all

be grouped by POLE_ID, then

be grouped by ID, then finally the pline drawn

via drop order.


(defun c:ConnecTheBlocksUsingThisLispCode
       ( / OK  Listen maybe you just do_not know how_to put_this together)
;;;		pBe Nov 2020			;;;
  (setq OK (lambda ( n l) (cadr (assoc n l))))
(defun Listen ( j n m o p l)
  	(Vl-sort l '(lambda (o p)
		(cond
		     ((< (ok n o)(ok n p)))
		     ((= (ok n o)(ok n p))
		      		(< (ok m o) (ok m p)))
		     ((= (ok m o)(ok m p))
		      		(< (ok j o) (ok j p)))
		   )
		)
	)	 
  )
  
(defun maybe (lst)
  (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
			  (cons 62 6)(cons 6 "ACAD_ISO02W100")
                          (cons 90 (length lst)))
                    (mapcar (function (lambda (p) (cons 10 p))) lst))))
  
  (if (setq You (ssget '((0 . "INSERT") (66 . 1) (2 . "AR_DROP_POINT") )))
    (progn
      (repeat (Setq just (sslength You))
	(setq do_not (vlax-ename->vla-object (ssname You (setq just (1- just)))))
	(setq know (mapcar '(lambda (at)
			       (list (vla-get-tagstring at)(vla-get-textstring at)))
	       (vlax-invoke do_not 'GetAttributes)))
	(setq how_to (vlax-get do_not 'InsertionPoint))
	(setq put_this (cons (append know (list (trans how_to 0 1)))
			put_this)))
      	(setq together (listen "POLE_ID" "ID" "DROP_ORDER"a b put_this))
      	(maybe (mapcar 'last together))
      )
    )(princ)
  )

- Thats all i have to say about -

0 Likes