Jump to content

Leaderboard

  1. mhupp

    mhupp

    Trusted Member


    • Points

      4

    • Posts

      2,183


  2. BIGAL

    BIGAL

    Trusted Member


    • Points

      3

    • Posts

      20,044


  3. tombu

    tombu

    Trusted Member


    • Points

      2

    • Posts

      1,912


  4. Steven P

    Steven P

    Trusted Member


    • Points

      2

    • Posts

      2,986


Popular Content

Showing content with the highest reputation on 04/01/2026 in all areas

  1. Yeah why not, look at date 1992, hopefully works removed some layer setting etc. 34 years ago. Dont think VL existed. Uses Lines etc. ;;;---------------------------------------------------------------------------; ;;; ;;; autodim3.LSP Version 1.0 ;; ;;; by Alan ;;; 1 April 1992 ;;; ;;; DESCRIPTION ;;; AUTOMATICALLY DIMENSIONS ; ;;;---------------------------------------------------------------------------; ; dimmensioning doesnt work if elev wrong ;(command "elev" hts "0") (SETVAR "ELEVATION" 0) (SETVAR "THICKNESS" 0) (defun mmserr (s) (if (/= s "Function cancelled") (princ (strcat "\nError: " s)) ) (setq S nil) (setvar "CMDECHO" cm) (setq *error* olderr) (princ) ) ;;;---------------------------------------------------------------------------; ;;; Main Program. ;;;---------------------------------------------------------------------------; (setq cm (getvar "cmdecho")) (setvar "cmdecho" 1) (setvar "dimdli" 0) (setq exlay (getvar "clayer")) (setq thick (getvar "thickness")) (setq elev (getvar "elevation")) (setq or_pt (list 0.0 0.0 0.0)) (command "osnap" "near") (setvar "thickness" 0) ;(command "elev" hts "0") ; set up dimension locations (setq ppt1 (ENTSEL "\npick first point to dimension :")) (setq tpp1 (entget (car ppt1) ) ) (setq pt1 (cdr (assoc 10 tpp1) ) ) (setq pt2 (cdr (assoc 11 tpp1) ) ) (setq hts (caddr pt1 )) (setvar "elevation" hts) (setq ang1 (angle pt1 pt2)) (setq npt1 (cadr ppt1)) (setq rad (distance pt1 npt1)) (setq ang2 (angle pt1 npt1)) (setq diffang (- ang1 ang2)) (setq dist (* (cos diffang) rad)) (setq apt1 (polar pt1 ang1 dist)) (setq pt5 (getpoint apt1 "\npick second point to dimension :")) ;(setq ss (ssget "c" apt1 pt5)) (setq ss (ssget "F" (list apt1 pt5))) (setvar "osmode" 0) (setq ang3 (angle pt5 apt1)) (setq dist (distance pt5 apt1)) (setq pt3 (getpoint pt5 "\npoint for dimension lines :")) (setq pt4 (getpoint pt5 "\nend point for dimension lines :")) (setq xyang (angle pt5 apt1)) (setq xy (distance apt1 pt5)) (setq pt6 (polar pt4 xyang xy)) (setq pt8 (inters pt1 pt2 pt4 pt6 nil)) (setq yoff (- (cadr pt8)(cadr apt1))) (setq xoff (- (car pt8)(car apt1))) (setq sss nil) (setq tempss nil) (setq dimpt1 nil) (setq dimpt2 nil) (while (setq en (ssname ss 0)) (setq dimpt1 (cdr (assoc 10 (entget en)))) (setq dimpt2 (cdr (assoc 11 (entget en)))) (setq newpt2 (inters pt5 apt1 dimpt1 dimpt2 nil)) (if (/= newpt2 nil) (progn (IF (/= NEWPT2 OLDPT) (progn (setq sss (cons newpt2 sss)) (SETQ OLDPT NEWPT2) ) ) ; CHECK TO SEE IF SAME AS PREV ) ) ; Delete each measured entity from set (ssdel en ss) ) (setq dimno (length sss)) ; loop starts at 0 (setq I 0) (setq maxx (- dimno 1)) ; start loop at dimno -2 (while (/= I maxx) ;(princ I) (setq J 1) (setq K (- dimno I) ) ; loop from 1 to dimno - I (while (/= J K) (setq j3 (LIST 1 1 1)) (setq j4 (LIST 2 2 2)) (setq j2 (nth J sss)) (setq L (- j 1)) (setq j1 (nth L sss)) ; (if (<= (CAR j2) (CAR j1)) (if (<= (distance or_pt j2) (distance or_pt j1)) (progn ; (princ "sorting ") (setq temp j2) (setq temp2 j1) (setq sss (subst j3 j2 sss)) (setq sss (subst j4 j1 sss)) (setq sss (subst J2 j4 sss)) (setq sss (subst J1 j3 sss)) ) ) (setq j (1+ j)) ) (setq i (+ I 1)) ) (PRINC "\nNow Dimensioning ") ;now plot dimmesions ; now dimension draw first to then loop for rest (setq d1 (nth 0 sss)) (setq d4 (list (+ (car d1) xoff)(+ (cadr d1) yoff))) (setq d2 (nth 1 sss)) (setq d5 (list (+ (car d2) xoff)(+ (cadr d2) yoff))) (PRINC "1") (command "DIM" "aligned" d4 d5 pt3 "") (setq x 2) (while (/= x dimno) (setq d3 (nth x sss)) (setq d6 (list (+ (car d3) xoff)(+ (cadr d3) yoff))) (PRINC "2") ; (command "diM" "continue" d6 "") (command "continue" d6 "") (setq x (+ x 1)) ) (PRINC "3") (command "exit") (setvar "CMDECHO" cm) (setvar "clayer" exlay) (setvar "elevation" elev) (setvar "thickness" thick) (setq ss nil) (princ)
    3 points
  2. Template drawing are the key to making AutoCAD simple. I always used Lee Mac's Steal from Drawing lisp to add Blocks, Layers, Linetypes, Dimension Styles, Text Styles, Table Styles, MLeader Styles, MLine Styles, Layouts, Page Setups, User Coordinate Systems, Named Groups, Views, Layer States, Scales, Materials, Named Viewports, Drawing Properties and Custom Properties All you need is to manage a template file with everything you need and you can add any and all you want to the current drawing with a single macro. Thanks Lee!
    2 points
  3. Here’s a sample of the kind of drawing I’m working with. It has dense geometry with small gaps and overlapping elements, and in cases like this, standard boundary methods don’t always produce consistent results. This is the type of scenario I’ve been trying to handle more reliably. I tried this on one of my actual project drawings. The image shows the input geometry and the output generated using the suggested approach (blue lines indicate the generated boundaries). It works quite well in simpler cases, but for this type of geometry I’m still seeing partial or inconsistent boundaries being created — it’s not forming a single clean outer boundary for the full shape. This is the kind of scenario I’ve been struggling with, especially where there are small gaps or more complex connections.
    1 point
  4. It's taken you 6 years to realise I cheat!! Good point, add (vl-load-com) in just before or after the (defun c ... line (edited above)
    1 point
  5. I updated something that makes multiple boundaries but cant find the post right now. doesn't work with gaps so idk if its something you could use. lee mac has an outline but also don't think it works with gaps. https://lee-mac.com/outlineobjects.html
    1 point
  6. If @Steven P is going to cheat an use Lee Mac Functions! might want to add (vl-load-com) to avoid errors if they don't have it loaded since it using vlax fuctions.
    1 point
  7. A slight variation on MHUPPS (vl-load-com) (defun c:ADIM (/ pt1 pt2 MyLine MySS acount MyIntersect MyDistance MyDistances pta ptb) (defun LM:intersections ( ob1 ob2 mod / lst rtn ) ;; See Lee Mac website. Get intersection list (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) (command "line" (setq pt1 (getpoint)) pause "") ; Draw reference line. Mod to polyline possible (setq MyLine (entlast)) ; Reference line entity name (setq pt2 (getvar 'lastpoint)) ; pt2 of reference line (setq MySS (ssget "_f" (list pt1 pt2) '( (-4 . "<NOT")(0 . "*DIM*") (-4 . "NOT>") ;Not Dims (-4 . "<NOT")(0 . "*TEXT*")(-4 . "NOT>") ;Not Text ))) ; Selection set crossing reference line (fence). Add filters (setq acount 0) ; a counter (while (< acount (sslength MySS)) ; Loop through selection set (if (setq MyIntersect (LM:intersections (vlax-ename->vla-object MyLine)(vlax-ename->vla-object (ssname MySS acount)) acextendnone )) ; get the intersection points, reference line, selection set items (progn (foreach n MyIntersect (setq MyDistance (distance pt1 n)) ; get the distance SS item, start reference line (setq MyDistances (cons (cons MyDistance (list n)) MyDistances)) ;; add the intersection & point to a list ) ; end foreach ) ; end progn ) ; end if intersections (setq acount (+ acount 1)) ; increase counter ) ; end while ; end loop (command "erase" MyLine "") ; erase reference line (setq MyDistances (vl-sort MyDistances (function (lambda (pta ptb) (< (car pta)(car ptB) ))) )) ; sort by distance (setq acount 0) (while (< (+ acount 1) (length MyDistances)) (setq p1 (car (cdr (nth acount MyDistances)))) (setq p2 (car (cdr (nth (+ acount 1) MyDistances)))) (setq mid (mapcar '/ (mapcar '+ p1 p2) '(2 2 2))) ; ripped of MHUPP (setq p3 (mapcar '+ mid '(0.0 2.0 0.0))) ;adj 2.0 for offset. ; ripped of MUPP (command "_.DIMLINEAR" p1 p2 p3) ; Ripped of MHUPP (setq acount (+ acount 1)) ) ; end while (princ) ) Edit: Corrected for polylines crossing reference line more than once
    1 point
  8. Here is something simple I threw together a while ago. Not everything you want, but should help. I started a more extreme version with more options back when people were posting they couldn't get TotalBoundary and SuperBoundary any longer. I'll try to get back on it this week, in the mean time, if you could post a drawing with some before and after it would help. I have no idea what all TotalBoundary and SuperBoundary does, it may help to explain exactly how you need to select and exactly what should be a boundary in your drawing it might might it easier. Hopefully a better LISPer will jump in. ;;; Select objects that define outlines. Works on LINE/ARC/CIRCLE/SPLINE/LWPOLYLINE. ;;; ;;; https://www.cadtutor.net/forum/topic/99063-need-a-tool-for-creating-2d-outlines-for-complex-2d-drawings/#findComment-678789 ;;; ;;; By SLW210 (a.k.a. Steve Wilson) ;;; ;;; MakeOut.lsp (defun c:MakeOut (/ ss i ent lst pts plines regions pp) (vl-load-com) (if (setq ss (ssget '((0 . "LINE,ARC,CIRCLE,SPLINE,LWPOLYLINE")))) (progn (setq i 0) (while (< i (sslength ss)) (setq ent (ssname ss i)) (setq i (1+ i)) ) (command "_.-boundary" ss "") (command "_.pedit" ss "" "J" "" "Y") (setq i 0) (while (< i (sslength ss)) (setq ent (ssname ss i)) (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (progn (command "_.pedit" ent "" "S" "0.01" "") (command "_.pedit" ent "" "C" "") ) ) (setq i (1+ i)) ) (princ "\nOutline created.") ) (princ "\nNo valid entities selected.") ) (princ) )
    1 point
  9. A lot shorter then i thought. will only work on horizontal polyline. adj p3 list to affect the offset. ;;----------------------------------------------------------------------;; ;; Poly DIM acts like QDIM but allows user to select horizontal points. ;; https://www.cadtutor.net/forum/topic/99059-auto-dimension-lisp/ (defun c:PLDIM (/ ent pts p1 p2 p3 ang) (vl-load-com) (command "_.pline") (while (= 1 (getvar "cmdactive")) (command pause) ) (setq ent (entlast)) (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (while (cadr pts) (setq p1 (car pts) p2 (cadr pts) mid (mapcar '/ (mapcar '+ p1 p2) '(2 2 2)) p3 (mapcar '+ mid '(0.0 2.0 0.0)) ;adj 2.0 for offset. ) (command "_.DIMLINEAR" p1 p2 p3) (setq pts (cdr pts)) ) (entdel ent) (princ) )
    1 point
  10. Drawing the line would also pick up 4 lines across the block. would maybe have to do a fence ssget. and if block draw a bounding box to pick up lines but even then could be inaccurate if not a square.
    1 point
×
×
  • Create New...