Need help counting support quantities, can you please help?

[israelU7LZU]

Good day to you Gentlemen,

I am not proficient in lisp programing, I don't quite understand the programing language. that's why I come seeking your help on this. 

I need to come up with a way to count supports quantities and add them up by height and create some sort of list in numerical order. is there a way to do these things?

please let me know what other info is needed to make this happen. 

Thank you 

[israelU7LZU]

if I hit enter instead of C for close, it will create a list with 0 chairs. haha 

[Sea-Haven]

Like the saying two steps forward one step back.

I went back to the ssget method you just have to use "WP" "within polygon". For the angled mtext and cables, make sure you hit enter twice to stop a band selection you will be asked to select more. Just press "N" or "no" to make the table.

At this stage there is no quick way to select the cables and the mtext as the text is all over the place compared to the cables. Still thinking about ways to make it simpler. 

Please try again. 

[israelU7LZU]

Good day Sea-Haven,

I'd been trying ways to get around the fact that my pline selection will not close when I hit "C".  I don't know what else to do, Help and thank you

[Sea-Haven]

Did you use supportsV3.lsp it has gone back to using plain SSGET and for cables on an angle use the WP option. don't need a close.

I thought I sent you a PM with my email address. Will check.

[Sea-Haven]

Thanks to help from others over at Cadtutor give this an try, just follow the prompts, you pick the text and cables for layers, then table text size and outside offset for the search box. 

The final thing I need to do is cross check the totals. 

;;; ==========================================================================
;;; LTCOUNT.lsp  -  Line bundle text counter (BricsCAD)
;;; --------------------------------------------------------------------------
;;; Author    : PB (with Claude)
;;; Platform : BricsCAD only
;;; Version  : 1.0  (2026-09-21)  Initial release
;;;    1.1  (2026-09-21)  Numeric text: TOTAL = value x found x lines
;;;  (e.g. "10" on 8 lines = 80). Non-numeric
;;;  text still totals as found x lines.

;;; Version  : 2.0  (2026-09-22)  2nd version
;; By Alan H
;;; --------------------------------------------------------------------------
;;; Commands :
;;;    LTCOUNT- Main routine
;;;    LTCOUNT-CFG  - Change session settings (layers, table text height)
;;;
;;;    LTCOUNT-CFG removed to pick objects instead
;;;    table text size & search offsets modified 2026-09-22
;;; --------------------------------------------------------------------------
;;; What it does:
;;;    1. Drag a fence across a run of parallel polylines/lines.
;;;    2. Counts the lines crossed (N) and finds the two outside lines.
;;;    3. Offsets both outside lines OUTWARD by a prompted distance and joins
;;;their ends into a closed box (kept on the box layer, non-plotting).
;;;    4. Selects TEXT/MTEXT on the CFG text layer fully inside the box.
;;;    5. Groups identical strings, counts them, multiplies by N.
;;;    6. Reports to the command line and builds a TABLE (Text/Found/Lines/Total).
;;; --------------------------------------------------------------------------
;;; Notes:
;;;    - Start the fence OUTSIDE the run: lines are ordered by distance from
;;;the first fence point, so the first/last become the outside lines.
;;;    - Lines on the box layer are ignored by the fence (safe to re-run).
;;;    - 3D polylines / meshes are skipped (cannot be offset).
;;; ==========================================================================

(vl-load-com)

;;; --------------------------------------------------------------------------
;;; CFG - guarded session globals (edit defaults here)
;;; --------------------------------------------------------------------------
(if (not PB-LTC-TxtLayer) (setq PB-LTC-TxtLayer "SUPPORT-TEXT-BANDED")) ; text layer to count
(if (not PB-LTC-LinLayer) (setq PB-LTC-LinLayer "TENDON-BANDED-BACKGROUND")) ; line layer filter (wildcard)
(if (not PB-LTC-BoxLayer) (setq PB-LTC-BoxLayer "LTCOUNT-BOX")) ; layer for kept box
(if (not PB-LTC-TxtHt)(setq PB-LTC-TxtHt 25)) ; table text height
(if (not PB-LTC-Offset)    (setq PB-LTC-Offset 16)) ; last offset used

;;; --------------------------------------------------------------------------
;;; PB:LTC-Try - apply function, return nil on error
;;; --------------------------------------------------------------------------
(defun PB:LTC-Try (f args / r)
  (setq r (vl-catch-all-apply f args))
  (if (vl-catch-all-error-p r) nil (if r r T))
)

;;; --------------------------------------------------------------------------
;;; PB:LTC-D2 - 2D (plan) distance between two points
;;; --------------------------------------------------------------------------
(defun PB:LTC-D2 (a b)
  (distance (list (car a) (cadr a)) (list (car b) (cadr b)))
)

;;; --------------------------------------------------------------------------
;;; PB:LTC-Close - closest point on curve in plan (falls back to 3D)
;;; --------------------------------------------------------------------------
(defun PB:LTC-Close (o p / r)
  (setq r (vl-catch-all-apply 'vlax-curve-getClosestPointToProjection
  (list o p '(0.0 0.0 1.0))))
  (if (or (null r) (vl-catch-all-error-p r))
   (vlax-curve-getClosestPointTo o p)
   r
 )
)

;;; --------------------------------------------------------------------------
;;; PB:LTC-Offset - offset object, return first new object (extras deleted)
;;; --------------------------------------------------------------------------
(defun PB:LTC-Offset (o d / r l)
  (setq r (vl-catch-all-apply 'vla-Offset (list o d)))
  (if (not (vl-catch-all-error-p r))
  (progn
    (setq l (vlax-safearray->list (vlax-variant-value r)))
    (foreach x (cdr l) (vla-delete x))
      (car l)
    )
  )
)

;;; --------------------------------------------------------------------------
;;; PB:LTC-OffsetOut - offset both sides, keep side farthest from ref point
;;; --------------------------------------------------------------------------
(defun PB:LTC-OffsetOut (o d ref / o1 o2)
   (setq o1 (PB:LTC-Offset o d)
   o2 (PB:LTC-Offset o (- d))
   )
  (cond
  ((and o1 o2)
  (if (> (PB:LTC-D2 ref (PB:LTC-Close o1 ref))
    (PB:LTC-D2 ref (PB:LTC-Close o2 ref)))
    (progn (vla-delete o2) o1)
    (progn (vla-delete o1) o2)
  )
  )
  (o1)
  (o2)
  )
)

;;; --------------------------------------------------------------------------
;;; PB:LTC-CurvePts - WCS points along curve (arc segments densified)
;;; --------------------------------------------------------------------------
(defun PB:LTC-CurvePts (o / typ sp ep i j pa pb pm k st pts)
  (setq typ (cdr (assoc 0 (entget (vlax-vla-object->ename o)))))
  (if (= typ "LINE")
    (list (vlax-curve-getStartPoint o) (vlax-curve-getEndPoint o))
    (progn
      (setq sp (vlax-curve-getStartParam o)
            ep (vlax-curve-getEndParam o)
            i  sp
      )
      (while (< i ep)
        (setq j  (min ep (1+ i))
              st (- j i)
              pa (vlax-curve-getPointAtParam o i)
              pb (vlax-curve-getPointAtParam o j)
              pm (vlax-curve-getPointAtParam o (+ i (/ st 2.0)))
              pts (cons pa pts)
        )
        ;; curved segment - add 7 intermediate points
        (if (> (distance pm (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pa pb)) 1e-4)
          (progn
            (setq k 1)
            (repeat 7
              (setq pts (cons (vlax-curve-getPointAtParam o (+ i (* st (/ k 8.0)))) pts)
                    k   (1+ k)
              )
            )
          )
        )
        (setq i j)
      )
      (reverse (cons (vlax-curve-getEndPoint o) pts))
    )
  )
)

;;; --------------------------------------------------------------------------
;;; PB:LTC-Layer - create layer if missing (non-plotting, magenta)
;;; --------------------------------------------------------------------------
(defun PB:LTC-Layer (lay)
  (if (not (tblsearch "LAYER" lay))
  (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")
    '(100 . "AcDbLayerTableRecord") (cons 2 lay) '(70 . 0)
    '(62 . 6) '(6 . "Continuous") '(290 . 0)))
  )
)

;;; --------------------------------------------------------------------------
;;; PB:LTC-Table - build results TABLE at UCS point ip
;;; --------------------------------------------------------------------------

(defun AH:table_make (numcolumns txtsz / numrows curspc colwidth numcolumnsobjtable rowheight sp )
  (setq sp (vlax-3d-point (getpoint "Pick top left")))
  (if (= (vla-get-activespace doc) 0)
    (setq curspc (vla-get-paperspace doc))
    (setq curspc (vla-get-modelspace doc))
  )
  (setq numrows 2)
  (setq rowheight (* 2.0 txtsz))
  (setq colwidth 100)
  (setq objtable (vla-addtable curspc sp numrows numcolumns rowheight colwidth))
  (vla-settext objtable 0 0 "TABLE title")
  (vla-SetTextHeight Objtable (+ acDataRow acTitleRow acHeaderRow) txtsz)
  (vla-SetText Objtable 0 0 "Chairs")
  (vla-SetText Objtable 1 0 "Size")
  (vla-SetText Objtable 1 1 "Count")
  (setq obj2 (vlax-ename->vla-object (entlast)))
  (vla-Setcolumnwidth obj2 0 (* 6 txtsz))
  (vla-Setcolumnwidth obj2 1 (* 4.5 txtsz))
  (setq obj2 (vlax-ename->vla-object (entlast)))
  (princ)
)

;;; --------------------------------------------------------------------------
;;; Removes double items from a list by Gile
;;; -

(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

;;; --------------------------------------------------------------------------
;;; counts items in a list by Gile
;;; -

(defun my-count (a L)
  (cond
  ((null L) 0)
  ((equal a (car L)) (+ 1 (my-count a (cdr L))))
  (t (my-count a (cdr L))))
)

;;; --------------------------------------------------------------------------
;;; converts single text entries into multiple text entries based on lines crossed
;;; -

(defun splitss ( / x ent textstr)
(repeat (setq x (sslength sst))
  (setq ent (ssname sst (setq x (1- x))))
  (setq type (cdr (assoc 0 (entget ent))))
  (if (wcmatch type "*TEXT")
  (progn
    (setq textstr (getpropertyvalue ent "Text"))
    (repeat n
      (setq lst (cons (list (distof textstr) textstr) lst))
    )
  )
  )
  )
  (princ)
)

;;; --------------------------------------------------------------------------
;;; C:LTCOUNT - main routine
;;; --------------------------------------------------------------------------
 (defun C:LTCOUNT ( / *error* doc oldce p1 p2 p1w p2w ss sst i e ed lst n d r
 objA objB ptA ptB offA offB ptsA ptsB pts ptsU ll ur mg
 cnt s a tp tmp z)


  ;; error handler - clears temp offsets, restores sysvars, closes undo
(defun *error* (msg)

  (if oldce (setvar "CMDECHO" oldce))
  (if doc (vla-EndUndoMark doc))
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\n** Error: " msg " **"))
  )
  (princ)
)

(setq doc    (vla-get-ActiveDocument (vlax-get-acad-object))
  oldce (getvar "CMDECHO")
)

(vla-StartUndoMark doc)
(setvar "CMDECHO" 0)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq oldlay (getvar 'clayer))
(command "-layer" "M" "Table" "")

(setq lst '())

(setq PB-LTC-TxtLayer (cdr (assoc 8 (entget (car (entsel "\npick text object for layer "))))))
(setq PB-LTC-LinLayer (cdr (assoc 8 (entget (car (entsel "\npick cable object for layer "))))))
(command "._-layer" "_off" "*" "Y" "")
(command "._-layer" "_on" (strcat PB-LTC-TxtLayer "," PB-LTC-LinLayer) "")
(setq PB-LTC-BoxLayer "Dummy")

(initget 6)
(setq r (getdist (strcat "\nTable text height <" (rtos PB-LTC-TxtHt 2 3) ">: ")))
(if r (setq PB-LTC-TxtHt r))

(setq cont "Yes")
  
  (while (= cont "Yes")
  
    ;; --- offset distance ---
  (initget 6)
  (setq r (getdist (strcat "\nOffset outward for box <" (rtos PB-LTC-Offset 2 3) ">: ")))
  (if r (setq PB-LTC-Offset r))
  (setq d PB-LTC-Offset)
  
  
  ;; --- fence pick ---
  (setq p1 (getpoint "\nFence start (outside the run of lines): ")
  p2 (getpoint p1 "\nFence end (other side of the run): "))
  (setq ss (ssget "_F" (list p1 p2) (list '(0 . "LWPOLYLINE,POLYLINE,LINE") (cons 8 PB-LTC-LinLayer))))
  (if (= ss nil)(progn  (alert "\nNo lines crossed by the fence\n\nWill now exit.")))
   
  ;; --- order lines by plan distance from fence start ---
  	 
  (setq blst '())
  (setq i 0)
  (repeat (sslength ss)
   (setq e (ssname ss i) ed (entget e) i (1+ i))
   (if (not (and (= "POLYLINE" (cdr (assoc 0 ed)))
   (/= 0 (logand 88 (cdr (assoc 70 ed))))))
   (setq blst (cons (cons (PB:LTC-D2 p1 (PB:LTC-Close e p1))
   (vlax-ename->vla-object e)) blst))
   )
  )
  (setq blst (vl-sort blst '(lambda (a b) (< (car a) (car b)))))
  (setq n (length blst))
  (if (= n 0) (progn (Alert "\nNo 2D lines/polylines crossed\n\nWill now exit.")(exit)))
  
  (setq objA (cdar blst) objB (cdr (last blst)))
  (princ (strcat "\nLines crossed: " (rtos n 2 0)))
  
  ;; --- offset outer lines outward ---
  (if (= n 1)
    (setq offA (PB:LTC-Offset objA d)
    offB (PB:LTC-Offset objA (- d)))
    (setq ptA  (PB:LTC-Close objA p2)
    ptB  (PB:LTC-Close objB p1)
    offA (PB:LTC-OffsetOut objA d ptB)
    offB (PB:LTC-OffsetOut objB d ptA))
  )

  (setq tmp (list offA offB))
 
  (if (= (or offA offB) nil)(progn (alert "\nOffset failed - box not created.\n\nWill now exit")(exit)))
  
      ;; --- build box points (A forward, B back) ---
  (setq ptsA (PB:LTC-CurvePts offA))
  (setq ptsB (PB:LTC-CurvePts offB))
  (if (< (PB:LTC-D2 (car ptsA) (car ptsB))  (PB:LTC-D2 (car ptsA) (last ptsB)))
    (setq ptsB (reverse ptsB))
  )
  (setq pts (append ptsA ptsB))
  (setq z (caddr (car ptsA)))

   ;; --- remove temp offsets ---
  (foreach o tmp (vla-delete o))
  (setq tmp nil)
  
   ;; --- draw kept box ---
  (command "-layer" "M" PB-LTC-BoxLayer "C" 6 "" "")
  (entmakex
  (append
     (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 PB-LTC-BoxLayer)
    '(100 . "AcDbPolyline") (cons 90 (length pts)) '(70 . 1) (cons 38 z))
     (mapcar '(lambda (p) (cons 10 (list (car p) (cadr p)))) pts)
  )
  )
  (setq boxent (entlast))
  
      ;; --- zoom to box, select text inside, zoom back ---
  (setq ptsU (mapcar '(lambda (p) (trans p 0 1)) pts)
    ll    (list (apply 'min (mapcar 'car ptsU)) (apply 'min (mapcar 'cadr ptsU)))
    ur    (list (apply 'max (mapcar 'car ptsU)) (apply 'max (mapcar 'cadr ptsU)))
    mg    (* 0.05 (distance ll ur))
    ll    (mapcar '(lambda (x) (- x mg)) ll)
    ur    (mapcar '(lambda (x) (+ x mg)) ur)
  )
  (command "_.ZOOM" "_W" ll ur)
  
  (setq sst (ssget "_CP" ptsU (list '(0 . "TEXT,MTEXT") (cons 8 PB-LTC-TxtLayer))))
  	 
  (command "_.ZOOM" "_P")
  (command "erase" boxent "")
  
  (if (= sst nil)(progn (alert (strcat "No text found inside box on layer " PB-LTC-TxtLayer "\n\nWill now exit"))(Exit)))
  
  (splitss)
  (setq lst (vl-sort lst '(lambda (i j) (< (car i)(car j)))))
  (princ lst)
  
  (setq lst3 '())
  
  (setq lst2 (remove_doubles lst))
  (princ lst2)
  
  (foreach val lst2
    (setq cnt (my-count val lst))
    (setq lst3 (cons (list val cnt) lst3))
  )
  
  (princ "\n")
  (initget 1 "Yes No")
  (setq ans (getkword "\nSelect more Yes No "))
  (if (= ans "No" )(setq cont "No"))
) ; while

(command "._-layer" "_on" "*" "")
(command "-layer" "M" "Table" "")
(AH:table_make 2 PB-LTC-TxtHt)
  
(setq rownum (vla-get-rows obj2))
(setq count 0)

(repeat (setq x (length lst3))
  (vla-InsertRows obj2 rownum (vla-GetRowHeight obj2 (- rownum 1)) 1)
  (setq trow (nth (setq x (1- x)) lst3))
  (vla-SetText Obj2 rownum 0 (cadr (car trow)))
  (vla-SetText Obj2 rownum 1 (rtos (cadr trow) 2 0))
  (setq count (+ count (cadr trow)))
  (setq rownum (1+ rownum))
)
(vla-InsertRows obj2 rownum (vla-GetRowHeight obj2 (- rownum 1)) 1)
(vla-SetText Obj2 rownum 0 "Total")
(vla-SetText Obj2 rownum 1 (rtos count 2 0))
(vla-SetTextHeight obj2 (+ acDataRow acHeaderRow acTitleRow) PB-LTC-TxtHt)
(vla-SetAlignment obj2 acDataRow acMiddleCenter)

(setvar 'osmode oldsnap)

(*error* nil)
)

(alert "LTCOUNT v2 loaded - LTCOUNT to run again")
(princ)
(c:ltcount)

Other forum, big help from Least, https://www.cadtutor.net/forum/topic/99163-ai-taking-over/page/2/#comments

[israelU7LZU]

Good day Sea-Heven,

once again, I'm running into a 

(LOAD "C:/apps/PT_CAD/LISP/supportsv4.lsp") ; error: syntax error

I appreciate your time on this matter since I have no clue on how to read these files. 

[paullimapa]

found problem with code and corrected LTCOUNT.lsp:

function PB:LTC-CurvePts has extra parenthesis in line 140

[Sea-Haven]

Thanks @paullimapa Will correct and double check was definitely working. 

Code updated above.

[israelU7LZU]

Thank you Paullimapa for the fix. altho now I have a new chanllenge. I will reply to Sea-Haven with a video

[israelU7LZU]

Good day Sea-Haven,

Thanks to you and Paullimapa, I was able to start the command, but when it asks to select the layers, I pick the chair heights then the banded cable layer and when it's done selecting, everything disappears, so when it's time to select a fence, there is nothing to select and it end the commands. 

please see attached video.  

[Sea-Haven]

Please have a look at this. Hopefully shows how to use, the main reason for the repeat of offest value is if you need to make bigger or smaller depending on dwg. This part of dwg can be a problem. The 11 1/4" may get missed.

[israelU7LZU]

Sea-Haven,

I unloaded previous versions of the lisp to make sure I used the most recent one you just sent over. I also restarted Auto CAD to make sure no older version got uploaded. I have no clue why it keeps not selecting the layers and turns off everything. see the video attached please. 

[Sea-Haven]

I turn off the layers that are not selected text and the cables. Will double check that bit of code. 

Ok found it line 261 was incorrect, but code worked for me so did not detect Please replace in code.

(command "._-layer" "_on" (strcat PB-LTC-TxtLayer "," PB-LTC-LinLayer) "")

@israelU7LZU I also noticed in the video a possible problem, you have a single cable with text but at one point it is close to another cable and may count the text incorrectly as it may detect extra text, can you email me the dwg so can test.