Combination selection logic

alique.langlois · ‎10-13-2019

Hello all,

A while back I had some good help to program a lisp from some awesome people on the form (@ВeekeeCZ & @dlanorh) and since then I have been learning a little a bit. I am now back with some help to figure out a logic problem; at least I think it is.

What I need to do now is prompt the user to select one of three block names (IS0X, COMBINER, SUB_BUS). The combinations can be the following: IS0X and IS0X, IS0X and SUB_BUS, COMBINER and IS0X, COMBINER and COMBINER.

The original code looks at two blocks of pre-determined names, pulls the attribute information and prompts the user to make a polyline to determine the length between the two-insertion point, and last, all the info collected is placed into a block. I am still doing this but the above combinations have become common and I would do them by hand when the lisp could not do it, due to the logic issue.

This is the hard part I have to think like a kid and make sure the user can't select the block in the same location (the blocks that share the same name will be a distance apart).

I will post the blocks for the fun if someone wants to play with them.

This is the code I have thus far and it's not working but I want to try to do as much as u can on my own. As I am trying to learn and not just asking for someone to code for me.

I am pretty sure I would have to make the changes to the :blockselect sub and code below it but i am still a little green on how to approach this.

;---------------------------------------------------------------------------------
;                           Block selection function                                 
;---------------------------------------------------------------------------------
; Block selection  -  BeekeeCZ
; Prompts user to select a block
; If block doesnt match block names that are accepted will return wrong block 
; If block matchs 
;---------------------------------------------------------------------------------
  (defun :blockselect (flt / done out ens ben)
								; flt - the block names put in
								; done - 
    (while (not done)
      (and (setvar 'errno 0) 			; needs to be reset
	   (setq ens (entsel (strcat "\nPick block " flt " at side to connect: ")))
	   (setq ben (car ens))
	   (cond ((= 52 (getvar 'errno))  	; Right click to exit
		  (setq done T))
		 ((= 7 (getvar 'errno))         ;  missed block 
		  (princ "\nError: Missed, try again."))
		 ((/= "INSERT" (cdr (assoc 0 (entget ben))))   ; not a block 
		  (princ "\nError: Wrong selection, BLOCK is required."))
		 ((not (wcmatch 
						(setq bln (strcase (:getBlockName ben)))
				flt)) ; picked a random block
		  (princ "\nError: Wrong block, a vaild BLOCK is required."))
		 (T
		  (princ (strcat "\nBlock selected: " bln))
		  (foreach itm (LM:getattributeswithvalues ben) (princ (strcat ", " (car itm) ": " (cdr itm))))
		  (setq done T
			out (list bln ben (osnap (cadr ens) "_mid")))))))
    out)
;---------------------------------------------------------------------------------
; this is the part of code that is confirming my combination
(and (setq blk (:blockselect "COMBINER,IS0X,SUB_BUS"))
; select the second point in reff to first
		(cond ((= (car blk) "IS0X")
				(setq bl1 (if (= (car blk) "IS0X")
						blk
						(:blockselect "IS0X")))
				(setq bl2 (if (= (car blk) "IS0X")
						 blk
						 (:blockselect "IS0X")))

				; get name and destination info
				(setq a11 (LM:getattributevalue (cadr bl1) "T_NUM"))
				(setq a12 (LM:getattributevalue (cadr bl1) "COMBINER"))
				(setq a21 (LM:getattributevalue (cadr bl2) "C_NUM"))
				)
				((= (car blk) "COMBINER")
				(setq bl1 (if (= (car blk) "COMBINER")
						 blk
						 (:blockselect "COMBINER")))
				(setq bl2 (if (= (car blk) "IS0X")
						 blk
						 (:blockselect "IS0X")))


; so forth.

alique.langlois · ‎10-13-2019

So I might have figured out part of my problem.

In my selection sub-routine, I will need to add a new data point on the output. I will need the insertion point of the block. I am bugging at the part of code to bet this information. I am sure its a syntax error.

(assoc 10 (entget "Block entity variable label"))

from there I will be using some conditional statements to get the results I want.

Sea-Haven · ‎10-13-2019

Its a bit longer code needed to get to the assoc / dxf code values note the entget is normaly (10 . X Y Z) so must use cdr to get the values past the .

(setq pt (cdr (assoc 10 (entget (car (entsel "pick block"))))))

(setq obj (vlax-ename->vla-object (car (entsel "pick object"))))

(setq pt (vlax-get Obj 'insertionPoint))

alique.langlois · ‎10-13-2019

@Sea-Haven Thank you I was missing a cdr in the code to get the result I wanted.

I have hit another point of confusion. This should be easy for most but I am sure it is just me overthinking it.

cond ((= (car blk) "IS0X")
				(setq bl1 (if (= (car blk) "IS0X")  ; not sure i am understand the logic right here
						blk
						(:blockselect "IS0X")))
				(setq bl2 (if (= (car blk) "COMBINER")
						 blk
						 (:blockselect "COMBINER")))

If I am understanding the logic at my comment: if blk = IS0X then set bl1 to blK and request the next blk (blockselect sub)?

Or

if blk = IS0X then set bl1 to blK, if not request the next blk (blockselect sub)?

just a little unsure of the syntax I guess.

Sea-Haven · ‎10-13-2019

I think your going about this the wrong way using ssget would be better this will make a selection set of the blocks you want.

(setq ss (ssget (list (cons 0 "Insert)(cons 2 "ISOX,COMBINER,SUB_BUS"))))

alique.langlois · ‎10-13-2019

Not sure I am following. Although there is information on the program you might be missing. The lisp in its entirety is intended to help the user (me) to make a polyline between two-block. Route of the said polyline is inputted by the user till I get from one block to the other. Once done, the lisp insert's another block and fills in data extracted from the two original blocks along with the length of the polyline.

I am working off a base code that I had made a while back that I know works.

I am open to learning new ways of coding if you don't mind sharing your way you would approach this? Your code does so in pseudo-code formate as this would allow me to try and understand the philosophy.

Sea-Haven · ‎10-13-2019

Need a dwg or image showing process hard to understand what your doing.

alique.langlois · ‎10-13-2019

So here is the link to the orignal program.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/polyline-length-with-fancy-block-inp...

I uploaded the lisp that came from it.

hope that explains better.

Sea-Haven · ‎10-13-2019

So its pick a block, pick a block, draw a pline, then label the new pline.

(the blocks that share the same name will be a distance apart).

Why not just make a selection set of one block name go through zoom to each one at a reasonable scale, pick second block if its name matches then do pline and add label. Do I have it right ?

In the test dwg the lengths are not correct ?

ВeekeeCZ · ‎10-14-2019

I've made an upgrade to my previous code... changes are bolded.

(defun c:BConnection (/ *error* LM:getattributevalue LM:setattributevalue col lay atd atr a11 a12 be2 bn2 a21 pen blk bl1 bl2 pnt)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if col (setvar 'cecolor col))
    (if lay (setvar 'clayer lay))
    (if atd (setvar 'attdia atd))
    (if atr (setvar 'attreq atr))
    (if eco (setvar 'cmdecho eco))
    (princ))
  
  
  ;; http://www.lee-mac.com/attributefunctions.html#vlgetattributevalue
  
  ;; Get Attribute Value  -  Lee Mac
  ;; Returns the value held by the specified tag within the supplied block, if present.
  ;; blk - [ent] Block (Insert) Entity Name
  ;; tag - [str] Attribute TagString
  ;; Returns: [str] Attribute value, else nil if tag is not found.
  
  (defun LM:getattributevalue ( blk tag / val enx )
    (while (and (null val)
		(setq blk (entnext blk))
		(= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
		)
      (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
	(setq val (cdr (assoc 1 (reverse enx)))))))
  
  ;; Set Attribute Value  -  Lee Mac
  ;; Sets the value of the first attribute with the given tag found within the block, if present.
  ;; blk - [ent] Block (Insert) Entity Name
  ;; tag - [str] Attribute TagString
  ;; val - [str] Attribute Value
  ;; Returns: [str] Attribute value if successful, else nil.
  
  (defun LM:setattributevalue ( blk tag val / end enx )
    (while (and (null end)
		(setq blk (entnext blk))
		(= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
		)
      (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
	(if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
	  (progn
	    (entupd blk)
	    (setq end val))))))
  
  
  ;; Get All Attributes with Values  -  Based on Lee's routine, by Beekee
  ;; Returns the value held by the specified tag within the supplied block, if present.
  ;; blk - [ent] Block (Insert) Entity Name
  ;; Returns: [lst] List of pairs (att . val), else nil if no att is found.
  
  (defun LM:getattributeswithvalues ( blk / enx lst)
    (while (and (null val)
		(setq blk (entnext blk))
		(= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
		)
      (setq lst (cons (cons (cdr (assoc 2 enx))
			    (cdr (assoc 1 (reverse enx))))
		      lst)))
    lst)
  
  
  (defun :blockselect (flt / done out ens ben)
    (while (not done)
      (and (setvar 'errno 0) 			; needs to be reset
	   (setq ens (entsel (strcat "\nPick block " flt " at side to connect: ")))
	   (setq ben (car ens))
	   (cond ((= 52 (getvar 'errno))  	; RT click to exit
		  (setq done T))
		 ((= 7 (getvar 'errno))
		  (princ "\nError: Missed, try again."))
		 ((/= "INSERT" (cdr (assoc 0 (entget ben))))
		  (princ "\nError: Wrong selection, BLOCK is required."))
		 ((not (wcmatch (setq bln (strcase (cdr (assoc 2 (entget ben))))) flt))
		  (princ (strcat "\nError: Wrong block '" (cdr (assoc 2 (entget ben))) "', need " flt ".")))
		 (T
		  (princ (strcat "\nBlock selected: " bln))
		  (foreach itm (LM:getattributeswithvalues ben) (princ (strcat ", " (car itm) ": " (cdr itm))))
		  (setq done T
			out (list bln ben (osnap (cadr ens) "_mid")))))))
    out)
    
    
    
    ; -------------------------------------------------------------------------------------------------
    ; -------------------------------------------------------------------------------------------------
    
    
    (setq col (getvar 'cecolor)) 					; save current values of sysvars to reset them in the end
    (setq lay (getvar 'clayer))
    (setq atd (getvar 'attdia))
    (setq atr (getvar 'attreq))
    (setq eco (getvar 'cmdecho))
    
    
    (and (setq bl1 (:blockselect "IS0X,COMBINER"))
	 (setq bl2 (:blockselect (if (= (car bl1) "IS0X")
				   "IS0X,SUB_BUS"
				   "IS0X,COMBINER")))
	 (or (not (equal (assoc 10 (entget (cadr bl1))) (assoc 10 (entget (cadr bl2))) 1e-3))
	     (prompt "\nError: Wrong selection, blocks cannot be in the same location."))
	 (setq a11 (cond ((LM:getattributevalue (cadr bl1) "T_NUM"))
			 ("Undefined"))) ; to prevent nil input if not defined.
	 (setq a12 (cond ((LM:getattributevalue (cadr bl1) "COMBINER"))
			 ("Undefined")))
	 (setq a21 (cond ((LM:getattributevalue (cadr bl2) "C_NUM"))
			 ("Undefined")))
	 (setvar 'cecolor "1")
	 (setvar 'cmdecho 0)
	 (vl-cmdf "_PLINE" "_non" (setq pnt (last bl1)))
	 (progn
	   (while (setq pnt (getpoint "\nNext point: " pnt))
	     (command "_non" pnt))
	   (command "_non" (last bl2) "")
	   T)
	 (setq pen (entlast))
	 (vl-cmdf "_.CHPROP" pen "" "_Color" 3 "")
	 (vl-cmdf "_.LAYER" "_Thaw" "HIDDEN" "_Make" "HIDDEN" "")
	 (setvar 'attdia 0)
	 (setvar 'attreq 0)
	 (princ "\nPlace the block: ")
	 (vl-cmdf "_.INSERT" "TAG" "_Scale" 1 "_Rotate" 0 PAUSE)
	 (setq bl3 (entlast))
	 (progn
	   (LM:setattributevalue bl3 "CBL_NAME" (strcat a11 " - " a21))
	   (LM:setattributevalue bl3 "COMBINER" a12)
	   (LM:setattributevalue bl3 "P_LENGTH" (rtos (* (getpropertyvalue pen "Length") 1.1)  2 3))
	   ))
    (*error* "end") ; reset all sysvars...
    )

alique.langlois · ‎10-14-2019

@Sea-Haven I think I understand. I will try your way from scratch later today as it would interesting to better understand selection sets and I think a little shorter on the code side. Thank you for your pointers!

@ВeekeeCZ Thank you for the change in code. It was a lot shorter than where I was going. I had some while loops going with several conditions statements using the point of insertion. Needless to say, I was getting up there in lines.

I am going to integrate the code and add in the other stuff I knew I could program in and post it for the community.

Thank you both once again. I am still rough on the lisp as its not my first program language but I am slowly understanding it. Hopefully, I will be paying it forward one day.

alique.langlois · ‎10-15-2019

@ВeekeeCZ

Just a quick question. I am trying to understand this part of the code and It might be a point where the code is crashing on my end.

(or (not (equal (assoc 10 (entget (cadr bl1))) (assoc 10 (entget (cadr bl2))) 1e-3))
	     (prompt "\nError: Wrong selection, blocks cannot be in the same location."))

would this be better in a while loop like below?

(while (not same)
	 (setq bl2 (:blockselect (if (= (car bl1) "IS0X")
				   "IS0X,SUB_BUS"
				   "IS0X,COMBINER")))
	 (not (equal (assoc 10 (entget (cadr bl1))) (assoc 10 (entget (cadr bl2))) (setq same T))
	     (prompt "\nError: Wrong selection, blocks cannot be in the same location.")
	)

Or am I not getting the right understanding.

ВeekeeCZ · ‎10-16-2019

Be easy on yourself. I wouldn't complicate things unless it's necessary.

This is a common approach that if the user makes a stupid error on input and won't lose too much, the routine simply ends with an error message (in better case) - and I wouldn't consider this as 'crash' because this case was considered are it works as designed.

Just consider

- How often could this mistake happen?

- What will lose if he makes this mistake..

Anyway, your implementation wouldn't work. Placing (setq same T) instead of precision makes no sense.

Maybe like this...

(while (not not-the-same) ; not-the-same has to be localized!!!
  (setq bl2 (:blockselect (if (= (car bl1) "IS0X")
			    "IS0X,SUB_BUS"
			    "IS0X,COMBINER")))
  (if (equal (assoc 10 (entget (cadr bl1))) (assoc 10 (entget (cadr bl2))) 1e-3)
    (prompt "\nError: Wrong selection, blocks cannot be in the same location, try again.")
    (setq not-the-same T)))

Community

Combination selection logic

Combination selection logic

Combination selection logic