Jump to content

Compare 2 multiline attributes in same block, return number of lines from larger one

RubberDinero

By RubberDinero
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

RubberDinero Enthusiast

RubberDinero

Posted
Posted (edited)

I'm trying to create a lisp that lines up multiple blocks in a legend. With one click it will space out the entire legend evenly.

 

The legend blocks contains a multiline attribute on the left, I believe it's attribute 2 and the one on the right is attribute 3. 

 

Sometimes the left one has more lines, sometimes the right. sometimes they are both the same.

 

What would be the best way for a lisp to read both attributes and returning the max number of lines found? if both the same return one value. 

 

Thanks ahead of time!

Edited by RubberDinero
  • RubberDinero changed the title to Compare 2 multiline attributes in same block, return number of lines from larger one
devitg Experienced

devitg

Posted
Posted
5 hours ago, RubberDinero said:

I'm trying to create a lisp that lines up multiple blocks in a legend. With one click it will space out the entire legend evenly.

 

The legend blocks contains a multiline attribute on the left, I believe it's attribute 2 and the one on the right is attribute 3. 

 

Sometimes the left one has more lines, sometimes the right. sometimes they are both the same.

 

What would be the best way for a lisp to read both attributes and returning the max number of lines found? if both the same return one value. 

 

Thanks ahead of time!

@RubberDinero   Please upload your sample dgw

RubberDinero Enthusiast

RubberDinero

Posted
  • Author
Posted
1 hour ago, devitg said:

@RubberDinero   Please upload your sample dgw

This is a mockup file of the one I currently work with.

 

A program populates each block depending on buy or sells added to an addon program. Then there is a create BOM button that drops "these" in with really crazy spacing and I have to move them up to make it presentable. Sometimes a job consists of hundreds of these so you can just imagine how time consuming this is and the benefit of a lisp that can stack these .

 

On a previous post,  https://www.cadtutor.net/forum/topic/76133-move-blocks-individually-in-y-plan/#comment-601479,  I was able to make a lisp where I cross select all items and then manually click one by one to put them into place. This greatly improved this process, but now I'm thinking, what if I avoid all but one click and have the subsequent items place themselves down based on the number of rows that the multiline attribute of the previous block has the most.

 

in the file

SAMPLE.dwg

BIGAL Grand Master

BIGAL

Posted
Posted

If I understand correctly use bounding box of a block to work out its size, make a list of block and box then just rearrange them.

 

image.png.b68484487890030962e5a084ab363b2a.png

 

Say sort on lower left point for order. Thinking about it.

RubberDinero Enthusiast

RubberDinero

Posted
  • Author
Posted (edited)
1 hour ago, BIGAL said:

If I understand correctly use bounding box of a block to work out its size, make a list of block and box then just rearrange them.

 

image.png.b68484487890030962e5a084ab363b2a.png

 

Say sort on lower left point for order. Thinking about it.

I ran into this by total accident earlier today, been working on getting it to work for the past few hours. 

Finally I did!

 

I know it's not pretty, and I'm sure I can delete a bunch of lines that are worthless, but I dare not touch something that is working perfectly!

 

Added a condition to check if xmatch is equal to X+1, this will make sure that I have to click somewhere for the very first item. 

At the very bottom I setq point1 of the bounding box (I found this online so I left point2 just because it works) 

    (setq DScale (getvar "dimscale"))
    (setq s (ssget '((0 . "insert"))))
    (setq xmatch (sslength s))
   (repeat (setq x (sslength s))
    (foreach b (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s (setq x (- x 1))))))
  (or (setq k (getenv "AlignBlocks")) (setq k "X"))
  (if (and (not (initget "X Y Z"))
	   (setq k (cond ("Y")
			 (k)
		   )
	   )
	(cond
	 ((= (+ x 1) xmatch)
	   (setq p (getpoint "\Pick an alignment point: "))
	)
	 ((/= (+ x 1) xmatch)
	   (setq p point1)
))
      )
    (progn
      (setenv "AlignBlocks" k)
      (setq i (vl-position k '("X" "Y" "Z")))
      (setq a (- (nth i p) (* 0.2 DScale)))
      
	(vlax-invoke b 'move (setq p (vlax-get b 'insertionpoint)) (subst a (nth i p) p))
      
    )
  )


  (setq obj b)
  (if obj
    (progn
      (vla-getboundingbox obj 'point1 'point2)
      (setq point1 (vlax-safearray->list point1))
      (setq point2 (vlax-safearray->list point2))
      (setq point1 (trans (list (car point1) (cadr point1) 0) 0 1))
      (setq point2 (trans (list (car point2) (cadr point2) 0) 0 1))
    )
  )

))

 

I wish I could create these from scratch instead of Frankensteining code together, but LISP is so confusing to me. I can write Python (like a well versed newbie), but I've been trying LISP for decades and it just doesn't make sense.

Edited by RubberDinero
BIGAL Grand Master

BIGAL

Posted
Posted

My attempt

  

; https://www.cadtutor.net/forum/topic/77078-compare-2-multiline-attributes-in-same-block-return-number-of-lines-from-larger-one/

(defun C:wow ( / d1 d2 ent ename inspoint obj lst pt1 pt2 dist gap oldsnap)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0))
(setq gap (getdist "\nEnter the gap ")) ; 1.7 ?
(setq ss (ssget '((0 . "INSERT"))))

(setq lst '())
(repeat (setq x (sslength ss))
  (setq ent (ssname ss (setq x (- x 1))))
  (setq ename (cdr (assoc -1 (entget ent))))
  (setq inspoint (cdr (assoc 10 (entget ent))))
  (setq obj (vlax-ename->vla-object ent))
  (vla-GetBoundingBox obj 'minpoint 'maxpoint)
  (setq pointmin (vlax-safearray->list minpoint))
  (setq pointmax (vlax-safearray->list maxpoint))
  (setq d1 (- (cadr inspoint) (cadr pointmin)))
  (setq d2 (- (cadr pointmax) (cadr inspoint)))
  (setq lst (cons (list (car inspoint)(cadr inspoint) ename d1 d2) lst))
)
(setq lst (vl-sort lst (function (lambda (a b) (> (cadr a)) (cadr b)))))
(setq lst (reverse lst))

(setq entg (entget (nth 2 (nth 0 lst))))
(setq pt1 (cdr (assoc 10 entg)))
(setq pt2 (mapcar '+ pt1 (list 0.0 (- (+ (nth 3 (nth 0 lst)) gap)) 0.0)))
(setq x 0)

(repeat (- (length lst) 1)
  (setq ent (nth 2 (nth (setq x (1+ x)) lst)))
  (setq entg (entget ent))
  (setq pt1 (cdr (assoc 10 entg)))
  (command "move" ent "" pt1 pt2)
  (setq dist (- (+ (nth 3 (nth x lst)) 1.7 (nth 4 (nth (1+ x) lst)))))
(setq pt2 (mapcar '+ pt2 (list 0.0 dist 0.0)))
)

(setvar 'osmode oldsnap)
(princ)
)
(c:wow)

image.png.ca340b4711498ef9435d62282869d817.png

RubberDinero Enthusiast

RubberDinero

Posted
  • Author
Posted

(setq lst '())
 

what does the apostrophe do here? I see them everywhere and I can’t figure out what role they play. 

RubberDinero Enthusiast

RubberDinero

Posted
  • Author
Posted
43 minutes ago, BIGAL said:

 

My attempt

 

I feel like you made it your goal to use the most complicated code so I couldn’t follow. :D

I’m way lost with that code!

RubberDinero Enthusiast

RubberDinero

Posted
  • Author
Posted
58 minutes ago, BIGAL said:

My attempt

 

I decided to brave it out and start removing lines I don't need.

 

The part with the AlignBlocks I couldn't figure out how to get it to Y plane only, I had to add all 3 planes and pick Y through variables assignments as if someone was typing.

 

This is part of a much bigger code, but here is a working code stripped to just the alignment part. 

(defun c:test (/ DScale s xmatch x b k i a p obj point1 point2 p2 i br)
(vl-load-com)
(setq DScale (getvar "dimscale"))
(setq s (ssget '((0 . "insert"))))
(setq xmatch (sslength s))
   (repeat (setq x (sslength s))
    (foreach b (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s (setq x (- x 1))))))
     (or (setq k (getenv "AlignBlocks")) (setq k "X"))
      (if (and (not (initget "X Y Z"))
       (setq k (cond ("Y")
     	 (k)
       )
      )
	 (cond
	  ((= (+ x 1) xmatch)
	   (setq p (getpoint "\Pick an alignment point: "))
	  )
	  ((/= (+ x 1) xmatch)
	   (setq p point1)
      )
     )
    )
    (progn
      (setenv "AlignBlocks" k)
      (setq i (vl-position k '("X" "Y" "Z")))
      (setq a (- (nth i p) (* 0.2 DScale)))
      (vlax-invoke b 'move (setq p (vlax-get b 'insertionpoint)) (subst a (nth i p) p))
      
    )
  )
  (setq obj b)
   (if obj
    (progn
      (vla-getboundingbox obj 'point1 'point2)
      (setq point1 (vlax-safearray->list point1))
      (setq point1 (trans (list (car point1) (cadr point1) 0) 0 1))
    )
   )
  )
)
  (princ)
)
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

(setq lst '()) this is one way to create a blank list or to delete an existing list, another is to use (append,  others will comment here about creating lists or resetting back to blank, I just reset in case already exists as I use LST all the time.

 

Did my code work for Y direction ? Yes can add X direction similar process just split code into 2 extra defuns a X & Y direction.

 

Complicated code No its not it uses a bounding box to find the extents of block, then works out the distance from the insert point to the top and bottom of the box so can work out where to move box to.

 

If you think that is complicated then latest code for a client is 1250 lines of code and not finished yet. 29 defuns.

 

Edited by BIGAL
RubberDinero Enthusiast

RubberDinero

Posted
  • Author
Posted

To be honest, I didn’t even try your code. The one I Frankensteined together works and I understand the flow. I’ve been trying to make sense of yours, hopefully I get to understand it by going over it. 
 

what I meant with my question above is, what does the ‘ mark do? I see it before ‘osmode ‘+ and ‘((0. “insert”))

 

 what its purpose?

Steven P Grand Master

Steven P

Posted
Posted

a ' is shorthand for list, sort of...

 

LISP is based around lists and these can be created using the function 

(list -list items-)

or

'( -list items- )

 

(and a couple of other ways). The main difference being (list ) evaluates what is in the list, so you could have (list (+ 2 2 )), where '( ) takes the list exactly as it is written

 

For example you could use '((0. "INSERT")) or (list (0. "INSERT"))

 

  • Like 1
RubberDinero Enthusiast

RubberDinero

Posted
  • Author
Posted
2 hours ago, Steven P said:

a ' is shorthand for list, sort of...

 

LISP is based around lists and these can be created using the function 

(list -list items-)

or

'( -list items- )

 

(and a couple of other ways). The main difference being (list ) evaluates what is in the list, so you could have (list (+ 2 2 )), where '( ) takes the list exactly as it is written

 

For example you could use '((0. "INSERT")) or (list (0. "INSERT"))

 

Okay, that makes sense.

devitg Experienced

devitg

Posted
Posted
16 minutes ago, RubberDinero said:

Okay, that makes sense.

@RubberDinero,  beside it can make LIST , the main meaning is QUOTE , o CITAR en español , 

 

  

(setq osmode (getvar 'osmode)) ; get the osmode variable value
;then 

(setqvar 'osmode 1 ) ; setq syatem variable osmode to 1 , or END point 

;When doing a LIST you can not make it by ' if the lisp hold a variable 
'( 0 . "insert") or '( 8 . "as-build")
'But if the layername becomes from a varible laki

(setq layername "as-build" ) ; here layername is a variable that hold the string "as-build"

;You have to use (cons 8 layername)

 

  • 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.

×
 Share
Go to topic listing
×
×
  • Create New...