dimensioning question

[Tharwat]

I have a suggestion Tharwat. You should retain both versions. I would rename one of them as DimAuto though as to avoid any confusion. There will be people who prefer not to have their lines replaced by dimensions. You might also want to add a line in the file itself that tells the use your lisp routine works with lines only.

 

No worries mate , here is a full complete lisp that can handle all these issues in one go .

 

Hope you comment it if any error or mistake took a place with this LISP .

 

(defun c:DimAuto (/ *error* spc Textheight CurrentTextstyle del selectionset ang)
;;; Tharwat 10. Oct. 2012 ;;;
 (vl-load-com)
 (defun *error* (x) (princ "\n *Cancel*") (princ))
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
   )
 (setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
             )
       )
 (setq Textheight
        (if (eq (cdr (assoc 40 (setq CurrentTextstyle (entget (tblobjname "style" (getvar 'Textstyle)))))) 0.)
          (cdr (assoc 42 CurrentTextstyle))
          (cdr (assoc 40 CurrentTextstyle))
          )
       )
 (prompt "\n Select only LINES to Auto measure them ...")
 (if (and (setq selectionset (ssget '((0 . "LINE"))))
          (progn (initget "Yes No")
                 (setq del (cond ((getkword "\n Delete the selected LINES [Yes,No] < No > :"))
                                 ("No")
                                 )
                       )
                 )
          )
   (progn (vla-StartUndoMark acdoc)
          ((lambda (intger / selectionsetname entgetlist dimension p1 p2)
             (while (setq selectionsetname (ssname selectionset (setq intger (1+ intger))))
               (setq entgetlist (entget selectionsetname))
               (setq
                 dimension (vla-adddimaligned
                             spc
                             (vlax-3d-point (setq p1 (cdr (assoc 10 entgetlist))))
                             (vlax-3d-point (setq p2 (cdr (assoc 11 entgetlist))))
                             (if (eq del "Yes")
                               (vlax-3d-point (setq p2 (cdr (assoc 11 entgetlist))))
                               (vlax-3d-point (polar p1 (+ (angle p1 p2) (/ pi 2.)) (+ (* Textheight 0.4) Textheight)))
                               )
                             )
                 )
               (setq ang (angle p1 p2))
               (cond ((and (>= ang (/ pi 2.)) (<= ang (+ pi (/ pi 2.)))) (setq ang (+ ang pi)))
                     ((= ang pi) (setq ang (- ang pi)))
                     ((> ang 0.0) (setq ang (- ang (+ pi pi))))
                     )
               (vla-put-textrotation dimension ang)
               (if (eq del "Yes")
                 (entdel selectionsetname)
                 )
               )
             )
            -1
            )
          (vla-EndUndoMark acdoc)
          )
   (princ "\n < *** No lines selected *** >")
   )
 (princ "\n Written by Tharwat Al Shoufi")
 (princ)
 )

Tharwat

[ReMark]

You're too good to us Tharwat. I'll take it for a test run. Thanks.

 

Just noticed you are in Abu Dhabi. Are you self-employed or do you work for some big multi-national firm there?

[Tharwat]

You're too good to us Tharwat. I'll take it for a test run. Thanks.

 

Thank you , enjoy it

 

Just noticed you are in Abu Dhabi. Are you self-employed or do you work for some big multi-national firm there?

 

Yeah , it is multi-national company / Mechanical field (Air-Conditioning , Plumbing and Fire Fighting system ) and I am working abroad .

[Tharwat]

What about another version that can create dimension objects between circles while just passing the cursor over circles ?

 

Just select the first Circle and move your cursor over the other circles to create the dimensions .

 

(defun c:Test (/ *error* c go p1 gr e ent dimension p2 lst ang)
 (vl-load-com)
;;;   Tharwat Al Shoufi  12. 10. 2012 ;;;
;;; Create Dimensions between circles ;;;
 (defun *error* (x) (princ "\n *Cancel*") (princ))
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
           )
 )
 (prompt "\n Select start Circle ...")
 (if (setq c (ssget "_+.:S" '((0 . "CIRCLE"))))
   (progn
     (setq p1 (cdr (assoc 10 (entget (ssname c 0)))))
     (setq go t)
     (setq lst (cons (cdr (assoc -1 (entget (ssname c 0)))) lst))
   )
   (princ "\n Nothing selected or not a Circle object ")
 )
 (while (and go (eq 5 (car (setq gr (grread t 15 2)))))
   (redraw)
   (princ
     "\r Move cursor over circles to add dimension entity between them :"
   )
   (if (and (setq e (ssget (cadr gr)))
            (eq (cdr (assoc 0 (setq ent (entget (ssname e 0)))))
                "CIRCLE"
            )
            (not (member (cdr (assoc -1 ent)) lst))
       )
     (progn
       (setq
         dimension (vla-adddimaligned
                     spc
                     (vlax-3d-point p1)
                     (vlax-3d-point (setq p2 (cdr (assoc 10 ent))))
                     (vlax-3d-point (setq p2 (cdr (assoc 10 ent))))
                   )
       )
       (setq ang (angle p1 p2))
       (cond ((and (>= ang (/ pi 2.)) (<= ang (+ pi (/ pi 2.))))
              (setq ang (+ ang pi))
             )
             ((= ang pi) (setq ang (- ang pi)))
             ((> ang 0.0) (setq ang (- ang (+ pi pi))))
       )
       (vla-put-textrotation dimension ang)
       (setq p1 p2)
       (setq lst (cons (cdr (assoc -1 ent)) lst))
     )
   )
 )
 (princ "\n Written by Tharwat Al Shoufi")
 (princ)
)

 

Tharwat

[ReMark]

Looks like we have a man on a mission. Once again our thanks to you Tharwat for your efforts.

[ryan osmun]

with this one, as soon it tells me to select object nothing happens?

[Tharwat]

Looks like we have a man on a mission. Once again our thanks to you Tharwat for your efforts.

 

Thanks Remark , did you like the idea ?

 

with this one, as soon it tells me to select object nothing happens?

 

Just select the first circle and move the cursor after that on the other circles without selecting anything .

[ryan osmun]

hmm, with i have cad 2012 does that make a difference? it doesnt seem to be working for me?

[Tharwat]

hmm, with i have cad 2012 does that make a difference? it doesnt seem to be working for me?

 

No at all , have you noticed that the name of the routine is TEST ?

 

Tell me how did you run the code .

[ryan osmun]

i have copied your lsp to my desk top saved it as test.lsp. went in cad appload, loaded the lsp file. then typed test in command and it says select objects, as soon as i select a circle it gos away like nothing has happend. i loaded your double version dimauto and it worked perfect.

[Tharwat]

, as soon as i select a circle it gos away like nothing has happend.

After that move the cursor over ( above ) the other circles to make the dimensions automatically without selecting circles.

[ryan osmun]

still nothing happening?

[Tharwat]

still nothing happening?

That's really odd , let us wait for Remark's try and reply .

[ReMark]

Give me a moment. I have some paperwork to fill out. I'll be back.

 

Test completed.

 

I get dimensions but all of them have yellow boxes next to them with an exclamation point in it. Maybe something to do with reassociating a dimension?

[ryan osmun]

i wonder why i am not even getting that? could certain settings i have on be affecting it?

[Tharwat]

 

Test completed.

 

I get dimensions but all of them have yellow boxes next to them with an exclamation point in it. Maybe something to do with reassociating a dimension?

 

Thanks for giving the time to try it Remark .

 

Actually what you have mentioned is not related to the code at all , because it is simply create dimensions according to the current dimension style and nothing 's more .

[Tharwat]

i wonder why i am not even getting that? could certain settings i have on be affecting it?

 

Change the name of the routine and reload it again , you may have another routine with the same name .

[ReMark]

My test drawing is just a new drawing with the overall scale factor reset from its default of "1" to "12". No other changes were made. I am using an imperial template.

 

Note the boxes I have circled in red. Interesting.

[ryan osmun]

ya i have tried that it still did the same thing.

[Tharwat]

OMG , can you upload that new drawing Remark ?

 

Or you may have the Annotative Dim. style on ? Change the dim style and try it again please .