AutoLISP to automate cable label creation

CLINE.lsp

;----------------------------------------------------------------------------------
; Error Handler
;----------------------------------------------------------------------------------
(defun MI:Error (msg)

    ; Error guarding for when you pass Esc.
    ; Only works on English installs!
  (if (not (member msg (list "Function cancelled" "quit / exit abort")))
    ; if this is genuine error, code backtrace
    (progn
      (vl-bt)
      (princ msg)
    )
  )  ; if
  (princ)
)    ; Error

;----------------------------------------------------------------------------------
; Reload Helper
;----------------------------------------------------------------------------------
(defun c:RRR () (load "CLINE.lsp") (princ "Code reloaded. *reload sound*") (princ))

;----------------------------------------------------------------------------------
; dxf Helper Function
;----------------------------------------------------------------------------------
(defun dxf (i l) (cdr (assoc i l)))

;----------------------------------------------------------------------------------
; Degree-to-Radian (dtr) Helper Function
;----------------------------------------------------------------------------------
(defun dtr (x)
	;define degrees to radians function

  (* pi (/ x 180.0))
	;divide the angle by 180 then
	;multiply the result by the constant PI

)    ;end of function

;----------------------------------------------------------------------------------
;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [ent] Block (Insert) Entity Name
;; Returns: [lst] Association list of ((<tag> . <value>) ... )
;----------------------------------------------------------------------------------

(defun LM:getattributevalues (blk / enx)
  (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
    (cons
      (cons
        (cdr (assoc 2 enx))
        (cdr (assoc 1 (reverse enx)))
      )
          (LM:getattributevalues blk)
    )
  )
)

;----------------------------------------------------------------------------------
; The Command
;----------------------------------------------------------------------------------
(defun MI:cline (direction / *error*
                cablenum cabletypename
                startlabelblock endlabelblock startoffs endoffs
                vertex_lst firstpoint lastpoint line layername
                firstnsel firstnent firstent lastnsel lastnent lastent
                firstnattribs firstattribs
                lastnattribs lastattribs
               )
                ; lastnsel - selected entity
                ; ent - entity info with entget
  ; error guarding
  (setq *error* MI:Error)
  
  ; do not echo
  (setq echo (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  
  (setq cablenum (getstring "Enter cable number to draw: "))
  
  (setq cabletype (getreal 
                    "Enter cable type to draw: [1: HDMI/2:CAT/3:Analog Audio/4:Speaker/5:FO/6:RS232/7:Power]:")
  )
  
  ;;;
  ;;; PARSE DIRECTION
  ;;;
  ;;; TODO: Don't hard code Block Name!!
  (cond
    ((= direction "lr") (progn 
                          (setq startlabelblock "CBL-LABEL-LEFT") (setq endlabelblock "CBL-LABEL-RIGHT")
                          (setq startoffs 180) (setq endoffs 0)
                        ))
    ((= direction "rl") (progn 
                          (setq startlabelblock "CBL-LABEL-RIGHT") (setq endlabelblock "CBL-LABEL-LEFT")
                          (setq startoffs 0) (setq endoffs 180)
                        ))
    ((= direction "ll") (progn 
                          (setq startlabelblock "CBL-LABEL-LEFT") (setq endlabelblock "CBL-LABEL-LEFT")
                          (setq startoffs 180) (setq endoffs 180)
                        ))
    ((= direction "rr") (progn 
                          (setq startlabelblock "CBL-LABEL-RIGHT") (setq endlabelblock "CBL-LABEL-RIGHT")
                          (setq startoffs 0) (setq endoffs 0)
                        ))
  )

  ;;;
  ;;; CREATE THE PLINE
  ;;;
  (command "PLINE")
  ; pause until line is finished
  (while (> (getvar 'CmdActive) 0) (command pause))
  ; save the entity of the created line
  (setq line (entget (entlast)))

  
  ; get the first and last line of the created polyline
  (setq vertex_lst (vl-remove nil (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) line)))
  (setq firstpoint (nth 0 vertex_lst))
  (setq lastpoint (nth (- (length vertex_lst) 1) vertex_lst))
  
  ; set correct layer name and cable type name according to input
  (cond
    ((= cabletype 1) (progn (setq layername "HDMI") (setq cabletypename "HDMI")))
    ((= cabletype 2) (progn (setq layername "CAT") (setq cabletypename "CAT7")))
    ((= cabletype 3) (progn (setq layername "ANALOG AUDIO") (setq cabletypename "ANALOG AUDIO")))
    ((= cabletype 4) (progn (setq layername "SPEAKER") (setq cabletypename "SPEAKER")))
    ((= cabletype 5) (progn (setq layername "FO") (setq cabletypename "FO")))
    ((= cabletype 6) (progn (setq layername "SERIAL") (setq cabletypename "SERIAL")))
    ((= cabletype 7) (progn (setq layername "POWER") (setq cabletypename "IEC")))
  )
  
  ; change layer to the right cable type
  (entmod (subst (cons 8 layername) (assoc 8 line) line))
  
  

  ;;;
  ;;; FIRST POINT BLOCK
  ;;;
  ; create selection from the last point
  (setq firstnsel (nentselp (polar firstpoint (dtr 90) 0.5)))

  ; check selection entity
  (if (= 1 (length (last firstnsel)))
    (progn
      ; get the nested entity
      (setq firstnent (entget (car firstnsel)))
      ; get the main entity
      (setq firstent (entget (car (last firstnsel))))
      ; get all attributes from the nested entity
      (setq firstnattribs (LM:getattributevalues (dxf 330 firstnent)))
      ; get all attributes from the main entity
      (setq firstattribs (LM:getattributevalues (dxf -1 firstent)))
    )
    ; if length is more than 1
    (progn
      ; get the nested entity
      (setq firstnent (entget (car (last firstnsel))))
      ; get the main entity
      (setq firstent (entget (cadr (last firstnsel))))
      ; get all attributes from the nested entity
      (setq firstnattribs (LM:getattributevalues (dxf -1 firstnent)))
      ; get all attributes from the main entity
      (setq firstattribs (LM:getattributevalues (dxf -1 firstent)))
    )
  )
  
  ;;;
  ;;; LAST POINT BLOCK
  ;;;
  ; create selection from the last point
  (setq lastnsel (nentselp (polar lastpoint (dtr 90) 0.5)))

  (if (= 1 (length (last lastnsel)))
    (progn
      ; get the nested entity
      (setq lastnent (entget (car lastnsel)))
      ; get the main entity
      (setq lastent (entget (car (last lastnsel))))
      ; get all attributes from the nested entity
      (setq lastnattribs (LM:getattributevalues (dxf 330 lastnent)))
      ; get all attributes from the main entity
      (setq lastattribs (LM:getattributevalues (dxf -1 lastent)))
    )
    ; if length is more than 1
    (progn
      ; get the nested entity
      (setq lastnent (entget (car (last lastnsel))))
      ; get the main entity
      (setq lastent (entget (cadr (last lastnsel))))
      ; get all attributes from the nested entity
      (setq lastnattribs (LM:getattributevalues (dxf -1 lastnent)))
      ; get all attributes from the main entity
      (setq lastattribs (LM:getattributevalues (dxf -1 lastent)))
    )
  )

  ;;; DEBUGGING ONLY
  ; (princ firstattribs)
  ; (print)
  ; (princ firstnattribs)
  ; (print)
  ; (princ lastattribs)
  ; (print)
  ; (princ lastnattribs)
  
  
  ;;; CREATE FIRST CABLE LABEL BLOCK
  (command "INSERT" startlabelblock (polar firstpoint (dtr startoffs) 0) "1" "1" "0"
           (dxf "DEVICE-ID" lastattribs) cablenum cabletypename
          ;  (if (not (or (= nil (dxf "CONNECTOR" lastnattribs)) (= "" (dxf "CONNECTOR" lastnattribs))))
          ;     (strcat (dxf "CONNECTOR" lastnattribs) " " (dxf "DESCRIPTION" lastnattribs))
          ;     (strcat (dxf "CONNECTOR-LABEL" lastnattribs) " " (dxf "DESCRIPTION" lastnattribs))
          ;  )
          ;  (dxf "ROOM" lastattribs)
  )

  ;;; CREATE LAST CABLE LABEL BLOCK
  (command "INSERT" endlabelblock (polar lastpoint (dtr endoffs) 0) "1" "1" "0"
          (dxf "DEVICE-ID" firstattribs) cablenum cabletypename
          
          ; (if (not (or (= nil (dxf "CONNECTOR" firstnattribs)) (= "" (dxf "CONNECTOR" firstnattribs))))
          ;     (strcat (dxf "CONNECTOR" firstnattribs) " " (dxf "DESCRIPTION" firstnattribs))
          ;     (strcat (dxf "CONNECTOR-LABEL" firstnattribs) " " (dxf "DESCRIPTION" firstnattribs))
          ; )
          ; (dxf "ROOM" firstattribs)
  )

  
  ; set echo back
  (setvar 'cmdecho echo)

  ; clean exit
  (princ)
)



;;;
;;; COMMAND SHORTCUTS
;;;
(defun c:LRLINE ()
  (MI:cline(setq direction "lr"))
)

(defun c:RLLINE ()
  (MI:cline(setq direction "rl"))
)

(defun c:LLLINE ( / direction)
  
  (MI:cline(setq direction "ll"))
)

(defun c:RRLINE ( / direction)
  (MI:cline(setq direction "rr"))
)