Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/10/2024 in all areas

  1. Adaptation from some code 4 years ago (defun c:foo (/ a d l r s sp) ;; RJP » 2024-05-09 ;; Adapted from https://www.cadtutor.net/forum/topic/69706-routine-for-buffer/#comment-561009 (setq l "BubbleLicious") (setq d 45) (cond ((setq s (ssget '((0 . "INSERT")))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq r (cons (entmakex (list '(0 . "CIRCLE") (assoc 10 (entget e)) (cons 40 d))) r)) ) (setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (car r)))))) (setq s (vlax-invoke sp 'addregion (mapcar 'vlax-ename->vla-object r))) (mapcar 'entdel r) (setq a (car s)) (entmod (append (entget (vlax-vla-object->ename a)) (list (cons 8 l)))) (foreach o (cdr s) (vla-boolean a acunion o)) ) ) (princ) )
    2 points
  2. Al's Steel Mill is USA sizes. This one has the latest updates for the shapes. Updated AISC Shapes for STL.LSP - AutoLISP, Visual LISP & DCL - AutoCAD Forums (cadtutor.net)
    1 point
  3. link is just example, not like this? (defun c:foo ( / acdoc cloud_offset_size ss ssl index ss2 ent obj bbox lll url c_radius c_center c_ent ss3 ss4 ss5 ) (vla-startundomark (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))) (setvar 'cmdecho 0) (setq cloud_offset_size 70) ;edit this value (setq ss (ssget '((0 . "INSERT")))) (setq ssl (sslength ss)) (setq index 0) (setq ss2 (ssadd)) (repeat ssl (setq ent (ssname ss index)) (setq obj (vlax-ename->vla-object ent)) (setq bbox (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) (setq url (vlax-safearray->list ur)) (setq c_radius (/ (distance lll url) 2)) (setq c_center (polar lll (angle lll url) c_radius)) (setq c_ent (entmakex (list (cons 0 "CIRCLE") (cons 10 c_center) (cons 40 (+ cloud_offset_size c_radius))))) (command "region" c_ent "") (ssadd (entlast) ss2) (setq index (+ index 1)) ) (command "union" ss2 "") (setvar 'cmdecho 1) (vla-endundomark acdoc) (princ) ) I used QSELECT because I didn't have time, but it is possible to add routines for exploding a region or joining with a polyline.
    1 point
  4. There is a few draw steel section programs out there if you google may start with "Wiseys steel shapes" it has sections from all over the world. WiseysSteelShapes.zip
    1 point
  5. Need some more info like what size is revcloud spacing and layer to put it on. A pline with arcs on end is a bit of a challenge. Give this a try ; https://www.cadtutor.net/forum/topic/84863-revcloud-around-polyline-object-on-both-sides-but-retain-polyline/ ; By Alan H April 2024 (defun doline ( / obj2 obj3 p1 p2 p3 p4 start end ang) (vla-offset obj dist) (setq ent2 (entlast)) (setq obj2 (vlax-ename->vla-object ent2 )) (setq start (vlax-curve-getstartPoint obj2)) (setq end (vlax-curve-getEndPoint obj2)) (setq ang (angle start end)) (setq p1 (polar start (+ pi ang) dist)) (setq p2 (polar end ang dist)) (vlax-put obj2 'startpoint p1) (vlax-put obj2 'endpoint p2) (vla-offset obj (- dist)) (setq ent3 (entlast)) (setq obj3 (vlax-ename->vla-object ent3)) (setq start (vlax-curve-getstartPoint obj3)) (setq end (vlax-curve-getEndPoint obj3)) (setq ang (angle start end)) (setq p3 (polar start (+ pi ang) dist)) (setq p4 (polar end ang dist)) (vlax-put obj3 'startpoint p3) (vlax-put obj3 'endpoint p4) (command "line" p1 p3 "") (setq ent4 (entlast)) (command "line" p2 p4 "") (setq ent5 (entlast)) (command "pedit" ent2 "Y" "j" ent3 ent4 ent5 "" "") (princ) ) (defun dopoly ( / ) (setq obj (vlax-ename->vla-object ent)) (cond ((= (vlax-get obj 'closed) -1)(dopoly2)) ((= (vlax-get obj 'closed) 0)(dopoly3)) ) (princ) ) (defun dopoly2 ( / a1 a2 ) (vla-offset obj dist) (setq obj2 (vlax-ename->vla-object (entlast))) (setq a1 (vlax-get obj 'area)) (setq a2 (vlax-get obj2 'area)) (if (> a2 a1) (princ) (progn (vla-delete obj2) (vla-offset obj (- dist)) (command "pedit" (entlast) "R" "") ) ) (princ) ) (defun dopoly3 ( / lst p1 p2 p3 p4 ent2 ent3 ent4) (setq lst '()) (vla-offset obj dist) (setq ent2 (entlast)) (setq co-ord1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent2)))) (setq p1 (car co-ord1)) (setq p2 (cadr co-ord1)) (setq p4 (nth (- (length co-ord1) 1) co-ord1)) (setq p3 (nth (- (length co-ord1) 2) co-ord1)) (setq p1 (polar p1 (angle p2 p1) dist)) (setq p4 (polar p4 (angle p3 p4) dist)) (setq lst (cons (car p1) lst)) (setq lst (cons (cadr p1) lst)) (setq x 0) (repeat (- (length co-ord1) 2) (setq lst (cons (car (nth (setq x (1+ x)) co-ord1)) lst)) (setq lst (cons (cadr (nth x co-ord1)) lst)) ) (setq lst (cons (car p4) lst)) (setq lst (cons (cadr p4) lst)) (setq lst (reverse lst)) (vlax-put (vlax-ename->vla-object ent2) 'coordinates lst) (setq lst '()) (vla-offset obj (- dist)) (setq ent3 (entlast)) (setq co-ord2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent3)))) (setq p5 (car co-ord2) p6 (cadr co-ord2)) (setq p8 (nth (- (length co-ord2) 1) co-ord2)) (setq p7 (nth (- (length co-ord2) 2) co-ord2)) (setq p5 (polar p5 (angle p6 p5) dist)) (setq p8 (polar p8 (angle p7 p8) dist)) (setq lst (cons (car p5) lst)) (setq lst (cons (cadr p5) lst)) (setq x 0) (repeat (- (length co-ord2) 2) (setq lst (cons (car (nth (setq x (1+ x)) co-ord2)) lst)) (setq lst (cons (cadr (nth x co-ord2)) lst)) ) (setq lst (cons (car p8) lst)) (setq lst (cons (cadr p8) lst)) (setq lst (reverse lst)) (vlax-put (vlax-ename->vla-object ent3) 'coordinates lst) (command "line" p5 p1 "") (setq ent4 (entlast)) (command "line" p8 p4 "") (setq ent5 (entlast)) (command "pedit" ent2 "J" ent3 ent4 ent5 "" "") (princ) ) (defun c:wow ( / ent ent2 ent3 ent4 dist obj objtype) (setq ent (car (entsel "\nSelect a object "))) (setq obj (vlax-ename->vla-object ent)) (setq dist (getreal "\nEnter offset ")) (setq objtype (vlax-get obj 'objectname)) (cond ((= objtype "AcDbline")(doline)) ((= objtype "AcDbPolyline")(dopoly)) ) (command "revcloud" "A" 10 10 "E" (entlast) "n") (princ) ) (c:wow)
    1 point
  6. That lisp has my name in it, written for a particular situation, I would do slightly different now just get all blocks, make table and ask do you want Excel as well. Table needs cleaning up. Make header row bigger, change columns sizes to reflect values use 2 line text. eg No Of Bars Not sure why there all background mtext box, hard to read. Not sure why I used hit test when insertrows works better. Question where is "No of Bars" coming from ?
    1 point
  7. Another example (defun wow ( / obj atts att) (setq obj (vlax-ename->vla-object (car (entsel "\nSelect a block object ")))) (setq atts (vlax-invoke obj 'Getattributes)) (foreach att atts (princ (strcat "\nTag name " (vlax-get att 'Tagstring) " Att value " (vlax-get att 'Textstring) )) ) (princ) ) (wow) If you know a tag string you can check for a single attribute.
    1 point
×
×
  • Create New...