lisp for add line length with same color and compare together then choose the bigest and write on a special coordinate

[mohammadreza]

hi . can you help me about this below lisp , please.?

lisp for add line length with same color and compare together then choose the biggest and write on a special coordinate

[Tsuky]

This ?

(defun c:max_length_by_color ( / ss n dxf_ent d c l nw_l val)
(setq l nil nw_l nil)
  (setq ss (ssget '(( 0 . "LINE"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          dxf_ent (entget (ssname ss (setq n (1- n))))
          d (distance (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)))
          c
          (if (assoc 420 dxf_ent)
            (cdr (assoc 420 dxf_ent))
            (if (assoc 62 dxf_ent)
              (cdr (assoc 62 dxf_ent))
              256
            )
          )
          l (cons (cons c d) l)
        )
      )
      (mapcar '(lambda (x) (if (not (member x nw_l)) (setq nw_l (cons x nw_l)))) (mapcar 'car l))
      (setq
        val
        (eval
          (cons 'max
            (mapcar
              'cdr
              (mapcar
                '(lambda (e)
                  (cons e (apply '+ (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq e (car x))) l))))
                )
                nw_l
              )
            )
          )
        )
      )
      (entmake
        (list
          '(0 . "MTEXT")
          '(100 . "AcDbEntity")
          (cons 410 (getvar "CTAB"))
          (cons 8 (getvar "CLAYER"))
          '(100 . "AcDbMText")
          (cons 10 (getvar "VIEWCTR"))
          (cons 40 (getvar "TEXTSIZE"))
          '(41 . 0)
          '(46 . 0.0)
          '(71 . 1)
          '(72 . 5)
          (cons 1 (strcat "\\pxt20;{\\C1;" (rtos val) "}"))
          '(7 . "Standard")
          '(210 0.0 0.0 1.0)
          '(11 1.0 0.0 0.0)
          '(42 . 0.0)
          '(50 . 0.0)
        )
      )
      (command "_.move" (entlast) "" (getvar "VIEWCTR") pause)
    )
  )
  (prin1)
)

 

[mohammadreza]

On 9/21/2023 at 8:54 PM, Tsuky said:

This ?

(defun c:max_length_by_color ( / ss n dxf_ent d c l nw_l val)
(setq l nil nw_l nil)
  (setq ss (ssget '(( 0 . "LINE"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          dxf_ent (entget (ssname ss (setq n (1- n))))
          d (distance (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)))
          c
          (if (assoc 420 dxf_ent)
            (cdr (assoc 420 dxf_ent))
            (if (assoc 62 dxf_ent)
              (cdr (assoc 62 dxf_ent))
              256
            )
          )
          l (cons (cons c d) l)
        )
      )
      (mapcar '(lambda (x) (if (not (member x nw_l)) (setq nw_l (cons x nw_l)))) (mapcar 'car l))
      (setq
        val
        (eval
          (cons 'max
            (mapcar
              'cdr
              (mapcar
                '(lambda (e)
                  (cons e (apply '+ (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq e (car x))) l))))
                )
                nw_l
              )
            )
          )
        )
      )
      (entmake
        (list
          '(0 . "MTEXT")
          '(100 . "AcDbEntity")
          (cons 410 (getvar "CTAB"))
          (cons 8 (getvar "CLAYER"))
          '(100 . "AcDbMText")
          (cons 10 (getvar "VIEWCTR"))
          (cons 40 (getvar "TEXTSIZE"))
          '(41 . 0)
          '(46 . 0.0)
          '(71 . 1)
          '(72 . 5)
          (cons 1 (strcat "\\pxt20;{\\C1;" (rtos val) "}"))
          '(7 . "Standard")
          '(210 0.0 0.0 1.0)
          '(11 1.0 0.0 0.0)
          '(42 . 0.0)
          '(50 . 0.0)
        )
      )
      (command "_.move" (entlast) "" (getvar "VIEWCTR") pause)
    )
  )
  (prin1)
)

 

actually its true.thanks

[mohammadreza]

4 hours ago, mohammadreza said:

actually its true.thanks

 

On 9/21/2023 at 8:54 PM, Tsuky said:

This ?

(defun c:max_length_by_color ( / ss n dxf_ent d c l nw_l val)
(setq l nil nw_l nil)
  (setq ss (ssget '(( 0 . "LINE"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          dxf_ent (entget (ssname ss (setq n (1- n))))
          d (distance (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)))
          c
          (if (assoc 420 dxf_ent)
            (cdr (assoc 420 dxf_ent))
            (if (assoc 62 dxf_ent)
              (cdr (assoc 62 dxf_ent))
              256
            )
          )
          l (cons (cons c d) l)
        )
      )
      (mapcar '(lambda (x) (if (not (member x nw_l)) (setq nw_l (cons x nw_l)))) (mapcar 'car l))
      (setq
        val
        (eval
          (cons 'max
            (mapcar
              'cdr
              (mapcar
                '(lambda (e)
                  (cons e (apply '+ (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq e (car x))) l))))
                )
                nw_l
              )
            )
          )
        )
      )
      (entmake
        (list
          '(0 . "MTEXT")
          '(100 . "AcDbEntity")
          (cons 410 (getvar "CTAB"))
          (cons 8 (getvar "CLAYER"))
          '(100 . "AcDbMText")
          (cons 10 (getvar "VIEWCTR"))
          (cons 40 (getvar "TEXTSIZE"))
          '(41 . 0)
          '(46 . 0.0)
          '(71 . 1)
          '(72 . 5)
          (cons 1 (strcat "\\pxt20;{\\C1;" (rtos val) "}"))
          '(7 . "Standard")
          '(210 0.0 0.0 1.0)
          '(11 1.0 0.0 0.0)
          '(42 . 0.0)
          '(50 . 0.0)
        )
      )
      (command "_.move" (entlast) "" (getvar "VIEWCTR") pause)
    )
  )
  (prin1)
)

 

i need also to know about all lines length

[Tsuky]

The list of all values is in this function (line 28 at 33):

(mapcar
	'(lambda (e)
		(cons e (apply '+ (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq e (car x))) l))))
	)
	nw_l
)