Afmetingen in rechthoek

gery · do 20 10 2016, 18:52:33

Citaat van: Cad_user86 op do 20 10 2016, 08:08:52Nu moet je eerst de rechthoek tekenen, vervolgens de lisp activeren, hoogt tekst ingeven en vervolgens de rechthoek selecteren. Dit alles had ik graag in Ã©Ã©n beweging gedaan...

Je kan ook alle rechthoeken op normale wijze tekenen en de bemating op 't einde in Ã©Ã©n keer toevoegen aan alle of enkele geselecteerde rechthoeken.

Adrianus · zo 23 10 2016, 23:03:43

Goedenavond Gery,
Kun jij (of iemand anders) het voor elkaar krijgen dat deze lisp routine de huidige tekststijl oppakt (inclusief hoogte) zodat ik de hoogte niet meer zelf hoef in te vullen? Voor mij is deze lisp dan perfect.

Met vriendelijke groet,
Adrianus.

(defun c:LabelRec (/ ActDoc CurSpace Ht ss cnt Ent EntData VerPoints tmpEnt Wid Len Pt Str tmpPt tmpText tmpDist1 tmpDist2)
; Label rectangles with length and width in middle of them.
(vl-load-com)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (getvar "cvport") 1)
(setq CurSpace (vla-get-PaperSpace ActDoc))
(setq CurSpace (vla-get-ModelSpace ActDoc))
)
(if (and (setq Ht (getreal "\n Enter height of text: ")) (setq ss (ssget '((0 . "*POLYLINE")))))
(progn
(setq cnt 0)
(while (setq Ent (ssname ss cnt))
(setq EntData (entget Ent))
(if (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
(setq VerPoints (vlax-get (vlax-ename->vla-object Ent) 'Coordinates))
(progn
(setq VerPoints nil)
(setq tmpEnt (entnext Ent))
(while (not (equal (cdr (assoc 0 (entget tmpEnt))) "SEQEND"))
(setq tmpPt (cdr (assoc 10 (entget tmpEnt))))
(setq VerPoints (append VerPoints (list (car tmpPt))))
(setq VerPoints (append VerPoints (list (cadr tmpPt))))
(setq tmpEnt (entnext tmpEnt))
)
)
)
(if (= (length VerPoints)

(progn
(setq tmpDist1 (distance (list (nth 0 VerPOints) (nth 1 VerPoints)) (list (nth 2 VerPoints) (nth 3 VerPoints))))
(setq tmpDist2 (distance (list (nth 2 VerPOints) (nth 3 VerPoints)) (list (nth 4 VerPoints) (nth 5 VerPoints))))
(if (< tmpDist1 tmpDist2)
(setq Len tmpDist2 Wid tmpDist1)
(setq Len tmpDist1 Wid tmpDist2)
)
(setq Pt (list (/ (+ (nth 0 VerPoints) (nth 4 VerPoints)) 2.0) (/ (+ (nth 1 VerPoints) (nth 5 VerPoints)) 2.0) 0.0))
(setq Str (strcat (rtos Len 2 2) "x" (rtos Wid 2 2)))
(setq tmpText (vla-AddText CurSpace Str (vlax-3d-point Pt) Ht))
(vla-put-Alignment tmpText 4)
(vla-put-TextAlignmentPoint tmpText (vlax-3d-point Pt))
)
)
(setq cnt (1+ cnt))
)
)
)
)

gery · ma 24 10 2016, 11:38:18

Citaat van: Adrianus op zo 23 10 2016, 23:03:43
Kun jij (of iemand anders) het voor elkaar krijgen dat deze lisp routine de huidige tekststijl oppakt (inclusief hoogte) zodat ik de hoogte niet meer zelf hoef in te vullen? Voor mij is deze lisp dan perfect.

een 1e (snelle) poging:

Code Selecteer

(defun c:LabelRec (/ ActDoc CurSpace Ht ss cnt Ent EntData VerPoints tmpEnt Wid Len Pt Str tmpPt tmpText tmpDist1 tmpDist2)
; Label rectangles with length and width in middle of them.
(vl-load-com)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (getvar "cvport") 1)
(setq CurSpace (vla-get-PaperSpace ActDoc))
(setq CurSpace (vla-get-ModelSpace ActDoc))
)
(if (and (setq Ht (getvar 'textsize)) (setq ss (ssget '((0 . "*POLYLINE")))))
(progn
(setq cnt 0)
(while (setq Ent (ssname ss cnt))
(setq EntData (entget Ent))
(if (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
(setq VerPoints (vlax-get (vlax-ename->vla-object Ent) 'Coordinates))
(progn
(setq VerPoints nil)
(setq tmpEnt (entnext Ent))
(while (not (equal (cdr (assoc 0 (entget tmpEnt))) "SEQEND"))
(setq tmpPt (cdr (assoc 10 (entget tmpEnt))))
(setq VerPoints (append VerPoints (list (car tmpPt))))
(setq VerPoints (append VerPoints (list (cadr tmpPt))))
(setq tmpEnt (entnext tmpEnt))
)
)
)
(if (= (length VerPoints) 8)
(progn
(setq tmpDist1 (distance (list (nth 0 VerPOints) (nth 1 VerPoints)) (list (nth 2 VerPoints) (nth 3 VerPoints))))
(setq tmpDist2 (distance (list (nth 2 VerPOints) (nth 3 VerPoints)) (list (nth 4 VerPoints) (nth 5 VerPoints))))
(if (< tmpDist1 tmpDist2)
(setq Len tmpDist2 Wid tmpDist1)
(setq Len tmpDist1 Wid tmpDist2)
)
(setq Pt (list (/ (+ (nth 0 VerPoints) (nth 4 VerPoints)) 2.0) (/ (+ (nth 1 VerPoints) (nth 5 VerPoints)) 2.0) 0.0))
(setq Str (strcat (rtos Len 2 2) "x" (rtos Wid 2 2)))
(setq tmpText (vla-AddText CurSpace Str (vlax-3d-point Pt) Ht))
(vla-put-Alignment tmpText 4)
(vla-put-TextAlignmentPoint tmpText (vlax-3d-point Pt))
)
)
(setq cnt (1+ cnt))
)
)
)
)

Adrianus · ma 24 10 2016, 21:47:54

Geweldig Gery,
Hij doet het..

Mijn dank is groot.

Groet,
Adrianus

gery · di 25 10 2016, 11:17:40

Citaat van: Adrianus op ma 24 10 2016, 21:47:54Geweldig Gery,
Hij doet het..

Mijn dank is groot.

Graag gedaan.

gery · wo 26 10 2016, 00:10:40

Citaat van: Cad_user86 op do 20 10 2016, 08:08:52Het werkt inderdaad....... helaas nog niet meteen wat ik zoek
Het uiteindelijke resultaat is hoe ik het graag zou hebben, maar ik zou willen dat, wanneer je een rechthoek tekent, dat de tekst dan automatisch in het midden komt te staan.

Een poging:

Code Selecteer

(defun c:Rect+Label (/ ActDoc CurSpace Ht ss cnt Ent EntData VerPoints tmpEnt Wid Len Pt Str tmpPt tmpText tmpDist1 tmpDist2)
; Draws a rectangle, and labels it with length and width in the middle of it.
(vl-load-com)
(command "rectang")
(while (= (logand (getvar "CmdActive") 1) 1) (command pause))
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (getvar "cvport") 1)
(setq CurSpace (vla-get-PaperSpace ActDoc))
(setq CurSpace (vla-get-ModelSpace ActDoc))
)
(if (and (setq Ht (getvar 'textsize)) (setq ss (ssget "_L")))
(progn
(setq cnt 0)
(while (setq Ent (ssname ss cnt))
(setq EntData (entget Ent))
(if (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
(setq VerPoints (vlax-get (vlax-ename->vla-object Ent) 'Coordinates))
(progn
(setq VerPoints nil)
(setq tmpEnt (entnext Ent))
(while (not (equal (cdr (assoc 0 (entget tmpEnt))) "SEQEND"))
(setq tmpPt (cdr (assoc 10 (entget tmpEnt))))
(setq VerPoints (append VerPoints (list (car tmpPt))))
(setq VerPoints (append VerPoints (list (cadr tmpPt))))
(setq tmpEnt (entnext tmpEnt))
)
)
)
(if (= (length VerPoints) 8)
(progn
(setq tmpDist1 (distance (list (nth 0 VerPOints) (nth 1 VerPoints)) (list (nth 2 VerPoints) (nth 3 VerPoints))))
(setq tmpDist2 (distance (list (nth 2 VerPOints) (nth 3 VerPoints)) (list (nth 4 VerPoints) (nth 5 VerPoints))))
(if (< tmpDist1 tmpDist2)
(setq Len tmpDist2 Wid tmpDist1)
(setq Len tmpDist1 Wid tmpDist2)
)
(setq Pt (list (/ (+ (nth 0 VerPoints) (nth 4 VerPoints)) 2.0) (/ (+ (nth 1 VerPoints) (nth 5 VerPoints)) 2.0) 0.0))
(setq Str (strcat (rtos Len 2 2) "x" (rtos Wid 2 2)))
(setq tmpText (vla-AddText CurSpace Str (vlax-3d-point Pt) Ht))
(vla-put-Alignment tmpText 4)
(vla-put-TextAlignmentPoint tmpText (vlax-3d-point Pt))
)
)
(setq cnt (1+ cnt))
)
)
)
)

Er zullen ongetwijfeld nog andere en betere en simpelere codes bestaan, ik heb gewoonweg ff verder gewerkt op de in dit topic aangereikte code.

Cad_user86 · do 27 10 2016, 08:59:24

Joepie,

Perfect voor wat ik ermee moet doen!

Bedankt

gery · do 27 10 2016, 11:10:52

Citaat van: Cad_user86 op do 27 10 2016, 08:59:24Perfect voor wat ik ermee moet doen!

Bedankt

Graag gedaan.