polyline length with fancy block inputs

[alique.langlois]

Hello all,

So I am very new to ALisp, but have a fair handle on programming. My goal is to learn so I would like a little explanation on this request. I am also trying to as much as I can on my own and have built a framework for what I need to do, but if I am going about this the wrong way. Please point me in the right direction, but as I am pressed for time. I am open to someone just writing something up and I reverse engineer it. 

I have two blocks that have attributes (1st block = Name and destination, 2nd block = Name) these blocks will need to have a Pline draw between them by a user. When the polyline is complete the user will have a block that is inserted with the following data on a layer that will be hidden: the name attribute value of the two blocks together separated by a dash, the destination value, and the length of the polyline with an additional 10%.

I am going to plan out my code this way more or less:

select the start point block

if TABLE get name and destination, if not get the name

start polyline with red colour (hopefully, the user will have it start near or on the block perimeter) 
pick route for polyline (user input to the destination block)
hit enter (user input)
select the destination point block
if TABLE get name and destination, if not get the name
get the length of polyline and add the 10% (in future I will ask for hight between table and trench depth)
insert block on a hidden layer, if the layer doesn't exist make it

insert data to Tag block
change polyline colour to green

Voila!

I have put an example of the three blocks I want to do this with. I filed the attributes by hand in the TAG block to show the result. The file was done in acad2019. I can export it to an older version if needed

Thank you for any help!

[ВeekeeCZ]

It's not probably exactly by your description... not really clear to me... and various values of different XYWZ combinations din't help.

Anyway, guess this is something for you to start... and possibly easy-enough to by adjusted by yourself.

Also kinda resigned for any input testing at this point. (is the selected object really a block? is the block that shout be inserted in the drawing... this kind of stuff)

(defun c:BConnection (/ *error* LM:getattributevalue LM:setattributevalue col lay atd atr be1 bn1 a11 a12 be2 bn2 a21 pen )
  
  (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))
    (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))))))
  





  
  ; -------------------------------------------------------------------------------------------------
  ; -------------------------------------------------------------------------------------------------
  
  
  (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))
  
  (setq be1 (car (entsel "\nSelect start point block: "))) 	; block ename
  (setq bn1 (cdr (assoc 2 (entget be1)))) 			; block name
  (setq a11 (LM:getattributevalue be1 "T_NUM"))			; att val 1
  (setq a12 (LM:getattributevalue be1 "COMBINER"))
  (princ (strcat " ...'" bn1 "' block selected. T_num: '" (if (/= a11 "") a11 "UNKNOWN") "', Combiner: '" (if (/= a12 "") a12 "UNKNOWN")  "'\n"))
  (if (= a11 "")
    (progn
      (setq a11 (getstring "\nT_NUM: "))
      (LM:setattributevalue en3 "T_NUM" a11)))
  
  (setvar 'cecolor "1")
  (command-s "_PLINE")
  (setq pen (entlast))
  
  (setq be2 (car (entsel "\nSelect end point block: ")))
  (setq bn2 (cdr (assoc 2 (entget be2))))
  (setq a21 (LM:getattributevalue be2 "C_NUM"))
  (princ (strcat " ...'" bn2 "' block selected. C_num: '" (if a21 a21 "UNKNOWN") "'"))

  (setvar 'cmdecho 0)
  (command "_.CHPROP" pen "" "_Color" 3 "")
  
  (command "_.LAYER" "_Thaw" "HIDDEN" "_Make" "HIDDEN" "")

  (setvar 'attdia 0)
  (setvar 'attreq 0)
  (princ "\nPlace the block: ")
  (command "_.INSERT" "TAG" "_Scale" 1 "_Rotate" 0 PAUSE)
  (setq en3 (entlast))
  (LM:setattributevalue en3 "CBL_NAME" (strcat a11 " - " a21))
  (LM:setattributevalue en3 "COMBINER" a12)
  (LM:setattributevalue en3 "P_LENGTH" (rtos (* (getpropertyvalue pen "Length") 1.1)  2 3))
  
  (*error* "end") ; reset all sysvars...
  )

[dlanorh]

I can't open your drawing as I only have AutoCAD 2012, so can't be more specific to your needs, but the following may give you some pointers. I use visual lisp alot (autolisp's activeX equivalent) so the code below is skewed that way. I have documented the code as much as I can, and it contains techniques to check the drawing for missing blocks, layers etc as well as filter entity selection alluded to be @ВeekeeCZ  above. You should be able to run it, although it doesn't do anything apart from create a couple of layers, before exiting because a block isn't present.

(defun c:WHATEVER ( / *error* c_doc c_spc sv_lst sv_vals blk_name ss);list of local variables
;;local (private) error routine 
;;The local error routine should not include any (command) calls as this will cause the lisp to error from 2015 onward
;;If you need to use them use (command-s) or (vl-cmdf) instead. 
;;This is a security feature. since (command-s) and (vl-cmdf) evaluate the expression before execution and won't execute it if it is incorrect
;;whereas (command) executes on the fly and potentially allows rogue code.to execute

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals) ;;Reset system variables to entry state if error
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) ;;if undo mark left open then close it
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")));;If the error wasn't initiated by user or routine display error message
    (princ) ;;exit cleanly
  );end_*error*_defun
  
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object));; Assign variable to current open drawing. (vlax-get-acad-object) is the AUTOCAD Application
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace));; gets the current space 
        sv_lst (list 'osmode 'cmdecho 'textstyle) ;;list of system variables to save (to be reset to entry state on leaving)
        sv_vals (mapcar 'getvar sv_lst);; get the values of the system variables in sv_lst
        blk_name "Te&st"
  );end_setq

  ;; assign new values to system variables (notice that this list is shorter so it will only assign values to the first two variables in the list)
  ;; this makes use of a feature of mapcar function that stops when one list is empty
  (mapcar 'setvar sv_lst '(0 0))

  ;;check if a layer is present in the drawing. If not create it
  (cond ( (null (tblsearch "LAYER" "Turning Point")) (vlax-put (vla-add (vla-get-layers c_doc) "Turning Point") 'color 1)))
  (cond ( (null (tblsearch "LAYER" "TP-Blocks")) (vlax-put (vla-add (vla-get-layers c_doc) "TP-Blocks") 'color 7)))

  ;;check if a textstyle is present in the drawing. If not assign another textstyle as current
  ;;This sets the system variable textstyle missing above
  (cond ( (null (tblsearch "STYLE" "ARIAL")) ;;if textstyle arial not present
          (if (/= (getvar 'textstyle) "STANDARD")(setvar 'textstyle "STANDARD"));;if "standard" not the current textstyle set it as current. 
        )
        (t (if (/= (getvar 'textstyle) "ARIAL")(setvar 'textstyle "ARIAL")));;if "arial" is present but not current set it as current. 
  );end_cond
  
  ;;check if a block is present in the drawing. If not alert and exit lisp.
  (cond ( (null (tblsearch "BLOCK" blk_name)) (alert (strcat "Block " blk_name " NOT found in drawing")) (exit)));;blk_name can be a variable containing the block name or just the block name as text 

  ;;Get an entity of a specific type (here a lwpolyline) using ssget in point mode (ssget similar to entsel)
  (prompt "\nSelect Polyline : ")
  (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))));Filter for lwpolylines only
  ;;or a block
  (prompt "\nSelect Block : ")
  (setq ss (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1))));Filter for block references with attributes only

  ;;http://www.lee-mac.com/ssget.html for excellent guide to using ssget and filters
  
  (mapcar 'setvar sv_lst sv_vals);;At end of routine to reset system variables to entry state (normal execution)
  (princ) ;;exit cleanly
);end_defun

[alique.langlois]

Thank you both! I had started playing with some code last night (East coast Canada).  What you guys have done should help point me in the right direction and have something that will work. 

Really appreciate it, I will approve your solution when I put it together with mine if that is Cool. I will also post the finalized alisp so others can use it and hack it.

[devitg]

Please Upload your LISP , as up now 

[alique.langlois]

I am still putting things together and learning the way things are working. It is very far from being ready to do anything ( I have been putting comments in, so I can understand and be able to modify it later when I better understand )

Here is what I got thus far.

[devitg]

Hi Alique , and if it is possible , upload a sample dwg , as the user has done  the task , as we often call , an "after" sample .  

[alique.langlois]

Sorry about that I should have done that from the start. 

I have made some progress since my last msg. I am writing up some conditionals so that if the user doesn't know the right order or picks a none valid block (still working on it). 

It is not tested yet so I may have errors. 

Do you need the cad in a lower format of AutoCAD? 

[ВeekeeCZ · Accepted solution]

Just playing around... how about save some steps? 

(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 "\nError: Wrong block, TABLE or COMBINER 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)
    
    
    
    ; -------------------------------------------------------------------------------------------------
    ; -------------------------------------------------------------------------------------------------
    
    
    (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 blk (:blockselect "TABLE,COMBINER"))
	 (setq bl1 (if (= (car blk) "TABLE")
		     blk
		     (:blockselect "TABLE")))
	 (setq bl2 (if (= (car blk) "COMBINER")
		     blk
		     (:blockselect "COMBINER")))
	 (setq a11 (LM:getattributevalue (cadr bl1) "T_NUM"))
	 (setq a12 (LM:getattributevalue (cadr bl1) "COMBINER"))
	 (setq a21 (LM:getattributevalue (cadr bl2) "C_NUM"))
	 (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]

That does exactly what I needed!  Thank you @ВeekeeCZ! 

Now that this is done I have time to try and figure out how it works! I may poke you here if I have questions.

@dlanorh  You had mention you used visual lisp. What are some of the benefits of learning that?  I am just getting into lisp in general so I am looking for good documentation explain the basics and good practices. 

I am going to add some more detail to the code and post it so all can use it. I am sure I was not the only one looking for something like this.

[alique.langlois]

Here is my version (same as @ВeekeeCZ) just with a few comments to better understand what is happening. 

I am attaching the blocks used and the lisp itself.

;---------------------------------------------------------------------------------
;                       Load code handler                                        
;---------------------------------------------------------------------------------

(defun c:rrr () (load "Harness_tag.lsp") (alert "Loaded!"))

;---------------------------------------------------------------------------------
;                       Error code handler                                       
;---------------------------------------------------------------------------------

(defun xx:MyError (st)
	(if (not (member st (list "Funtion cancelled" "quit / exit abort")))
		(vl-bt)
	); if
	(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)
) ; MyError


;---------------------------------------------------------------------------------
;                           dxf helper function                                 
;---------------------------------------------------------------------------------
; The dxf works on taking the entity info and sepreating it to what you need
; example (0. "INSERT") is a inserted block
; dxf (the entity #) will return the info on that doted pair.
; http://help.autodesk.com/view/OARX/2018/ENU/?guid=GUID-3610039E-27D1-4E23-B6D3-7E60B22BB5BD
;---------------------------------------------------------------------------------
(defun dxf (i l) (cdr (assoc i l )))
;---------------------------------------------------------------------------------



;---------------------------------------------------------------------------------
;                           Get Atribute Value function                                 
;---------------------------------------------------------------------------------
; 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.
; http://www.lee-mac.com/attributefunctions.html#vlgetattributevalue
;---------------------------------------------------------------------------------
(defun LM:GETATTRIBUTEVALUE ( blk tag / val enx )
	(while 
		(and (null val)
			(setq blk (entnext blk))
			(= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
		) ; and
		  (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
		(setq val (cdr (assoc 1 (reverse enx))))
			) ; if
	) ; while
) ; defun LM:getattributevalue
;---------------------------------------------------------------------------------




;---------------------------------------------------------------------------------
;                           Set Attribute Value function                                 
;---------------------------------------------------------------------------------
; 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.
; http://www.lee-mac.com/attributefunctions.html#vlsetattributevalue
;---------------------------------------------------------------------------------
  (defun LM:setattributevalue ( blk tag val / end enx )
   (while 
		(and (null end)
			(setq blk (entnext blk))
			(= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
		) ;and
		(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)))
		) ; if
	) ; while
) ; defun LM:setattributevalue
;---------------------------------------------------------------------------------




;---------------------------------------------------------------------------------
;                           Get Atribute With Values function                                 
;---------------------------------------------------------------------------------
; 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)))))
		) ; and
      (setq lst (cons 
			(cons (cdr (assoc 2 enx))
				(cdr (assoc 1 (reverse enx)))
			) 
		   lst)
		 )
	)
    lst)
 ;---------------------------------------------------------------------------------



;---------------------------------------------------------------------------------
;                           Block selection function                                 
;---------------------------------------------------------------------------------
; Block selection  -  BeekeeCZ
; The dxf works on taking the entity info and sepreating it to what you need
; example (0. "INSERT") is a inserted block
; dxf (the entity #) will return the info on that doted pair.
;---------------------------------------------------------------------------------
  (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))))   ; no a block 
		  (princ "\nError: Wrong selection, BLOCK is required."))
		 ((not (wcmatch (setq bln (strcase (cdr (assoc 2 (entget 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)
;---------------------------------------------------------------------------------





;---------------------------------------------------------------------------------
;                               Body code                                     
;---------------------------------------------------------------------------------

(defun c:HTAG (/ *error* col lay atd atr a11 a12 be2 bn2 a21 pen blk bl1 bl2 pnt)
							; col - 
							; lay - 
							; atd - 
							; atr - 
							; aXX - atribute values
							; be2 - 
							; bn2 - 
							; pen - 
							; blX - block values
							; pnt - 

	(setq *error* xx:Error)

	; Save default values
	; save current values of sysvars to reset them in the end
	(setq col (getvar 'cecolor)) 					
	(setq lay (getvar 'clayer))
	(setq atd (getvar 'attdia))
	(setq atr (getvar 'attreq))
	(setq eco (getvar 'cmdecho))
	

	
	
	; select the first point block entity
	(and (setq blk (:blockselect "TABLE,COMBINER"))
		
		; select the second point in reff to first
		(setq bl1 (if (= (car blk) "TABLE")
				 blk
				 (:blockselect "TABLE")))
		 (setq bl2 (if (= (car blk) "COMBINER")
				 blk
				 (:blockselect "COMBINER")))

		; 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"))
		
		; start polyline with red colour (hopefully, the user will have it start near or on the block perimeter) 
		(setvar 'cecolor "1")
		(setvar 'cmdecho 0)
		(vl-cmdf "_PLINE" "_non" (setq pnt (last bl1)))
		(progn  ; pick route for polyline (user input to the destination block)
			(while 
				(setq pnt (getpoint "\nNext point: " pnt))
				(command "_non" pnt)
			) ; while
			(command "_non" (last bl2) "")
		 T) ; progn
		(setq pen (entlast))     ; hit enter (user input)
		
		; insert block on a hidden layer, if the layer doesn't exist make it
		
		(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))

		; insert data to Tag block

		(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))
		) ; progn
	) ; and
    (*error* "end") ; reset all sysvars...
) ; plength

 Thank you to all that helped me. 

[dlanorh]

---

@alique.langlois wrote:

@dlanorh  You had mention you used visual lisp. What are some of the benefits of learning that?  I am just getting into lisp in general so I am looking for good documentation explain the basics and good practices. 

---

An excellent site for Autolisp/Visual Lisp

They are not seperate, rather Visual Lisp is an extension of Autolisp (see link above). The two compliment each other. There are thing you can do in Visual Lisp that you can't in Autolisp and vice versa. For me it improves code readability and makes the code concise.

Autolisp works with entities, VL with objects. You can move between them using two VL functions

(vlax-ename->vla-object) entity->object

(vlax-vla-object->ename) object->entity

but you can also define two variables to point to the same drawing object

(setq obj (vlax-ename->vla-object (setq ent (car (entsel "\nSelect Entity : ")))))

To get the layer of the object using autolisp  (setq lyr (cdr (assoc 8 (entget ent))))

To get the layer of the object using VL you can use  any of these

(setq lyr (vla-get-layer obj))

(setq lyr (vlax-get-property obj 'layer)) or (setq lyr (vlax-get-property obj "layer"))

or the undocumented

(setq lyr (vlax-get obj 'layer))  or (setq lyr (vlax-get obj "layer"))

To change the layer of an entity using autolisp where new_lyr is the name of the new layer

(setq ents (entget ent))

(entmod (subst (cons 8 new_lyr) (assoc 8 ents)) ents)

To change the layer of an object using VL  you would substitute "put" for "get" in any of the above so

(vlax-put-property obj 'layer new_lyr) or (vla-put-layer obj new_lyr)

[ВeekeeCZ]

---

@alique.langlois wrote:

That does exactly what I needed!  Thank you @ВeekeeCZ! 

Now that this is done I have time to try and figure out how it works! I may poke you here if I have questions.

...

---

You're welcome. 

Btw once you get to the :blockselect sub-function you may find that you need to remove the AND function to make it work properly and you'll be right about that. 

[alique.langlois]

@ВeekeeCZ 

Sorry to bug you again. I the case where I make my blocks Dynamic the function stopped work and said that the block is invalid. Could you point me to the reason? I can do the rest of the research and programming from there

(learning curve on forum etiquette, should I make a new post or this is good)

[ВeekeeCZ]

Instead of this part...

(cdr (assoc 2 (entget ben)))

You'll need something like this: 

(:getBlockName ben)

; with this sub:

(defun :getBlockName (obj)
  (if (= (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj)))
  (if (vlax-property-available-p obj 'EffectiveName)
    (vla-get-EffectiveName obj)
    (vla-get-Name obj)))

; also this is needed somewhere

(vl-load-com)

[alique.langlois]

Hello @ВeekeeCZ, Just a question for you regarding the block selection sub you had made for me. 

One of the IS0X block is often the nexus point for the others. and I often have to make my polyline back to it. I was wondering if I could add a global variable that you hold that point when it is selected and allow the user to just hit enter and it will use that point. Then when a new nexus point is selected, it will store the new point for the next cycle. I often go from different first points, but the second point is often the same. 

;---------------------------------------------------------------------------------
; 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.")
); first condition
((/= "INSERT" (cdr (assoc 0 (entget ben)))) ; not a block 
(princ "\nError: Wrong selection, BLOCK is required.")
) ; second condition
((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") (cdr (assoc 10 (entget ben))))
)
)
)
)
)
out
); defun
;---------------------------------------------------------------------------------

; the part of code I would use to set the repeat globel variable
	
	
	; select the first point block entity
	(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 ((= "IS0X" (car bl1)) (LM:getattributevalue (cadr bl1) "I_NUM"))
					((= (car bl1) "COMBINER") (LM:getattributevalue (cadr bl1) "C_NUM"))
				)
		)
					

Is this possible? Would you go about this with a global variable or a different way?

[ВeekeeCZ]

HI... Anything is possible... but I would stop for a while and think about the workflow. Two possibilities have in mind...

(while (Pick first block <done>)  ; <done> is not necessary to show, kinda expected
  Make path
  Pick destination block <last>
  Place the callout block)

Pick destination block <last?> ; not sure is 'last' ii meaningful
(while (Pick first block <done>)
  Make path
  Place the callout block)