Automatic Dimensioning for Blocks in Autocad

[Ahmed_Hisham]

 

Good Day,

I want the attached code to run as QDIM in Autocad , My issue in my code that I choose the location of the dimension line after that the dimension appears. I want to see all the dimensions afterwards choose the location like in QDIM command.

Thanks

(vl-load-com)

(defun C:FH ( / *error* doc oVAR ss i pts ptsx ptsy d d0 filter )

   (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (foreach e oVAR (setvar (car e) (cdr e)))
    (vla-endundomark doc)
    (princ))

  ;------------------------------------------------------------------------------------------------------
  
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (foreach e '(CMDECHO ORTHOMODE)
    (setq oVAR (cons (cons e (getvar e)) oVAR)))

  (setvar 'CMDECHO 	0)
  (setvar 'ORTHOMODE 	0)

 

  
  
  
  (if (and (princ "\nNeed blocks, ")
               (setq ss (ssget (list '(0 . "INSERT"))))
	   (< 1 (setq i (sslength ss)))
	   (while (not (minusp (setq i (1- i))))
	     (setq pts (cons (cdr (assoc 10 (entget (ssname ss i)))) pts)))
	   (setq ptsx (vl-sort pts '(lambda (p q) (< (car  p) (car  q)))))
	   (setq ptsy (vl-sort pts '(lambda (p q) (< (cadr p) (cadr q)))))

	   (setq d (abs (/ (- (car  (last ptsx)) (caar  ptsx))      ;xmax-xmin
			   (if (zerop (setq d0 (- (cadr (last ptsy)) (cadar ptsy)))) ;ymax-ymin
			     0.001
			     d0))))

	   
	   (setq pt (getpoint "\nSpecify dimension line location: "))

	   (or *DimTypeBDA
	       (setq *DimTypeBDA "Aligned"))
	   (not (initget "Horizontal Vertical Aligned"))
	   (setq *DimTypeBDA (cond ((getkword (strcat "\nType of dimension ["
						      (cond ((> d 1000.) (if (= *DimTypeBDA "Vertical") (setq *DimTypeBDA "Horizontal")) "Horizontal")
							    ((< d 0.001) (if (= *DimTypeBDA "Horizontal") (setq *DimTypeBDA "Vertical")) "Vertical")
							    ("Horizontal/Vertical"))
						      "/Aligned] <" *DimTypeBDA ">: ")))
				   (*DimTypeBDA)))

	   (setq pts (if (or (= *DimTypeBDA "Horizontal")
			     (and (= *DimTypeBDA "Aligned")
				  (> (- (car (last ptsx))  (caar ptsx))
				     (- (cadr (last ptsy)) (cadar ptsy)))))
		       ptsx
		       ptsy))
	   
	

	   (setq i 0)
	   )

    
    (repeat (1- (length pts))  
  
      (cond ((= *DimTypeBDA "Horizontal")
	     (command "_.DIMLINEAR"
			"_none" (nth i pts)
			"_none" (nth (1+ i) pts)
			"_H"
			"_none" pt))
	    
	    ((= *DimTypeBDA "Vertical")
	       (command "_.DIMLINEAR"
			"_none" (nth i pts)
			"_none" (nth (1+ i) pts)
			"_V"
			"_none" pt))
	    
	    (T ;Aligned
	       (command "_.DIMALIGNED"
			"_none" (nth i pts)
			"_none" (nth (1+ i) pts)
			"_none" pt)))

 

      (setq i (1+ i)))

    (princ (strcat "\nError: Wrong selection of at least 2 BLOCKS.")))

  (foreach e oVAR (setvar (car e) (cdr e)))
  (vla-endundomark doc)
  (princ)
)

 

 

 

 

FH Final.LSP

[Stefan BMR]

See the answer here and let me know if it's what you want.

[hanhphuc]

 

This is a simple transient effect in visualizing Qdim lines.

you can try LM:grtext as well

(defun gr-lines (i co pt l / k ip-lst lastp)
  ;hp 04.05.2020
  
  (defun ip-lst (pt c v1 v2 l)
  (grvecs
    (apply 'append
           (setq l (mapcar '(lambda (p / ip)
                              (if
                                (setq
                                  ip
                                  (inters
                                    pt
                                    (mapcar '+ pt v1)
                                    p
                                    (mapcar '+ p v2)
                                    nil
                                  )
                                )
                                (list c ip p)
                              )
                            )
                           l
                   )
           )
    )
  )
  (mapcar 'cadr l)
)

  (while (and pt
              (setq k (grread t 13 0))
              (= (car k) 5)
              (setq pt (cadr k))
              (vl-consp pt)
         )
    (redraw)

    (cond
      ((= i 0)
          (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))
          (grvecs (list co
                        (list (caar l) (cadr pt))
                        (list (car (last l)) (cadr pt))
                  )
          )
         (ip-lst pt co '(1 0 0) '(0 1 0) l)
         )

      ((= i 1)
          (setq l (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))
          (grvecs (list co
                        (list (car pt) (cadar l))
                        (list (car pt) (cadr (last l)))
                  )
          )
         (ip-lst pt co '(0 1 0) '(1 0 0) l)
         )

      ((= i 2)
          (mapcar '(lambda (a b / ip)
                     (if
                       (setq ip 
                          (apply 'ip-lst
                            (vl-list* pt co
                               (reverse
                                 (cons (list a b)
                                  (mapcar '(lambda (x) (polar '(0 0 0) (+ x (angle a b)) 1))
                                  (list (/ pi 2) 0)
                                  )
                                )
                              )
                            )
                           )
                          )
                       (apply 'grdraw (append ip (list co)))
                     )
                   )
                  l (cdr l)
          )
      )
    )
    (setq lastp pt)
  )
  lastp
)

 

 

Try to modify add function call in original code in red  

(if ,and ,progn, else) 

 

    ;;<snippets>;;   
    (if
       (and
          ;;<snippets>;;
           (setq pt (getpoint "\nSpecify dimension line location: "))   ;; ignore this line within 'and'      
          ;;<snippets>;;
        )
       
       (progn  ;;add this as new
              (setq  pts (mapcar '(lambda (x) (trans x 0 1)) pts)
                     pt (gr-lines (vl-position *DimTypeBDA '("Horizontal" "Vertical" "Aligned"))
                         4 (getvar 'viewctr)
                         pts
                        )
                ) ;setq 

          (repeat (1- (length pts))
            
            ;;<snippets>;; unchanged
           
           ) ;repeat 

        ) ; end of progn  
      
        (princ (strcat "\nError: Wrong selection of at least 2 BLOCKS.")) ;else

     ) ; end of if

    ;;<snippets>;;

 

 

 

 

 

Edited May 5, 2020 by hanhphuc
typo & trans

[Ahmed_Hisham]

Hi  @hanhphuc , 

 

Thank you for all your effort to solve it. 

 

Genius  

 

 

 

 

FH Final 5-5-2020.LSP