LISP - change length of a rectangle

LISP - change length of a rectangle

Cudal
Contributor Contributor
645 Views
9 Replies
Message 1 of 10

LISP - change length of a rectangle

Cudal
Contributor
Contributor

Hi,

 

I have multiple blocks with rectangle of different length. the width is currently 4" and i want change it to 3.75. can someone create a LISP that will change the width of the rectangle to 3.75. it should move the top line 0.125" down and the bottom line 0.125" up. Thank you

 

Cudal_0-1738173481460.png

 

0 Likes
646 Views
9 Replies
Replies (9)
Message 2 of 10

pendean
Community Legend
Community Legend

Why not create a DYNAMIC BLOCK(s) to use that you can incrementally shrink or lengthen whenever you need it with a click or two?

0 Likes
Message 3 of 10

Cudal
Contributor
Contributor

the blocks are already existing. at least two hundred and I need to change them individually

0 Likes
Message 4 of 10

pendean
Community Legend
Community Legend

@Cudal wrote:

the blocks are already existing. at least two hundred and I need to change them individually


two hundred different blocks?

Or the one same block, 200 copies, and a very quick REFEDIT (or BEDIT) of one instance will fix them all just like that?

Message 5 of 10

paullimapa
Mentor
Mentor

Can you share this dwg?


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 6 of 10

komondormrex
Mentor
Mentor

@Cudal 

hey there,

check the following. will change every rectangle lw-polyline width in every block from 4 to 3.75 as per suggested.

 

(defun c:lessen_rect_block_width_4_025 (/ points coordinates segments width_seg mid_point)
 	(vlax-map-collection (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
 		'(lambda (block) (vlax-map-collection block
 							'(lambda (object) (if (and (= "AcDbPolyline" (vla-get-objectname object))
 													   (minusp (vlax-get object 'closed))
 													   (= 4 (vlax-curve-getendparam object))
 													   (not (setq points nil))
 													   (setq coordinates (vlax-get object 'coordinates)) 
 													   (not (while coordinates (setq points (append points (list (list (car coordinates) (cadr coordinates))))) (setq coordinates (cddr coordinates))))
 													   (setq segments (mapcar 'list points (append (cdr points) (list (car points)))))
 													   (equal (distance (nth 0 points) (nth 2 points)) (distance (nth 1 points) (nth 3 points)) 1e-6)
 													   (equal (apply 'distance (nth 0 segments)) (apply 'distance (nth 2 segments)) 1e-6)
 													   (equal (apply 'distance (nth 1 segments)) (apply 'distance (nth 3 segments)) 1e-6)
 													   (or (equal 4 (apply 'distance (nth (setq width_seg 0) segments)) 1e-6) (equal 4 (apply 'distance (nth (setq width_seg 1) segments)) 1e-6)) 
 												   )
 												   (vlax-put object 'coordinates
 														(apply 'append (apply 'append 
 																			   (mapcar '(lambda (segment) (mapcar '(lambda (point) (polar (setq mid_point (mapcar '* '(0.5 0.5) 
																			   																						  (mapcar '+ (car segment) 
																																									  			 (cadr segment)
																																									  )
																																						  )
																																		  ) 
 																			   													   		  (angle mid_point point) 
 																																   		  1.875
 																																   )
 																												   ) 
 																												   segment
 																										  )
 																						) 
 					 																	(list (nth width_seg segments) (nth (+ 2 width_seg) segments))
 																			   )
 																	   )
 														)
 												   )
 											   )
 							 )
 						)
 		)
	)
	(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)	
	(princ)
)

 

 

 

0 Likes
Message 7 of 10

marko_ribar
Advisor
Advisor

@komondormrex 

I and I suppose all others have difficulty viewing your posts as your formatting of codes always look far too to the right of code tags... Next time, please take some time to prettify codes as it may help both you and others that are looking at it...

Now I did it for you, but next time, please pay attention to what you post and how does it look like...

(defun c:lessen_rect_block_width_4_025 ( / points coordinates segments width_seg mid_point )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (vlax-map-collection (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    (function
      (lambda ( block )
        (vlax-map-collection block
          (function
            (lambda ( object )
              (if
                (and
                  (= "AcDbPolyline" (vla-get-objectname object))
                  (minusp (vlax-get object (quote closed)))
                  (= 4 (vlax-curve-getendparam object))
                  (not (setq points nil))
                  (setq coordinates (vlax-get object (quote coordinates))) 
                  (not
                    (while coordinates
                      (setq points (append points (list (list (car coordinates) (cadr coordinates)))))
                      (setq coordinates (cddr coordinates))
                    )
                  )
                  (setq segments (mapcar (function list) points (append (cdr points) (list (car points)))))
                  (equal (distance (nth 0 points) (nth 2 points)) (distance (nth 1 points) (nth 3 points)) 1e-6)
                  (equal (apply (function distance) (nth 0 segments)) (apply (function distance) (nth 2 segments)) 1e-6)
                  (equal (apply (function distance) (nth 1 segments)) (apply (function distance) (nth 3 segments)) 1e-6)
                  (or
                    (equal 4 (apply (function distance) (nth (setq width_seg 0) segments)) 1e-6)
                    (equal 4 (apply (function distance) (nth (setq width_seg 1) segments)) 1e-6)
                  )
                ) ;_ end and
                (vlax-put object (quote coordinates)
                  (apply (function append)
                    (apply (function append)
                      (mapcar
                        (function
                          (lambda ( segment )
                            (mapcar
                              (function
                                (lambda ( point )
                                  (polar (setq mid_point (mapcar (function *) (list 0.5 0.5) (mapcar (function +) (car segment) (cadr segment)))) (angle mid_point point) 1.875)
                                )
                              ) segment
                            )
                          )
                        ) (list (nth width_seg segments) (nth (+ 2 width_seg) segments))
                      )
                    )
                  )
                ) ;_ end then
              ) ;_end if
            )
          )
        ) ;_end vlax-map-collection
      )
    )
  ) ;_end vlax-map-collection
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)        
  (princ)
)
Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 8 of 10

komondormrex
Mentor
Mentor

yeah, i have been pointed to it by @Sea-Haven  back earlier, and i try it my best every other time, but still sh(

0 Likes
Message 9 of 10

Sea-Haven
Mentor
Mentor

This shows all the tabs that have been used.

SeaHaven_0-1738370539429.png

Same thing but replace the tabs with 2 spaces. The indenting is still clear but code does not disappear to the right.

SeaHaven_1-1738370615084.png

Which indenting method are you using ? Bricscad has a Beautify option which will put in tabs.

 

0 Likes
Message 10 of 10

komondormrex
Mentor
Mentor

@Sea-Haven 

it's custom tabs, in my case 4-length and spaces.

 

@marko_ribar 

just curious. why do you prefer function over '? there are people out there doing similar all the way.

0 Likes