Jump to content

Recommended Posts

Posted (edited)

I need to select two columns with numbers and get the result (difference) in the third column.
This code sometimes misidentified the difference, I can't figure out what the reason is.

(defun c:Df2Column ( / col1 col2 n1 n2 p1 p2 p3 basept dy txt1 txt2 i ent1 ent2)
  (princ "\nSelect the texts of the first column: ")
  (setq col1 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col1)
    (progn (princ "\nThe objects of the first column are not selected.") (exit))
  )
  (princ "\nSelect the texts of the second column: ")
  (setq col2 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col2)
    (progn (princ "\nThe objects of the second column are not selected.") (exit))
  )
  (if (/= (sslength col1) (sslength col2))
    (progn (princ "\nThe number of objects in the columns does not match.") (exit))
  )
  (princ "\nSpecify the insertion point of the third column: ")
  (setq basept (getpoint))
  ;; Defining the step by Y between the elements of the second column
  (setq ent2a (ssname col2 0))
  (setq ent2b (ssname col2 1))
  (setq y1 (cadr (cdr (assoc 10 (entget ent2a)))))
  (setq y2 (cadr (cdr (assoc 10 (entget ent2b)))))
  (setq dy (- y2 y1))
  (setq i 0)
  (repeat (sslength col1)
    (setq ent1 (ssname col1 i))
    (setq ent2 (ssname col2 i))
    (setq txt1 (cdr (assoc 1 (entget ent1))))
    (setq txt2 (cdr (assoc 1 (entget ent2))))
    (setq n1 (atof txt1))
    (setq n2 (atof txt2))
    (if (and n1 n2)
      (progn
        (setq p3 (list (car basept) (+ (cadr basept) (* i dy)) 0.0))
        (entmakex (list
          (cons 0 "TEXT")
          (cons 8 (cdr (assoc 8 (entget ent2))))
          (cons 10 p3)
          (cons 40 (cdr (assoc 40 (entget ent2))))
          (cons 1 (if (> (- n1 n2) 0)
            (strcat "+" (rtos (- n1 n2) 2 3))  
            (rtos (- n1 n2) 2 3)))
        ))
      )
    )
    (setq i (1+ i))
  )
    (princ)
)

difference.dwgFetching info...

Edited by Nikon
Posted

Hi
There's a problem with n1 and n2: they're likely referring to texts that are next to each other.
But that's unlikely to happen because it depends on the order in which they are found in the database.
You should create a function that:
1) compares the texts in the two columns
2) relates each pair of texts because they both have the same x coordinate (with a maximum range of 1/2 the height of both texts)
3) creates a list for each columns sets with the texts in order from highest Y to lowest.

Then modify your 'repeat' to iterate over the members of both lists: (nth ind lstColumn1) will always be in the same row as (nth ind lstColumn2)

  • Thanks 1
Posted

I haven't looked at the example - weekend and CAD is off, but how many rows do you have to calculate and on how many drawings?

 

Reason I ask is I often find that the rule a LISP operates with are often not perfect and don't accommodate every situation - If the operation I need to do is not excessive then I refer to do it be select row text 1, row 1 text 2 and then place the result, repeat with row 2, and so on

 

Things to also consider is an overkill on the texts to assess to remove duplicates, check that any mtexts are 1 line texts, text 1 or 2 are strings and not numbers, texts are not text or mtext (attributes, blocks, rtexts (they happen), mtexts don't cover both columns, texts don't cover both columns... and many more things that can stop the routine from completing or making a miss match from one column to the next.

  • Thanks 1
Posted

Comparing rows of text is not a problem it can be done very easy have done many times but this confuses me. How do you pick the two numbers to compare, if it's in order on right examples then must be done in a pick pick manner if its as per "correctly" on right then yes its easy.

 

This one

image.png.c5aa462f3ef67d5078adad1f0db4ac4f.png

 

Or this one

image.png.ccab9dff8fa62a09b429d188ea7d8342.png

  • Thanks 1
Posted (edited)

@Steven P  @BIGAL

Thanks for the clarifications.
There are just 2 columns with separate text or mtext with numeric values,
there can be 2-30 rows in columns...
I select the first column - pcm, then the 2nd column - pcm and specify the insertion point of the 3rd column
with the result.
1st row of 1st column minus 1st row of 2nd column = 1st row of 3rd column, etc.
The above code copes with the task (30 lines or more), but sometimes it crashes and that's why I have to check the result for correctness, so now I can't trust the received values...
The interval between the rows does not always match the interval between the rows of the 1st and 2nd columns...

 

        

Edited by Nikon
Posted

If the order will always be the same, and the number of elements will also be the same (because the code ensures this), then all you need to do is convert the two sets into two lists ordered by their Y coordinates, from highest to lowest.
This could be done like this:

(defun ordena (cj1 cj2 / e l n m)
  (setq l1 nil l2 nil)
  (setq l1 (vl-sort
	     (while (setq e (ssname cj1 (setq n (if n (1+ n) 0))))
	       (setq l (cons (list (caddr (assoc 10 (entget e))) e) l))
	     )
	     '(lambda (a b) (> (car a) (car b)))
	   )
	l nil
  )
  (setq l2 (vl-sort
	     (while (setq e (ssname cj2 (setq m (if m (1+ m) 0))))
	       (setq l (cons (list (caddr (assoc 10 (entget e))) e) l))
	     )
	     '(lambda (a b) (> (car a) (car b)))
	   )
  )
)

 

In these lists each element is another list of 2 elements, where the first is the Z coordinate of the text and the second, its entity name.

  • Thanks 1
Posted

More compact

(defun ordena (cj1 cj2 / e l n m c)
  (setq l1 nil l2 nil)
  (foreach cj (list cj1 cj2)
    (setq l (cons (vl-sort
		    (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
	              (setq c (cons (list (caddr (assoc 10 (entget e))) e) c))
	            )
	            '(lambda (a b) (> (car a) (car b)))
	          )
		  l
	    )
	  c nil n nil
    )
  )
  (setq l1 (car l) l2 (cadr l))
)

 

  • Thanks 1
Posted (edited)

You can call this function after creating the two ssets with '(ordena col1 col2)'.
Then you should undo the 5 lines of code under ';; Defining the step...'
And in 'repeat', replace '(sslength col1)' with '(length l1)'

Additionally, you would also need to replace '(ssname col1 i)' with '(cadr (nth i l1))' and '(ssname col2 i)' with '(cadr (nth i l2))'

Finally, if you want p3 to be exactly the same Y coordinate as the text in column 2, you can replace your current code '(setq p3 (+ (cadr basept)...)' with '(setq p3 (list (car basept) (car (nth i l2)) 0.0))'

 

With all this, your code should work.

Edited by GLAVCVS
  • Thanks 1
Posted
  On 4/27/2025 at 8:49 AM, GLAVCVS said:

More compact

Expand  

Thanks @GLAVCVS

how do I add this to the code correctly?

Posted

Try to do it with the explanations I've given you. That will help you understand the changes somewhat.

If there's anything in the explanation you don't understand, don't hesitate to ask.

  • Thanks 1
Posted
  On 4/27/2025 at 9:14 AM, Nikon said:

Thanks @GLAVCVS

how do I add this to the code correctly?

Expand  

You can paste the 'ordena' function below the rest of the code.

  • Thanks 1
Posted (edited)
  On 4/27/2025 at 9:24 AM, GLAVCVS said:

Try to do it with the explanations I've given you. That will help you understand the changes somewhat.

If there's anything in the explanation you don't understand, don't hesitate to ask.

Expand  

I'll try,  but I'm not sure of my knowledge...

Edited by Nikon
Posted

I would do a sort on Y then X makes sure the values are read from left to right, else may for some odd reason left and right are mixed.

 

; sorts on 1st two items
(vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (cadr a) (cadr b)))
	      ((= (cadr a) (cadr b)) 
		  (< (car a) (car b)))
	    )
	  )
)

 

 

  • Like 1
  • Thanks 1
Posted
  On 4/27/2025 at 8:49 AM, GLAVCVS said:

More compact

(defun ordena (cj1 cj2 / e l n m c)
 (setq l1 nil l2 nil)
 (foreach cj (list cj1 cj2)
 (setq l (cons (vl-sort
 (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
 (setq c (cons (list (caddr (assoc 10 (entget e))) e) c))
 )
 '(lambda (a b) (> (car a) (car b)))
 )
 l
 )
 c nil n nil
 )
 )
 (setq l1 (car l) l2 (cadr l))
)
Expand  

I tried to change the code according to @GLAVCVS advice, but the code gives an error: Group member not found

(defun c:Df2Columns-ord (/ col1 col2 n1 n2 p1 p2 p3 basept dy txt1 txt2 i ent1 ent2 l1 l2)
  (princ "\nSelect the texts of the first column: ")
  (setq col1 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col1)
    (progn (princ "\nThe objects of the first column are not selected.") (exit))
  )
  (princ "\nSelect the texts of the second column: ")
  (setq col2 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col2)
    (progn (princ "\nThe objects of the second column are not selected.") (exit))
  )
  (if (/= (sslength col1) (sslength col2))
    (progn (princ "\nThe number of objects in the columns does not match.") (exit))
  )
  (princ "\nSpecify the insertion point of the third column: ")
  (setq basept (getpoint))
  
   ;; the two arrays
  (setq col1 (vlax-invoke (vlax-get-acad-object) 'ActiveDocument 'ModelSpace))
  (setq col2 (vlax-invoke (vlax-get-acad-object) 'ActiveDocument 'ModelSpace))
  
  (setq col1 (vl-remove-if 'null (mapcar 'ssname (ssget '((0 . "TEXT,MTEXT"))) )))
  (setq col2 (vl-remove-if 'null (mapcar 'ssname (ssget '((0 . "TEXT,MTEXT"))) )))
  
  (ordena col1 col2)
  
  (setq l1 (car (vlax-get-property (vlax-invoke (vlax-get-acad-object) 'ActiveDocument 'ModelSpace) 'Items)))
  (setq l2 (cadr (vlax-get-property (vlax-invoke (vlax-get-acad-object) 'ActiveDocument 'ModelSpace) 'Items)))
  
(defun ordena (cj1 cj2 / e l n m c)
 (setq l1 nil l2 nil)
 (foreach cj (list cj1 cj2)
 (setq l (cons (vl-sort
 (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
 (setq c (cons (list (caddr (assoc 10 (entget e))) e) c))
 )
 '(lambda (a b) (> (car a) (car b)))
 )
 l
 )
 c nil n nil
 )
 )
 (setq l1 (car l) l2 (cadr l))
)

;; Defining the step by Y 
 ;;   (setq ent2a (ssname col2 0))
 ;;   (setq ent2b (ssname col2 1))
 ;;   (setq y1 (cadr (cdr (assoc 10 (entget ent2a)))))
 ;;   (setq y2 (cadr (cdr (assoc 10 (entget ent2b)))))
 ;;   (setq dy (- y2 y1))
  
  (setq i 0)
  (repeat (length l1)
    (setq ent1 (cadr (nth i l1)))
    (setq ent2 (cadr (nth i l2)))
    (setq txt1 (cdr (assoc 1 (entget ent1))))
    (setq txt2 (cdr (assoc 1 (entget ent2))))
    (setq n1 (atof txt1))
    (setq n2 (atof txt2))
    (if (and n1 n2)
      (progn
       
        (setq p3 (list (car basept) (car (nth i l2)) 0.0))
  
        (entmakex
          (list
            (cons 0 "TEXT")
            (cons 8 (cdr (assoc 8 (entget ent2))))
            (cons 10 p3)
            (cons 40 (cdr (assoc 40 (entget ent2))))
            (cons 1 (if (> (- n1 n2) 0)
                        (strcat "+" (rtos (- n1 n2) 2 3))
                        (rtos (- n1 n2) 2 3))
                 )
          )
        )
      )
    )
    (setq i (1+ i))
  )
  (princ)
)

 

Posted (edited)

 

(defun c:Df2Column
       (/ col1 col2 n1 n2 p1 p2 p3 basept dy txt1 txt2 i ent1 ent2 l1 l2 ordena)
  (defun ordena (cj1 cj2 / e l n m c)
    (foreach cj (list cj1 cj2)
      (setq l (cons (vl-sort
		      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
	                (setq c (cons (list (caddr (assoc 10 (entget e))) e) c))
	            )
	            '(lambda (a b) (> (car a) (car b)))
	          )
		  l
	    )
	    c nil n nil
      )
    )
    (setq l1 (cadr l) l2 (car l))
  )
  (princ "\nSelect the texts of the first column: ")
  (setq col1 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col1)
    (progn (princ "\nThe objects of the first column are not selected."
	   )
	   (exit)
    )
  )
  (princ "\nSelect the texts of the second column: ")
  (setq col2 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col2)
    (progn (princ
	     "\nThe objects of the second column are not selected."
	   )
	   (exit)
    )
  )
  (if (/= (sslength col1) (sslength col2))
    (progn (princ
	     "\nThe number of objects in the columns does not match."
	   )
	   (exit)
    )
  )
  (ordena col1 col2)
  (princ "\nSpecify the insertion point of the third column: ")
  (setq basept (getpoint))
  ;; Defining the step by Y between the elements of the second column
;;;  (setq ent2a (ssname col2 0))
;;;  (setq ent2b (ssname col2 1))
;;;  (setq y1 (cadr (cdr (assoc 10 (entget ent2a)))))
;;;  (setq y2 (cadr (cdr (assoc 10 (entget ent2b)))))
;;;  (setq dy (- y2 y1))
  (setq i 0)
  (repeat (length l1);(sslength col1)
    (setq ent1 (cadr (nth i l1)));(ssname col1 i))
    (setq ent2 (cadr (nth i l2)));(ssname col2 i))
    (setq txt1 (cdr (assoc 1 (entget ent1))))
    (setq txt2 (cdr (assoc 1 (entget ent2))))
    (setq n1 (atof txt1))
    (setq n2 (atof txt2))
    (if	(and n1 n2)
      (progn
	(setq p3 (list (car basept) (car (nth i l2)) 0.0))  ;(+ (cadr basept) (* i dy)) 0.0))
	(entmakex (list
		    (cons 0 "TEXT")
		    (cons 8 (cdr (assoc 8 (entget ent2))))
		    (cons 10 p3)
		    (cons 40 (cdr (assoc 40 (entget ent2))))
		    (cons 1
			  (if (> (- n1 n2) 0)
			    (strcat "+" (rtos (- n1 n2) 2 3))
			    (rtos (- n1 n2) 2 3)
			  )
		    )
		  )
	)
      )
    )
    (setq i (1+ i))
  )
  (princ)
)

 

Edited by GLAVCVS
  • Like 1
Posted
  On 4/29/2025 at 6:59 AM, Nikon said:

I tried to change the code according to @GLAVCVS advice, but the code gives an error: Group member not found

(defun c:Df2Columns-ord (/ col1 col2 n1 n2 p1 p2 p3 basept dy txt1 txt2 i ent1 ent2 l1 l2)
  (princ "\nSelect the texts of the first column: ")
  (setq col1 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col1)
    (progn (princ "\nThe objects of the first column are not selected.") (exit))
  )
  (princ "\nSelect the texts of the second column: ")
  (setq col2 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col2)
    (progn (princ "\nThe objects of the second column are not selected.") (exit))
  )
  (if (/= (sslength col1) (sslength col2))
    (progn (princ "\nThe number of objects in the columns does not match.") (exit))
  )
  (princ "\nSpecify the insertion point of the third column: ")
  (setq basept (getpoint))
  
   ;; the two arrays
  (setq col1 (vlax-invoke (vlax-get-acad-object) 'ActiveDocument 'ModelSpace))
  (setq col2 (vlax-invoke (vlax-get-acad-object) 'ActiveDocument 'ModelSpace))
  
  (setq col1 (vl-remove-if 'null (mapcar 'ssname (ssget '((0 . "TEXT,MTEXT"))) )))
  (setq col2 (vl-remove-if 'null (mapcar 'ssname (ssget '((0 . "TEXT,MTEXT"))) )))
  
  (ordena col1 col2)
  
  (setq l1 (car (vlax-get-property (vlax-invoke (vlax-get-acad-object) 'ActiveDocument 'ModelSpace) 'Items)))
  (setq l2 (cadr (vlax-get-property (vlax-invoke (vlax-get-acad-object) 'ActiveDocument 'ModelSpace) 'Items)))
  
(defun ordena (cj1 cj2 / e l n m c)
 (setq l1 nil l2 nil)
 (foreach cj (list cj1 cj2)
 (setq l (cons (vl-sort
 (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
 (setq c (cons (list (caddr (assoc 10 (entget e))) e) c))
 )
 '(lambda (a b) (> (car a) (car b)))
 )
 l
 )
 c nil n nil
 )
 )
 (setq l1 (car l) l2 (cadr l))
)

;; Defining the step by Y 
 ;;   (setq ent2a (ssname col2 0))
 ;;   (setq ent2b (ssname col2 1))
 ;;   (setq y1 (cadr (cdr (assoc 10 (entget ent2a)))))
 ;;   (setq y2 (cadr (cdr (assoc 10 (entget ent2b)))))
 ;;   (setq dy (- y2 y1))
  
  (setq i 0)
  (repeat (length l1)
    (setq ent1 (cadr (nth i l1)))
    (setq ent2 (cadr (nth i l2)))
    (setq txt1 (cdr (assoc 1 (entget ent1))))
    (setq txt2 (cdr (assoc 1 (entget ent2))))
    (setq n1 (atof txt1))
    (setq n2 (atof txt2))
    (if (and n1 n2)
      (progn
       
        (setq p3 (list (car basept) (car (nth i l2)) 0.0))
  
        (entmakex
          (list
            (cons 0 "TEXT")
            (cons 8 (cdr (assoc 8 (entget ent2))))
            (cons 10 p3)
            (cons 40 (cdr (assoc 40 (entget ent2))))
            (cons 1 (if (> (- n1 n2) 0)
                        (strcat "+" (rtos (- n1 n2) 2 3))
                        (rtos (- n1 n2) 2 3))
                 )
          )
        )
      )
    )
    (setq i (1+ i))
  )
  (princ)
)
Expand  

 

 

Only the changes I explained to you were necessary.

  • Thanks 1
Posted
  On 4/29/2025 at 7:57 AM, GLAVCVS said:

Only the changes I explained to you were necessary.

Expand  

Thanks for the corrections, but now there is confusion with the plus and minus signs.

plus or minus.png

Posted
  On 4/29/2025 at 7:43 AM, GLAVCVS said:

 

(defun c:Df2Column
       (/ col1 col2 n1 n2 p1 p2 p3 basept dy txt1 txt2 i ent1 ent2 l1 l2 ordena)
  (defun ordena (cj1 cj2 / e l n m c)
    (foreach cj (list cj1 cj2)
      (setq l (cons (vl-sort
		      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
	                (setq c (cons (list (caddr (assoc 10 (entget e))) e) c))
	            )
	            '(lambda (a b) (> (car a) (car b)))
	          )
		  l
	    )
	    c nil n nil
      )
    )
    (setq l1 (cadr l) l2 (car l))
  )
  (princ "\nSelect the texts of the first column: ")
  (setq col1 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col1)
    (progn (princ "\nThe objects of the first column are not selected."
	   )
	   (exit)
    )
  )
  (princ "\nSelect the texts of the second column: ")
  (setq col2 (ssget '((0 . "TEXT,MTEXT"))))
  (if (not col2)
    (progn (princ
	     "\nThe objects of the second column are not selected."
	   )
	   (exit)
    )
  )
  (if (/= (sslength col1) (sslength col2))
    (progn (princ
	     "\nThe number of objects in the columns does not match."
	   )
	   (exit)
    )
  )
  (ordena col1 col2)
  (princ "\nSpecify the insertion point of the third column: ")
  (setq basept (getpoint))
  ;; Defining the step by Y between the elements of the second column
;;;  (setq ent2a (ssname col2 0))
;;;  (setq ent2b (ssname col2 1))
;;;  (setq y1 (cadr (cdr (assoc 10 (entget ent2a)))))
;;;  (setq y2 (cadr (cdr (assoc 10 (entget ent2b)))))
;;;  (setq dy (- y2 y1))
  (setq i 0)
  (repeat (length l1);(sslength col1)
    (setq ent1 (cadr (nth i l1)));(ssname col1 i))
    (setq ent2 (cadr (nth i l2)));(ssname col2 i))
    (setq txt1 (cdr (assoc 1 (entget ent1))))
    (setq txt2 (cdr (assoc 1 (entget ent2))))
    (setq n1 (atof txt1))
    (setq n2 (atof txt2))
    (if	(and n1 n2)
      (progn
	(setq p3 (list (car basept) (car (nth i l2)) 0.0))  ;(+ (cadr basept) (* i dy)) 0.0))
	(entmakex (list
		    (cons 0 "TEXT")
		    (cons 8 (cdr (assoc 8 (entget ent2))))
		    (cons 10 p3)
		    (cons 40 (cdr (assoc 40 (entget ent2))))
		    (cons 1
			  (if (> (- n1 n2) 0)
			    (strcat "+" (rtos (- n1 n2) 2 3))
			    (rtos (- n1 n2) 2 3)
			  )
		    )
		  )
	)
      )
    )
    (setq i (1+ i))
  )
  (princ)
)

 

Expand  

 

Editado

 

Pruébalo de nuevo

  • Thanks 1
Posted

Why not use a table to do that?

Posted (edited)
  On 4/29/2025 at 10:17 AM, GLAVCVS said:

Editado

Pruébalo de nuevo

Expand  

gracias, ahora está bien, estudiaré los cambios)))

Edited by Nikon
  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...