Alleen tekst | Tekst met afbeeldingen

CADsite forum

AutoCAD => Autolisp => Topic gestart door: Cad_user86 op wo 19 10 2016, 09:41:03

Titel: Afmetingen in rechthoek
Bericht door: Cad_user86 op wo 19 10 2016, 09:41:03
Hallo,

Voor mijn zaagplannen had ik graag in mijn rechthoeken automatisch de afmetingen gekregen (lengtexbreedte) in het midden van de rechthoek als ik deze teken.

Bestaat hier een command of lisp routine voor?

Ik heb internet even gezocht maar vrees dat ik niet de juiste benamingen gebruik in de zoekfuncties.

Ik kwam volgende tegen maar dit werkt niet bij me:

(defun c:LabelRec (/ ActDoc CurSpace Ht ss cnt Ent EntData VerPoints tmpEnt Wid Len Pt Str 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) 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))
)



Bedankt
Cad_User86
Titel: Re: Afmetingen in rechthoek
Bericht door: julien op wo 19 10 2016, 10:48:37
Wij zijn hier afgestapt om zaagplannen in AutoCAD te maken.
We gebruiken hiervoor het gratis:
http://www.maxcutsoftware.com
Die maakt naast optimalisaties ook zaagplannen waar je de naam van je onderdeel kan opzetten en ook de zaagmaten. Is dat iets voor jou?
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op wo 19 10 2016, 12:32:41
Cad_user86, met welke (versie van) AutoCAD werkt u?
Titel: Re: Afmetingen in rechthoek
Bericht door: Cad_user86 op wo 19 10 2016, 13:34:52
Versie 2014
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op wo 19 10 2016, 13:47:45
Citaat van: Cad_user86 op wo 19 10 2016, 13:34:52Versie 2014
Dus de full versie en niet de LT?
Titel: Re: Afmetingen in rechthoek
Bericht door: Cad_user86 op wo 19 10 2016, 13:58:25
ja, volledige versie
Titel: Re: Afmetingen in rechthoek
Bericht door: roy_043 op wo 19 10 2016, 14:57:30
@Cad_User86:
De code in de OP is niet compleet. Wellicht een copy-paste fout?
En: Gebruik a.u.b. CODE-tags.
Titel: Re: Afmetingen in rechthoek
Bericht door: Cad_user86 op wo 19 10 2016, 15:22:07
Dag Roy,

Ik ken zelf niets van LISP, gewoon van internet gekopieerd zoals het hier staat (site van autodesk)
Wat is "OP"? en wat zijn CODE-tags?

Bedankt! :vreegoe:
Titel: Re: Afmetingen in rechthoek
Bericht door: EddyBeerke op wo 19 10 2016, 15:33:34
Citaat van: Cad_user86 op wo 19 10 2016, 15:22:07
Dag Roy,

Ik ken zelf niets van LISP, gewoon van internet gekopieerd zoals het hier staat (site van autodesk)
Wat is "OP"? en wat zijn CODE-tags?

Bedankt! :vreegoe:
Zie afbeelding...
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op wo 19 10 2016, 18:54:45
Citaat van: Cad_user86 op wo 19 10 2016, 15:22:07Wat is "OP"?
OpeningsPost?

Code Selecteer
en deze tekst staat tussen code-tags
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op wo 19 10 2016, 21:08:33
Als je bij de code in de OP op het einde 3 sluitende haken toevoegt, werkt het. Ziehier de volledige code:
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 (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) 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))
)
)
)
)
Titel: Re: Afmetingen in rechthoek
Bericht door: roy_043 op do 20 10 2016, 00:54:32
OP staat voor 'Original Post' of 'Original Poster'.
Titel: Re: Afmetingen in rechthoek
Bericht door: Cad_user86 op do 20 10 2016, 08:08:52
Het 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.

Nu 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...
Iemand een voorstel?

Bedankt alvast!!! :vreegoe: :vreegoe: :vreegoe: :mrgreen:
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op do 20 10 2016, 09:18:36
Dan zal je bovenstaande LISP code dienen uit te breiden met het RECTANG commando.
Titel: Re: Afmetingen in rechthoek
Bericht door: Reimer op do 20 10 2016, 09:39:38
Zou je dit ook met een dynamisch block kunnen doen? Voorbeeld in de bijlage.

Reimer
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op 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.
Titel: Re: Afmetingen in rechthoek (OPGELOST)
Bericht door: Adrianus op 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) 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))
)
)
)
)
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op 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))
)
)
)
)
Titel: Re: Afmetingen in rechthoek
Bericht door: Adrianus op ma 24 10 2016, 21:47:54
Geweldig Gery,
Hij doet het..  :vreegoe: :vreegoe: :vreegoe:

Mijn dank is groot.

Groet,
Adrianus
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op di 25 10 2016, 11:17:40
Citaat van: Adrianus op ma 24 10 2016, 21:47:54Geweldig Gery,
Hij doet het..  :vreegoe: :vreegoe: :vreegoe:

Mijn dank is groot.
Graag gedaan.
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op 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.
Titel: Re: Afmetingen in rechthoek
Bericht door: Cad_user86 op do 27 10 2016, 08:59:24
Joepie,

Perfect voor wat ik ermee moet doen!

Bedankt
Titel: Re: Afmetingen in rechthoek
Bericht door: gery op 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.
Alleen tekst | Tekst met afbeeldingen