Lt Dan's l 发表于 2022-7-6 11:09:23

Lisp, Blocks & Box

I'm looking for a simple lisp that puts a block (name: corner) in all corners of a rectangle. it needs to turn with the box. the block is at 0º in the upper left hand corner. I know there's something out there like this but I couldn't find it.

Lt Dan's l 发表于 2022-7-6 11:16:30

I meant to upload a pic

alanjt 发表于 2022-7-6 11:21:39

Sounds like someone needs to learn LISP. :wink:

Lee Mac 发表于 2022-7-6 11:26:59

In the language of pseudocode...
 


[*]Prompt for Block Selection


[*]Prompt for box Selection (check object validity)


[*]Get Vertices of Box (dxf group code 10 - multiple entries)


[*]Sort Points by x then y, or vice versa and insert block with correct rotation at each point. (Alternatively, perhaps get First Derivative of curve near vertex to determine rotation.

alanjt 发表于 2022-7-6 11:29:51

Don't forget to check for direction of polygon.
 

Lee Mac 发表于 2022-7-6 11:36:32

Haha nice one Alan
 
You're such a tease lol

alanjt 发表于 2022-7-6 11:37:40

 
HaHa, thanks.
I was looking for Gile's Clockwise routine, but then I remembered I could just use the formula to check the area of a triangle (given 3 points), so I just used that.

Lt Dan's l 发表于 2022-7-6 11:44:31

It goes along with the the code you helped me with the first time. When I create this I want the corners to fill in. I'd like them to come in automatically but if I have to select them than that's fine
 

(defun c:COMP1 (/ blockname p1 p2 d d1) ;; modified by Reid b. (vl-load-com) (setq blockname "1compartment") (if (and (or (tblsearch "block" blockname)            (findfile (strcat blockname ".dwg"))            (alert (strcat blockname " cannot be found!"))          )          (setq p1 (getpoint "\nSpecify block insertion point: "))          (setq d (getdist p1 "\nSpecify box width: "))          (setq d1 (getdist p1 "\nSpecify box length: "))   )   ((lambda (block)      (foreach x (vlax-invoke block 'GetDynamicBlockProperties)      (cond ((eq (vla-get-propertyname x) "DISTANCE")               (vla-put-value               x               (cond                   ((>= 0.125 (/ d 0.125)) 0.125)                   ((< 0.125 (setq num (/ d 0.125))) (* 0.125 (fix num)))                   (0.125)               )               )            )            ((eq (vla-get-propertyname x) "DISTANCE1")               (vla-put-value               x               (cond                   ((>= 0.125 (/ d1 0.125)) 0.125)                   ((< 0.125 (setq num (/ d1 0.125))) (* 0.125 (fix num)))                   (0.125)               )               )            )      )      )      (vl-catch-all-apply (function (lambda () (vla-explode block) (vla-delete block))))    )   (vla-insertblock       (if         (or (eq acmodelspace               (vla-get-activespace                   (cond (*AcadDoc*)                         ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))                   )               )             )             (eq :vlax-true (vla-get-mspace *AcadDoc*))         )          (vla-get-modelspace *AcadDoc*)          (vla-get-paperspace *AcadDoc*)       )       (vlax-3d-point (trans p1 1 0))       blockname       1.       1.       1.       0.   )   ) ) (princ))
 
http://www.cadtutor.net/forum/showthread.php?t=47619

alanjt 发表于 2022-7-6 11:48:31

It's really nice of you to completely remove my name from my code.

Lee Mac 发表于 2022-7-6 11:54:52

I can't believe that...
页: [1] 2
查看完整版本: Lisp, Blocks & Box