Dim lisp

[billscheltema]

Hi,

Would someone be willing to show a lisp routine that draws a rectangle with dimensioning as well.

I am trying to see the relationship between the two codes that would do this.

I think that if I see a simple routine it will make more sense to me.

Bill

[tedg]

Hi,

Would someone be willing to show a lisp routine that draws a rectangle with dimensioning as well.

I am trying to see the relationship between the two codes that would do this.

I think that if I see a simple routine it will make more sense to me.

Bill
You may want to provide more information.
Do you want to be able to pick and/or type the rectangle size?

How do you want it dimensioned? (not sure if that can be done automatically), you may have to select the dimension placements.

[billscheltema]

Hi,

I am looking for user input for rec size with a DLinear for the horizontal and vertical lines.
This would go into the DIM layer of course.

I had seen a lisp somewhere where a spacer was drawn and autodimensioned.

Bill

[tedg]

Hi,

I am looking for user input for rec size with a DLinear for the horizontal and vertical lines.
This would go into the DIM layer of course.

I had seen a lisp somewhere where a spacer was drawn and autodimensioned.

Bill
Well here's a quick stab at it, I couldn't make it "autodimension" so you need to place the two dimension strings. I scabbed this together with other routines I've written.


(defun C:RECDIM (/ p1 p2 p3 p4 LR1 LR2 OSM la)
(setq la (getvar "clayer"))
(setq strt_point (getpoint "Select start Point (lower left corner)"))(terpri)
(setq len (getdist "How wide is your rectangle? (horizontally)"))(terpri)
(setq wid (getdist "How high is your rectangle? (vertically)"))(terpri)
(setq Xp1 (car strt_point))
(setq yp1 (cadr strt_point))
(setq p1 (list xp1 yp1 0))
(setq xp2 (+ xp1 len))
(setq yp2 yp1)
(setq p2 (list xp2 yp2 0))
(setq xp3 xp2)
(setq yp3 (+ yp2 wid))
(setq osm (getvar "osmode"))
(setq p3 (list xp3 yp3 0))
(setq p4 (list xp1 yp3 0))
(SETQ LR1 (TBLSEARCH "LAYER" "RECT"))
(SETQ LR2 (TBLSEARCH "LAYER" "DIM"))
(IF (= LR1 NIL)
(command "layer" "make" "RECT" "color" "3" "" ""))
(IF (= LR2 NIL)
(command "layer" "make" "DIM" "color" "150" "" ""))
(setvar "osmode" 16384)
(command "layer" "S" "RECT" "" "")
(command "pline" p1 p2 p3 p4 "c")
(command "layer" "S" "DIM" "" "")
(command "_dimlinear" p1 p2 pause "")
(command "_dimlinear" p1 p4 pause "")
(setvar "osmode" osm)
(setvar "clayer" la)
(princ)
)
(princ "REC_DIM loaded. ")
(princ "command: RECDIM ")
(princ)
Like I said, a quick stab. The lisp gurus out there may have a better idea.

good luck

[Opie]

It's not as wordy as Ted's but it does about the same thing. ;)

(defun C:RECT-dim
(/ LL UL LR UR )
(setq LL (getpoint "\nSelect Start Point.: "))
(initget 1056)
(setq UR (getcorner LL "\nSelect End Point:")
UL (list (car LL)(cadr UR) 0)
LR (list (car UR)(cadr LL) 0)
)
(if (null (tblsearch "LAYER" "RECT"))
(command "layer" "make" "RECT" "color" "3" "" "")
(command "layer" "thaw" "RECT" "on" "RECT" "set" "RECT" "")
)
(command "._RECTANGLE" "_non" LL UR)
(if (null (tblsearch "LAYER" "DIM"))
(command "layer" "make" "DIM" "color" "150" "" "")
(command "layer" "thaw" "DIM" "on" "DIM" "set" "DIM" "")
)
(command "._dimlinear" LL LR pause)
(command "._dimlinear" LL UL pause)
(princ)
)

[tedg]

It's not as wordy as Ted's but it does about the same thing. ;)

Wordy? :lol:
Isn't it more = better? :p

I knew there would be a cleaner way....
:beer::beer:

[billscheltema]

Thanks guys,

Is there any way to set the ext line? or have the lisp complete the routine?

Bill

[tedg]

Thanks guys,

Is there any way to set the ext line? or have the lisp complete the routine?

Bill
Possibly, it's out of my league.

[T.Willey]

Here is my 'wordy' ActiveX entry.



(
(lambda (/ ActDoc CurSpace Pt Pt2 PlObj LayCol tempLay DimObj)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq CurSpace
(vlax-get
ActDoc
(if (equal (getvar 'CVport) 1)
'PaperSpace
'ModelSpace
)
)
)
(setq LayCol (vla-get-Layers ActDoc))
(foreach lst '(("Rect" 3) ("Dim" 150))
(if (not (tblsearch "layer" (car lst)))
(progn
(setq tempLay (vla-Add LayCol (car lst)))
(vla-put-Color tempLay (cadr lst))
)
)
)
(if
(and
(setq Pt (getpoint "\n Select start point: "))
(setq Pt2 (getcorner Pt "\n Select other corner: "))
(setq Pt (trans Pt 1 0))
(setq Pt2 (trans Pt2 1 0))
)
(progn
(setq PlObj
(vlax-invoke
CurSpace
'AddLightWeightPolyline
(list
(car Pt)
(cadr Pt)
(car Pt2)
(cadr Pt)
(car Pt2)
(cadr Pt2)
(car Pt)
(cadr Pt2)
)
)
)
(vla-put-Closed PlObj :vlax-true)
(vla-put-Layer PlObj "Rect")
(setq DimObj
(vlax-invoke
CurSpace
'AddDimRotated
Pt
(list
(car Pt)
(cadr Pt2)
(car Pt)
)
(list
(car (polar Pt pi 1.0))
(/ (+ (cadr Pt) (cadr Pt2)) 2.)
(car Pt)
)
(* pi 0.5)
)
)
(vla-put-Layer DimObj "Dim")
(setq DimObj
(vlax-invoke
CurSpace
'AddDimRotated
Pt
(list
(car Pt2)
(cadr Pt)
(car Pt)
)
(list
(/ (+ (car Pt) (car Pt2)) 2.)
(cadr (polar Pt (* pi 1.5) 1.0))
(car Pt)
)
0.0
)
)
(vla-put-Layer DimObj "Dim")
)
)
(princ)
)
)

[tedg]

Here is my 'wordy' ActiveX entry.
Very nice T.Willey! :beer:

That is what the OP requested.

[T.Willey]

Very nice T.Willey! :beer:

That is what the OP requested.

Thanks Ted. You can have that beer for me though. :wink: