A new get length LISP

2026-08-31T18:55:40Z

I don't know if there was ever another LISP/Program to do this type of get length at least I never found one, my original just did what I needed, I have since made it more generally useful (I hope).

As per the drawing I will attach, I just need to get the length of the center between the inner and outer of the perimeter of guards, etc. to determine the unrolled length.

Normally the guards are 3D and I create the profiles with SOLPROF which creates an anonymous block (I used to change these with UNANON) or sometimes in the past I have used SOLVIEW and SOLDRAW, the same issue arises that you just can't select them and get the profile length.

So originally that's what this LISP was created to do (I still have some of the older basic versions).

I have upgraded it to it's current state and also still working on another version, but only small enhancements.

For inside a block that is scaled, you will need to multiply the results by the scale factor, working through a viewport the viewport needs to be active, so I might tackle those issues as well as make a more detailed CSV. I also will try to make sure it works in non-AutoCAD like BricsCAD, CMS IntelliCAD, nanoCAD, etc. when I get time.

I lightly tested in most situations, I have no idea how it acts on non-uniformly scaled blocks, though.

It handles gaps and slight overlaps, I have some settings at the top, hopefully with enough instructions to modify on your own.

Where I work (except for the machine shop which uses decimal inches) they use Architectural units, I did not double check this in Metric, so if someone would report back on that it would help.

;;; Get total length of profile, etc. option to get average and report to CSV.                    |
;;;                                                                                               |
;;; https://www.cadtutor.net/forum/topic/99276-a-new-get-length-lisp/#findComment-679965          |
;;;                                                                                               |
;;; By SLW210 (a.k.a. Steve Wilson)                                                               |
;;;                                                                                               |
;;; ==============================================================================================|
;;; ==============================================================================================|
;;; GetLen.lsp                                                                                    |
;;; PROFILE / CENTERLINE LENGTH                                                                   |
;;;                                                                                               |
;;; VERSION: 2026-08-31                                                                           |
;;;                                                                                               |
;;; Supports a combination of:                                                                    |
;;;   LINE                                                                                        |
;;;   ARC                                                                                         |
;;;   CIRCLE                                                                                      |
;;;   LWPOLYLINE                                                                                  |
;;;   POLYLINE                                                                                    |
;;;   SPLINE                                                                                      |
;;;   ELLIPSE                                                                                     |
;;;                                                                                               |
;;; If PELLIPSE=1:                                                                                |
;;;   Heavy Polyline (a.k.a. Old Style or 2D Polylines) made from bulged VERTEX records.          |
;;;   These can be converted with CONVERTPOLY command, I chose to work with the Heavy Polylines.  |
;;;                                                                                               |
;;; Supports:                                                                                     |
;;;   - Model Space                                                                               |
;;;   - Paper Space                                                                               |
;;;   - Blocks (must be Scale 1.0)                                                                |
;;;   - Nested blocks                                                                             |
;;;   - Anonymous/dynamic blocks (*U...)                                                          |
;;;   - Uniform block scaling                                                                     |
;;;   - Single profile                                                                            |
;;;   - Two-profile average / centerline                                                          |
;;;   - Screen output                                                                             |
;;;   - CSV output                                                                                |
;;;   - Architectural formatting                                                                  |
;;;   - Endpoint tolerance for slight overlaps                                                    |
;;;   - Optional gap measurement                                                                  |
;;;                                                                                               |
;;; NOTE:                                                                                         |
;;;   nentsel returns:                                                                            |
;;;     1 = entity                                                                                |
;;;     2 = pick point                                                                            |
;;;     3 = transformation matrix                                                                 |
;;;     4 = block-reference path                                                                  |
;;;                                                                                               |
;;; ==============================================================================================|
;;; ==============================================================================================|


(vl-load-com)


;;; ============================================================
;;; USER SETTINGS                                               
;;; Adjust to your preference.                                  
;;; ============================================================

(setq *GETLEN-TOL* 0.01)

;; T = include gaps         
;; NIL = do not include gaps
(setq *GETLEN-ADD-GAPS* T)

;; "DECIMAL"                
;; "ARCHITECTURAL"          
(setq *GETLEN-UNITS* "ARCHITECTURAL")

;; Architectural precision: 
;; 16 = 1/16"               
;; 8  = 1/8"                
;; 4  = 1/4"                
(setq *GETLEN-ARCH-PRECISION* 8)

;; Drawing units expressed as inches:
;; Inches       = 1.0                
;; Feet         = 12.0               
;; Millimeters  = 0.0393700787       
(setq *GETLEN-INCHES-PER-UNIT* 1.0)


;;; ============================================================
;;; CURVE TYPE                                                  
;;; ============================================================

(defun GL:CurveType (ent / d typ)

  (if ent
    (progn

      (setq d
	     (entget ent)
      )

      (setq typ
	     (cdr
	       (assoc 0 d)
	     )
      )

      (if
	(member
	  typ
	  '("LINE" "ARC" "CIRCLE" "LWPOLYLINE" "POLYLINE" "SPLINE"
	    "ELLIPSE")
	)

	 T
      )
    )
  )
)


;;; ============================================================
;;; GET PARENT HEAVY POLYLINE                                   
;;; ============================================================

(defun GL:GetParentPolyline
			    (vertex / ent data typ parent)

  (if
    (and
      vertex
      (= "VERTEX"
	 (cdr
	   (assoc 0
		  (entget vertex)
	   )
	 )
      )
    )

     (progn

       (setq parent
	      (cdr
		(assoc 330
		       (entget vertex)
		)
	      )
       )

       (if parent

	 (progn

	   (setq data
		  (entget parent)
	   )

	   (setq typ
		  (cdr
		    (assoc 0 data)
		  )
	   )

	   (if (= typ "POLYLINE")
	     parent
	     nil
	   )
	 )

	 nil
       )
     )
  )
)

;;; ============================================================
;;; NESTED SELECTION                                            
;;; ============================================================

(defun GL:GetSelectedEntity
			    (/ sel ent typ parent)

  (setq	sel
	 (nentsel
	   "\nSelect a curve in the profile: "
	 )
  )

  (if sel

    (progn

      (setq ent
	     (car sel)
      )

      (setq typ
	     (cdr
	       (assoc 0
		      (entget ent)
	       )
	     )
      )

      ;; ------------------------------------------------------
      ;; Heavy POLYLINE / VERTEX                               
      ;; ------------------------------------------------------

      (if (= typ "VERTEX")

	(progn

	  (setq	parent
		 (GL:GetParentPolyline ent)
	  )

	  (if parent

	    (progn

	      (princ
		"\nHeavy POLYLINE vertex selected."
	      )

	      (princ
		"\nUsing parent POLYLINE."
	      )

	      (list
		parent
		(cadr sel)
		(caddr sel)
		(cadddr sel)
	      )
	    )

	    (progn

	      (princ
		"\nCould not identify parent POLYLINE."
	      )

	      sel
	    )
	  )
	)

	sel
      )
    )
  )
)

;;; ============================================================
;;; GET BLOCK PATH                                              
;;; ============================================================

(defun GL:GetBlockPath
		       (sel / path)

  (if sel
    (progn

      (setq path
	     (cadddr sel)
      )

      (cond

	((and
	   path
	   (= (type path) 'ENAME)
	 )

	 (list path)
	)

	((listp path)

	 path
	)

	(T
	 nil
	)
      )
    )
  )
)


;;; ============================================================
;;; GET BLOCK REFERENCE                                         
;;; ============================================================

(defun GL:GetBlockReference
			    (sel / path)

  (setq	path
	 (GL:GetBlockPath sel)
  )

  (if path
    (car path)
  )
)


;;; ============================================================
;;; GET BLOCK NAME                                              
;;; ============================================================

(defun GL:GetBlockNameFromPath
			       (sel / ref data name)

  (setq	ref
	 (GL:GetBlockReference sel)
  )

  (if ref
    (progn

      (setq data
	     (entget ref)
      )

      (setq name
	     (cdr
	       (assoc 2 data)
	     )
      )

      name
    )
  )
)


;;; ============================================================
;;; GET BLOCK DEFINITION ENTITIES                               
;;; ============================================================

(defun GL:GetBlockEntities
			   (blkName / btr ent typ result)

  (setq result nil)

  (if blkName
    (progn

      (setq btr
	     (tblobjname
	       "BLOCK"
	       blkName
	     )
      )

      (if btr
	(progn

	  (setq	ent
		 (entnext btr)
	  )

	  (while ent

	    (setq typ
		   (cdr
		     (assoc
		       0
		       (entget ent)
		     )
		   )
	    )

	    (if	(= typ "ENDBLK")

	      (setq ent nil)

	      (progn

		(setq result
		       (cons ent result)
		)

		(setq ent
		       (entnext ent)
		)
	      )
	    )
	  )
	)
      )
    )
  )

  (reverse result)
)


;;; ============================================================
;;; GET CURVES FROM BLOCK                                       
;;; ============================================================

(defun GL:GetBlockCurves
			 (blkName / all curves e)

  (setq	all
	 (GL:GetBlockEntities blkName)
  )

  (setq curves nil)

  (foreach e all

    (if
      (GL:CurveType e)

       (setq curves
	      (cons e curves)
       )
    )
  )

  (reverse curves)
)


;;; ============================================================
;;; HEAVY POLYLINE ENDPOINTS                                    
;;; ============================================================

(defun GL:GetHeavyPolylineEndpoints
				    (pline   /	     data    flags
				     closed  ent     vdata   typ
				     firstPt lastPt
				    )

  (setq	data
	 (entget pline)
  )

  ;; POLYLINE group 70
  (setq	flags
	 (cdr
	   (assoc 70 data)
	 )
  )

  (setq	closed
	 (= 1
	    (logand
	      (if flags
		flags
		0
	      )
	      1
	    )
	 )
  )

  (setq	ent
	 (entnext pline)
  )

  (while ent

    (setq vdata
	   (entget ent)
    )

    (setq typ
	   (cdr
	     (assoc 0 vdata)
	   )
    )

    (cond

      ((= typ "VERTEX")

       (if (null firstPt)

	 (setq firstPt
		(cdr
		  (assoc 10 vdata)
		)
	 )
       )

       (setq lastPt
	      (cdr
		(assoc 10 vdata)
	      )
       )
      )

      ((= typ "SEQEND")

       (setq ent nil)
      )
    )

    (if	ent
      (setq ent
	     (entnext ent)
      )
    )
  )

  (if
    (and
      firstPt
      lastPt
    )

     (if closed

       ;; ------------------------------------------------------
       ;; CLOSED POLYLINE                                       
       ;; ------------------------------------------------------

       (list
	 firstPt
	 firstPt
       )

       ;; ------------------------------------------------------
       ;; OPEN POLYLINE                                         
       ;; ------------------------------------------------------

       (list
	 firstPt
	 lastPt
       )
     )
  )
)

;;; ============================================================
;;; GENERAL ENDPOINTS                                           
;;; ============================================================

```lisp
(defun GL:GetEndpoints
		       (ent / typ p1 p2 result data)

  (if (null ent)
    nil

    (progn
      (setq data (entget ent))
      (setq typ (cdr (assoc 0 data)))

      ;; ------------------------------------------------------
      ;; Heavy POLYLINE                                        
      ;; ------------------------------------------------------

      (if (= typ "POLYLINE")

	(progn
	  (setq	result
		 (GL:GetHeavyPolylineEndpoints ent)
	  )

	  result
	)

	;; ----------------------------------------------------
	;; All other curves                                    
	;; ----------------------------------------------------

	(progn
	  (setq	p1
		 (vl-catch-all-apply
		   'vlax-curve-getStartPoint
		   (list ent)
		 )
	  )

	  (setq	p2
		 (vl-catch-all-apply
		   'vlax-curve-getEndPoint
		   (list ent)
		 )
	  )

	  (if
	    (and
	      (not (vl-catch-all-error-p p1))
	      (not (vl-catch-all-error-p p2))
	    )
	     (list p1 p2)
	     nil
	  )
	)
      )
    )
  )
)

;;; ============================================================
;;; BULGE SEGMENT LENGTH                                        
;;; ============================================================

(defun GL:BulgeSegmentLength
			     (p1 p2 bulge / chord included radius)

  (if
    (or
      (null p1)
      (null p2)
      (equal bulge 0.0 1e-14)
    )

     (if
       (and p1 p2)

	(distance p1 p2)

	0.0
     )

     (progn

       (setq chord
	      (distance p1 p2)
       )

       (setq included
	      (* 4.0
		 (atan
		   (abs bulge)
		 )
	      )
       )

       (if
	 (or
	   (<= chord 1e-14)
	   (<= included 1e-14)
	 )

	  chord

	  (progn

	    (setq radius
		   (/ chord
		      (* 2.0
			 (sin
			   (/ included 2.0)
			 )
		      )
		   )
	    )

	    (* radius included)
	  )
       )
     )
  )
)


;;; ============================================================
;;; HEAVY POLYLINE LENGTH                                       
;;; ============================================================

(defun GL:GetHeavyPolylineLength
				 (pline	     /		data
				  flags	     closed	ent
				  vdata	     typ	firstPt
				  currentPt  currentVertexData
				  nextPt     bulge	total
				 )

  (setq	data
	 (entget pline)
  )

  (setq	flags
	 (cdr
	   (assoc 70 data)
	 )
  )

  (setq	closed
	 (= 1
	    (logand
	      (if flags
		flags
		0
	      )
	      1
	    )
	 )
  )

  (setq total 0.0)
  (setq firstPt nil)
  (setq currentPt nil)
  (setq currentVertexData nil)

  (setq	ent
	 (entnext pline)
  )

  (while ent

    (setq vdata
	   (entget ent)
    )

    (setq typ
	   (cdr
	     (assoc 0 vdata)
	   )
    )

    (cond

      ((= typ "VERTEX")

       (setq nextPt
	      (cdr
		(assoc 10 vdata)
	      )
       )

       (if (not firstPt)
	 (setq firstPt nextPt)
       )

       ;; Previous vertex controls this segment.
       (if
	 (and
	   currentPt
	   currentVertexData
	 )

	  (progn

	    (setq bulge
		   (cdr
		     (assoc
		       42
		       currentVertexData
		     )
		   )
	    )

	    (if	(null bulge)
	      (setq bulge 0.0)
	    )

	    (setq total
		   (+ total
		      (GL:BulgeSegmentLength
			currentPt
			nextPt
			bulge
		      )
		   )
	    )
	  )
       )

       (setq currentPt nextPt)
       (setq currentVertexData vdata)
      )

      ((= typ "SEQEND")

       (setq ent nil)
      )
    )

    (if	ent
      (setq ent
	     (entnext ent)
      )
    )
  )

  ;; Closed polyline.
  (if
    (and
      closed
      firstPt
      currentPt
      currentVertexData
    )

     (progn

       (setq bulge
	      (cdr
		(assoc
		  42
		  currentVertexData
		)
	      )
       )

       (if (null bulge)
	 (setq bulge 0.0)
       )

       (if
	 (not
	   (equal
	     firstPt
	     currentPt
	     1e-12
	   )
	 )

	  (setq	total
		 (+ total
		    (GL:BulgeSegmentLength
		      currentPt
		      firstPt
		      bulge
		    )
		 )
	  )
       )
     )
  )

  total
)


;;; ============================================================
;;; GENERAL GETLENGTH                                           
;;; ============================================================

(defun GL:GetLength
		    (ent / typ obj result ep d data p1 p2)

  (setq	typ
	 (cdr
	   (assoc
	     0
	     (entget ent)
	   )
	 )
  )

  (cond

    ;; --------------------------------------------------------
    ;; HEAVY POLYLINE                                          
    ;; --------------------------------------------------------

    ((= typ "POLYLINE")

     (GL:GetHeavyPolylineLength ent)
    )


    ;; --------------------------------------------------------
    ;; LWPOLYLINE                                              
    ;; --------------------------------------------------------

    ((= typ "LWPOLYLINE")

     (setq obj
	    (vl-catch-all-apply
	      'vlax-ename->vla-object
	      (list ent)
	    )
     )

     (if
       (not
	 (vl-catch-all-error-p obj)
       )

	(progn

	  (setq	result
		 (vl-catch-all-apply
		   'vlax-get-property
		   (list obj 'Length)
		 )
	  )

	  (if
	    (not
	      (vl-catch-all-error-p result)
	    )

	     result

	     0.0
	  )
	)

	0.0
     )
    )


    ;; --------------------------------------------------------
    ;; LINE / ARC / CIRCLE / SPLINE / ELLIPSE                  
    ;; --------------------------------------------------------

    (T

     (setq ep
	    (vl-catch-all-apply
	      'vlax-curve-getEndParam
	      (list ent)
	    )
     )

     (if
       (not
	 (vl-catch-all-error-p ep)
       )

	(progn

	  (setq	d
		 (vl-catch-all-apply
		   'vlax-curve-getDistAtParam
		   (list ent ep)
		 )
	  )

	  (if
	    (not
	      (vl-catch-all-error-p d)
	    )

	     d

	     0.0
	  )
	)

	(progn

	  (setq	data
		 (entget ent)
	  )

	  (setq	p1
		 (cdr
		   (assoc 10 data)
		 )
	  )

	  (setq	p2
		 (cdr
		   (assoc 11 data)
		 )
	  )

	  (if
	    (and p1 p2)

	     (distance p1 p2)

	     0.0
	  )
	)
     )
    )
  )
)


;;; ============================================================
;;; NENTSEL MATRIX SCALE                                        
;;; ============================================================

(defun GL:MatrixVectorLength
			     (v)

  (if
    (and
      v
      (numberp (car v))
      (numberp (cadr v))
      (numberp (caddr v))
    )

     (sqrt
       (+
	 (* (car v) (car v))
	 (* (cadr v) (cadr v))
	 (* (caddr v) (caddr v))
       )
     )

     1.0
  )
)


(defun GL:GetBlockScale
			(matrix / sx sy sz)

  (if
    (and
      matrix
      (listp matrix)
      (>= (vl-list-length matrix) 3)
    )

     (progn

       (setq sx
	      (GL:MatrixVectorLength
		(nth 0 matrix)
	      )
       )

       (setq sy
	      (GL:MatrixVectorLength
		(nth 1 matrix)
	      )
       )

       (setq sz
	      (GL:MatrixVectorLength
		(nth 2 matrix)
	      )
       )

       (if
	 (and
	   (> sx 1e-14)
	   (> sy 1e-14)
	 )

	  (/ (+ sx sy) 2.0)

	  1.0
       )
     )

     1.0
  )
)


;;; ============================================================
;;; DEBUG SCALE                                                 
;;; ============================================================

(defun GL:PrintScale
		     (matrix / scale)

  (if matrix

    (progn

      (setq scale
	     (GL:GetBlockScale matrix)
      )

      (princ
	(strcat
	  "\nBlock scale: "
	  (rtos scale 2 8)
	)
      )
    )

    (princ
      "\nBlock scale: 1.00000000"
    )
  )
)


;;; ============================================================
;;; MEASURED LENGTH                                             
;;; ============================================================

(defun GL:GetMeasuredLength
			    (ent matrix / lngth scale)

  (setq	lngth
	 (GL:GetLength ent)
  )

  (if matrix

    (progn

      (setq scale
	     (GL:GetBlockScale matrix)
      )

      (* lngth scale)
    )

    lngth
  )
)


;;; ============================================================
;;; NEAR                                                        
;;; ============================================================

(defun GL:Near
	       (p1 p2)

  (and
    p1
    p2

    (<=
      (distance p1 p2)
      *GETLEN-TOL*
    )
  )
)


;;; ============================================================
;;; FIND NEXT CONNECTED ENTITY                                  
;;; ============================================================

(defun GL:FindNext
		   (currentEnd curves used / e ep answer)

  (foreach e curves

    (if
      (and
	(not
	  (member e used)
	)

	(setq ep
	       (GL:GetEndpoints e)
	)
      )

       (cond

	 ((GL:Near
	    currentEnd
	    (car ep)
	  )

	  (setq	answer
		 (list
		   e
		   (cadr ep)
		 )
	  )
	 )

	 ((GL:Near
	    currentEnd
	    (cadr ep)
	  )

	  (setq	answer
		 (list
		   e
		   (car ep)
		 )
	  )
	 )
       )
    )

    (if	answer
      (setq e nil)
    )
  )

  answer
)


;;; ============================================================
;;; TRACE PROFILE                                               
;;; ============================================================

(defun GL:TracePath
		    (start     curves	 matrix	   /	     used
		     ordered   total	 gapTotal  ep	     current
		     next      ent	 newEnd	   nextEP    gap
		     lengthValue
		    )

  (setq used nil)
  (setq ordered nil)
  (setq total 0.0)
  (setq gapTotal 0.0)

  (setq	ep
	 (GL:GetEndpoints start)
  )

  (if ep

    (progn

      ;; Start at first endpoint.
      (setq current
	     (car ep)
      )

      (setq used
	     (list start)
      )

      (setq ordered
	     (list start)
      )

      (setq total
	     (GL:GetMeasuredLength
	       start
	       matrix
	     )
      )

      ;; ------------------------------------------------------
      ;; Follow connected curves.                              
      ;; ------------------------------------------------------

      (while
	(setq next
	       (GL:FindNext
		 current
		 curves
		 used
	       )
	)

	 (setq ent
		(car next)
	 )

	 (setq newEnd
		(cadr next)
	 )

	 (setq nextEP
		(GL:GetEndpoints ent)
	 )

	 ;; Calculate actual gap.
	 (if nextEP

	   (setq gap
		  (min
		    (distance
		      current
		      (car nextEP)
		    )

		    (distance
		      current
		      (cadr nextEP)
		    )
		  )
	   )

	   (setq gap 0.0)
	 )

	 ;; Add gaps only when enabled.
	 (if *GETLEN-ADD-GAPS*

	   (if matrix

	     (setq gapTotal
		    (+ gapTotal
		       (* gap
			  (GL:GetBlockScale matrix)
		       )
		    )
	     )

	     (setq gapTotal
		    (+ gapTotal gap)
	     )
	   )
	 )

	 (setq used
		(append
		  used
		  (list ent)
		)
	 )

	 (setq ordered
		(append
		  ordered
		  (list ent)
		)
	 )

	 (setq lengthValue
		(GL:GetMeasuredLength
		  ent
		  matrix
		)
	 )

	 (setq total
		(+ total lengthValue)
	 )

	 (setq current newEnd)
      )
    )
  )

  (list
    ordered
    total
    gapTotal
  )
)


;;; ============================================================
;;; GCMD                                                        
;;; ============================================================

(defun GL:GCMD
	       (a b / remValue)

  (setq a (abs a))
  (setq b (abs b))

  (while (> b 0)

    (setq remValue
	   (rem a b)
    )

    (setq a b)
    (setq b remValue)
  )

  a
)


;;; ============================================================
;;; ARCHITECTURAL FORMAT                                        
;;; ============================================================

(defun GL:Architectural
			(value	  /	   inches   feet     remainder
			 whole	  frac	   num	    den	     gcdValue
			)

  (setq	den
	 *GETLEN-ARCH-PRECISION*
  )

  (setq	inches
	 (* value
	    *GETLEN-INCHES-PER-UNIT*
	 )
  )

  (setq	feet
	 (fix
	   (/ inches 12.0)
	 )
  )

  (setq	remainder
	 (- inches
	    (* feet 12.0)
	 )
  )

  (setq	whole
	 (fix remainder)
  )

  (setq	frac
	 (- remainder whole)
  )

  ;; Round fraction.
  (setq	num
	 (fix
	   (+
	     (* frac den)
	     0.5
	   )
	 )
  )

  ;; Carry fraction into inch.
  (if (>= num den)

    (progn

      (setq num 0)

      (setq whole
	     (1+ whole)
      )
    )
  )

  ;; Carry inch into foot.
  (if (>= whole 12)

    (progn

      (setq whole
	     (- whole 12)
      )

      (setq feet
	     (1+ feet)
      )
    )
  )

  ;; Reduce fraction.
  (if (> num 0)

    (progn

      (setq gcdValue
	     (GL:GCMD
	       num
	       den
	     )
      )

      (if (> gcdValue 1)

	(progn

	  (setq	num
		 (/ num gcdValue)
	  )

	  (setq	den
		 (/ den gcdValue)
	  )
	)
      )
    )
  )

  ;; Format.
  (cond

    ;; Feet.
    ((> feet 0)

     (cond

       ((= num 0)

	(strcat
	  (itoa feet)
	  "'-"
	  (itoa whole)
	  "\""
	)
       )

       ((= whole 0)

	(strcat
	  (itoa feet)
	  "'-"
	  (itoa num)
	  "/"
	  (itoa den)
	  "\""
	)
       )

       (T

	(strcat
	  (itoa feet)
	  "'-"
	  (itoa whole)
	  " "
	  (itoa num)
	  "/"
	  (itoa den)
	  "\""
	)
       )
     )
    )

    ;; Inches only.
    ((= num 0)

     (strcat
       (itoa whole)
       "\""
     )
    )

    ;; Fraction only.
    ((= whole 0)

     (strcat
       (itoa num)
       "/"
       (itoa den)
       "\""
     )
    )

    ;; Whole + fraction.
    (T

     (strcat
       (itoa whole)
       " "
       (itoa num)
       "/"
       (itoa den)
       "\""
     )
    )
  )
)


;;; ============================================================
;;; GET PROFILE CURVES                                          
;;; ============================================================

(defun GL:GetProfileCurves
			   (selected  sel	/	  blkName
			    curves    ss	idx	  e
			    edata     selectedSpace
			   )

  (setq	blkName
	 (GL:GetBlockNameFromPath sel)
  )

  ;; ----------------------------------------------------------
  ;; INSIDE BLOCK                                              
  ;; ----------------------------------------------------------

  (if blkName

    (progn

      (setq curves
	     (GL:GetBlockCurves blkName)
      )

      (list
	blkName
	curves
	selected
      )
    )

    ;; --------------------------------------------------------
    ;; MODEL / PAPER SPACE                                     
    ;; --------------------------------------------------------

    (progn

      (setq selectedSpace
	     (cdr
	       (assoc
		 410
		 (entget selected)
	       )
	     )
      )

      (setq ss
	     (ssget "_X")
      )

      (setq curves nil)

      (if ss

	(progn

	  (setq idx 0)

	  (while
	    (< idx
	       (sslength ss)
	    )

	     (setq e
		    (ssname ss idx)
	     )

	     (if
	       (GL:CurveType e)

		(progn

		  (setq	edata
			 (entget e)
		  )

		  (if
		    (= selectedSpace
		       (cdr
			 (assoc
			   410
			   edata
			 )
		       )
		    )

		     (setq curves
			    (cons e curves)
		     )
		  )
		)
	     )

	     (setq idx
		    (1+ idx)
	     )
	  )
	)
      )

      (list
	nil
	(reverse curves)
	selected
      )
    )
  )
)


;;; ============================================================
;;; CALCULATE PROFILE                                           
;;; ============================================================

(defun GL:CalculateProfile
			   (selected  sel	/	  info
			    curves    actual	matrix	  blockName
			   )

  (setq	info
	 (GL:GetProfileCurves
	   selected
	   sel
	 )
  )

  (if info

    (progn

      (setq curves
	     (cadr info)
      )

      (setq actual
	     (caddr info)
      )

      (setq matrix
	     (caddr sel)
      )

      (setq blockName
	     (car info)
      )

      (if (null blockName)
	(setq matrix nil)
      )

      (if actual

	(GL:TracePath
	  actual
	  curves
	  matrix
	)
      )
    )
  )
)


;;; ============================================================
;;; PRINT PROFILE                                               
;;; ============================================================

(defun GL:PrintProfile
		       (number result matrix / ordered total gaps e ed
			typ)

  (setq	ordered
	 (car result)
  )

  (setq	total
	 (cadr result)
  )

  (setq	gaps
	 (caddr result)
  )

  (princ
    (strcat
      "\n\nPROFILE "
      (itoa number)
      "\n================================"
    )
  )

  ;; Show scale.
  (GL:PrintScale matrix)

  (princ
    (strcat
      "\nObjects traced: "
      (itoa
	(vl-list-length ordered)
      )
    )
  )

  (foreach e ordered

    (setq ed
	   (entget e)
    )

    (setq typ
	   (cdr
	     (assoc
	       0
	       ed
	     )
	   )
    )

    (princ
      (strcat
	"\n  "
	typ
	"  Handle="
	(cdr
	  (assoc
	    5
	    ed
	  )
	)
	"  Length="
	(rtos
	  (GL:GetMeasuredLength
	    e
	    matrix
	  )
	  2
	  6
	)
      )
    )
  )

  (princ
    (strcat
      "\n--------------------------------"
      "\nCurve length: "
      (rtos total 2 6)
      "\nGaps: "
      (rtos gaps 2 6)
      "\nTotal: "
      (rtos
	(+ total gaps)
	2
	6
      )
      "\nArchitectural: "
      (GL:Architectural
	(+ total gaps)
      )
      "\n================================"
    )
  )

  result
)


;;; ============================================================
;;; CSV                                                         
;;; ============================================================

(defun GL:WriteCSV
		   (filename result1 result2 average / f totalValue)

  (setq	f
	 (open
	   filename
	   "w"
	 )
  )

  (if f

    (progn

      (write-line
	"GETLEN Profile Length Report"
	f
      )

      (write-line
	"Profile,Length,Architectural"
	f
      )

      (if result1

	(progn

	  (setq	totalValue
		 (+
		   (cadr result1)
		   (caddr result1)
		 )
	  )

	  (write-line
	    (strcat
	      "Profile 1,"
	      (rtos totalValue 2 6)
	      ","
	      (GL:Architectural totalValue)
	    )
	    f
	  )
	)
      )

      (if result2

	(progn

	  (setq	totalValue
		 (+
		   (cadr result2)
		   (caddr result2)
		 )
	  )

	  (write-line
	    (strcat
	      "Profile 2,"
	      (rtos totalValue 2 6)
	      ","
	      (GL:Architectural totalValue)
	    )
	    f
	  )
	)
      )

      (if average

	(write-line
	  (strcat
	    "Average,"
	    (rtos average 2 6)
	    ","
	    (GL:Architectural average)
	  )
	  f
	)
      )

      (close f)

      T
    )
  )
)


;;; ============================================================
;;; MAIN COMMAND                                                
;;; ============================================================

(defun c:GETLEN
		(/	   mode	     output    sel1	 sel2
		 ent1	   ent2	     result1   result2	 total1
		 total2	   average   csvFile   info	 location
		 curvesCount	     matrix1   matrix2
		)

  (vl-load-com)

  (princ
    "\n\n========================================"
  )

  (princ
    "\nGETLEN - PROFILE LENGTH"
  )

  (princ
    "\n========================================"
  )


  ;; ==========================================================
  ;; MODE                                                      
  ;; ==========================================================

  (initget
    "Single Average"
  )

  (setq	mode
	 (getkword
	   "\nMode [Single/Average] <Single>: "
	 )
  )

  (if (null mode)
    (setq mode "Single")
  )


  ;; ==========================================================
  ;; OUTPUT                                                    
  ;; ==========================================================

  (initget
    "Screen CSV Both"
  )

  (setq	output
	 (getkword
	   "\nOutput [Screen/CSV/Both] <Screen>: "
	 )
  )

  (if (null output)
    (setq output "Screen")
  )


  ;; ==========================================================
  ;; FIRST PROFILE                                             
  ;; ==========================================================

  (if (= mode "Average")

    (princ
      "\n\nFIRST PROFILE"
    )
  )

  (setq	sel1
	 (GL:GetSelectedEntity)
  )

  (if sel1

    (progn

      (setq ent1
	     (car sel1)
      )

      (setq matrix1
	     (caddr sel1)
      )

      ;; Get information.
      (setq info
	     (GL:GetProfileCurves
	       ent1
	       sel1
	     )
      )

      (if info

	(progn

	  (if (car info)

	    (setq location
		   (strcat
		     "Block "
		     (car info)
		   )
	    )

	    (setq location
		   "Model/Paper Space"
	    )
	  )

	  (setq	curvesCount
		 (vl-list-length
		   (cadr info)
		 )
	  )

	  (princ
	    (strcat
	      "\nLocation: "
	      location
	      "\nCurves available: "
	      (itoa curvesCount)
	    )
	  )
	)
      )

      ;; Calculate.
      (setq result1
	     (GL:CalculateProfile
	       ent1
	       sel1
	     )
      )

      (if result1

	(GL:PrintProfile
	  1
	  result1

	  (if (car info)
	    matrix1
	    nil
	  )
	)

	(princ
	  "\nSelected curve could not be resolved."
	)
      )
    )

    (princ
      "\nNothing selected."
    )
  )


  ;; ==========================================================
  ;; SECOND PROFILE                                            
  ;; ==========================================================

  (if
    (and
      (= mode "Average")
      result1
    )

     (progn

       (princ
	 "\n\nSECOND PROFILE"
       )

       (setq sel2
	      (GL:GetSelectedEntity)
       )

       (if sel2

	 (progn

	   (setq ent2
		  (car sel2)
	   )

	   (setq matrix2
		  (caddr sel2)
	   )

	   (setq info
		  (GL:GetProfileCurves
		    ent2
		    sel2
		  )
	   )

	   (if info

	     (progn

	       (if (car info)

		 (setq location
			(strcat
			  "Block "
			  (car info)
			)
		 )

		 (setq location
			"Model/Paper Space"
		 )
	       )

	       (princ
		 (strcat
		   "\nLocation: "
		   location
		   "\nCurves available: "
		   (itoa
		     (vl-list-length
		       (cadr info)
		     )
		   )
		 )
	       )
	     )
	   )

	   (setq result2
		  (GL:CalculateProfile
		    ent2
		    sel2
		  )
	   )

	   (if result2

	     (progn

	       (GL:PrintProfile
		 2
		 result2
		 (if (car info)
		   matrix2
		   nil
		 )
	       )

	       (setq total1
		      (+
			(cadr result1)
			(caddr result1)
		      )
	       )

	       (setq total2
		      (+
			(cadr result2)
			(caddr result2)
		      )
	       )

	       (setq average
		      (/
			(+ total1 total2)
			2.0
		      )
	       )

	       (princ
		 "\n\nTWO PROFILE AVERAGE / CENTERLINE"
	       )

	       (princ
		 "\n========================================"
	       )

	       (princ
		 (strcat
		   "\nProfile 1: "
		   (rtos total1 2 6)
		   "  "
		   (GL:Architectural total1)
		 )
	       )

	       (princ
		 (strcat
		   "\nProfile 2: "
		   (rtos total2 2 6)
		   "  "
		   (GL:Architectural total2)
		 )
	       )

	       (princ
		 "\n----------------------------------------"
	       )

	       (princ
		 (strcat
		   "\nAverage / Centerline: "
		   (rtos average 2 6)
		 )
	       )

	       (princ
		 (strcat
		   "\nArchitectural: "
		   (GL:Architectural average)
		 )
	       )

	       (princ
		 "\n========================================"
	       )
	     )

	     (princ
	       "\nSecond profile could not be resolved."
	     )
	   )
	 )

	 (princ
	   "\nSecond profile not selected."
	 )
       )
     )
  )

  (if
    (or
      (= output "CSV")
      (= output "Both")
    )

     (progn

       (setq csvFile
	      (getfiled
		"Save GETLEN CSV Report"
		"GETLEN.csv"
		"csv"
		1
	      )
       )

       (if csvFile

	 (progn

	   (GL:WriteCSV
	     csvFile
	     result1
	     result2
	     average
	   )

	   (princ
	     (strcat
	       "\nCSV saved: "
	       csvFile
	     )
	   )
	 )
       )
     )
  )


  ;; ==========================================================
  ;; FINISH                                                    
  ;; ==========================================================

  (princ
    "\n\nGETLEN complete."
  )

  (princ)
)


;;; ============================================================
;;; LOAD MESSAGE                                                
;;; ============================================================

(princ
  "\nGETLEN loaded. Type GETLEN to run."
)

(princ)

GetLenTest.dwg

Sign In

A new get length LISP

Recommended Posts

SLW210

Join the conversation

Tutorials

Forums

Activity