Auto dimension lisp

[mhy3sx]

I am searching for a lisp code to recognizes and dimensions LINE or ARC objects located in the Wall-2D layers and blocks in the CLOSETS-2D layer. like the image

The dimension layer is DIM

The idea is  to pick 2  points like a line and automatic insert the dmensions. I use ZWCAD.

 

Thanks

Edited Sunday at 03:04 PM by mhy3sx

[BIGAL]

Yes I have something done like 40 years ago, but did you try QDIM is that in ZWCAD ?

[mhy3sx]

Hi BIGAL, I have try QDIM but  working as

 

Quote

Select geometry to dimension :

 

The QDIM don't dimension the block (look the image)

 

I want to draw a line by specifying two points, to indicate where dimensions should be placed.

This line should only appear on the layers named WALLS-2D and CLOSETS-2D.

The WALLS-2D layer contains both lines and polylines, while the CLOSETS-2D layer contains blocks.

 

Thanks

Edited Monday at 09:15 AM by mhy3sx

[mhupp]

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.

[mhy3sx]

I find a solution. I craete a polyline ,then auto dimension the polyline and delete the polyline. Beter tahn nothing

 

Thanks

[BIGAL]

As suggested by @mhupp if you use a fence option you can find objects and get their intersection points do a sort based on start point. For the block would do a Bounding Box around the block. and get the left and right edge points, then do the dims. Yes just need a line from left to right for "intersectwith". You can set the correct layers when doing the SSGET "F".

 

If get time will dummy up your dwg and see what the code I have does.

Edited Monday at 10:42 PM by BIGAL

[mhupp]

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)
)

 

 

 

 

Edited 15 hours ago by mhupp

[Steven P]

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

 

Edited 11 hours ago by Steven P

[mhupp]

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.

 

[Steven P]

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)

[BIGAL]

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)