Bematen via autolisp

[benny]

Hey hey,

weet er iemand of het mogelijk is om een lisp te schrijven die ervoor zorgt dat als we een rechthoek selecteren, deze automatisch bemaat word?

groetjes

benny

[HofCAD]

Hey hey,

weet er iemand of het mogelijk is om een lisp te schrijven die ervoor zorgt dat als we een rechthoek selecteren, deze automatisch bemaat word?

groetjes

benny

----------- ~\\|//~ ------------
----------- (o)-(o) -------------
-------ooO---(_)---Ooo--------

Beste Benny,

Als de rechthoek getekend is met het commando RECTANG(RECTANGLE) of met het commando POLYGON,
dan is het object een (LW)polyline.
In de database van die polylijn staan o.a.  de vier hoekpunten(vertices) opgeslagen.

((-1 . <Entity name: 7ef9cda0>) (0 . "LWPOLYLINE") (330 .
<Entity name: 7ef9cd08>) (5 . "34") (100 . "AcDbEntity") (67 . 0) (410 .
"Model") (8 . "0") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 .
0.0) (39 . 0.0) (10 20.0 30.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 120.0 30.0)
(40 . 0.0) (41 . 0.0) (42 . 0.0) (10 120.0 110.0) (40 . 0.0) (41 . 0.0) (42 .
0.0) (10 20.0 110.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))

Door na een (entsel) de database met entget functie op te halen (setq ed (entget (car (entsel)))) , krijgt men
men bovenstaande listing in de variabele ed.
Men kan nu bijv. door (setq p1 (assoc 10 ed)) het eerste hoekpunt van de rechthoek vinden.
Alle informatie van de rechthoek kan opgehaald worden, en men kan dan dus ook via Lisp bematen.

In onderstaand programma is dit globaal al reeds uitgewerkt, maar is niet uitvoerig getest.

-Als je de rechthoek tekent met het commando PLINE, kan het programma de rechthoek verkeerd bematen.
-De objectafstand van de bemating, zou je misschien kunnen laten afhangen van de AutoCAD variabele
Dimscale.
-Het kan ook gemaakt worden dat het programma de bemating op de juiste laag zet.

Groetjes HofCAD CSI

(defun c:BMREC()
  (defun @dxf (code elist)
    (cdr (assoc code elist))
  )
  (defun @vert (e v / name en ev i vl zn)
    (setq name (@dxf 0 (entget e)))
    (if   (= name "POLYLINE")
      (progn
   (setq en e)
   (repeat   v
   Â  (setq en (entnext en))
   )
   (setq p! (cdr (assoc 10 (entget en))))
      )
    )
    (if   (= name "LWPOLYLINE")
      (progn
   (setq ev (entget e)
   Â      i    0
   Â      zn (cdr (assoc 38 ev))
   Â      vl (list '(0 0 0))
   )
   (while (/= (nth i ev) nil)
   Â  (if (= (car (nth i ev)) 10)
   Â    (setq
   Â      vl (append
      Â   vl
      Â   (list
      Â     (list 10 (cadr (nth i ev)) (caddr (nth i ev)) zn)
      Â   )
       )
   Â    )
   Â  )
   Â  (setq i (1+ i))
   )
   (setq p! (cdr (nth v vl)))
      )
    )
    (setq p! p!)
  )
(setq e (car (entsel)))
(command "dimlinear" (@vert e 1) (@vert e 2) "@0,-8" "")
(command "dimlinear" (@vert e 2) (@vert e 3) "@8,0" "")
)

[benny]

hey,

heel erg bedankt. dit programma werkt. het werkt inderdaad niet als je de rechthoek met apparte lijnen maakt. zou ik
dit op de een of de andere manier kunnen aanpassen? is het ook mogelijk om meerdere rechthoeken na elkaar te bematen, zonder iedere keer de lisp opnieuw te moeten aanroepen?

Helaas heb ik geen grote kennis van Autolisp, ken jij misschien een goed boek over autolisp?

alvast heel erg bedankt

Benny

[AHA-D]

Misschien ben je dan wel beter af met een routine die zowel de rechthoeken tekent als bemaat en die je enkel vraagt wat de afmetingen moeten zijn en waar het ding moet komen.

Alex

[HofCAD]

Misschien ben je dan wel beter af met een routine die zowel de rechthoeken tekent als bemaat en die je enkel vraagt wat de afmetingen moeten zijn en waar het ding moet komen.

Alex

------------- ~\\|//~ ------------
------------- (o)-(o) -------------
-------ooO---(_)---Ooo--------

Beste Benny en Alex,

Als men rechthoeken automatisch wil laten bematen, dan moet dat ergens een doel hebben.
Als men slechts sporatisch rechthoeken moet bematen, dan zie ik persoonlijk niet het nut in
van mijn programma.
Waarvoor wil je het programma eigenlijk gebruiken? 

Als de rechthoeken frekwent voorkomen (bijv. voor houtafmetingen of bijv. vloeroppervlak-benuttingsgraad)
dan geef ik Alex volledig gelijk, dat je dan beter een programma kan hebben die te gelijk
de rechthoeken tekent en bemaat.
En bijvoorbeeld ook de oppervlakte in Excel laat verschijnen.

Een programma die een rechthoek uit lijnen(dus geen LWpolyline of polyline) bemaat, kan
wel geschreven worden als er een goed criterium is.
Bijv.: - Twee van de vier lijnen worden correct geselecteerd
        - Of alle vier lijnen beschikken bijv. over een unieke kleur, of uniek lijntype, of lineweight
        - Of alle vier lijnen beschikken over een unieke XDATA code.
Waarom wil je een rechthoek uit vier losse lijnen laten bestaan?

Als Nederlands boek voor AutoLisp wat nu nog verkrijgbaar is, ken ik alleen
de (dikke) boeken van Ir. R. Boeklagen:
AutoCAD 14 Computer Ondersteund Ontwerpen met ISBN 90-72487-13-3
AutoCAD 2000 Computer Ondersteund Ontwerpen met ISBN 90-72487-23-0
AutoCAD 2000i Computer Ondersteund Ontwerpen met ISBN 90-72487-25-7
AutoCAD 2002 Computer Ondersteund Ontwerpen met ISBN 90-72487-29-X
AutoCAD 2004 Computer Ondersteund Ontwerpen met ISBN 90-72487-37-0
AutoCAD 2005 Computer Ondersteund Ontwerpen met ISBN 90-72487-41-9
AutoCAD 2006 Computer Ondersteund Ontwerpen met ISBN 90-72487-45-1
Als inleiding in AutoLisp en Visual Lisp, vind ik deze boeken best goed.

Groetjes HofCAD CSI

PS Een cursus volgen bij ir. R. Boeklagen, is zeer interessant en ook nog grappig.
Hij doet pas echt leuke dingen met AutoCAD en Inventor.

[HofCAD]

Hey hey,

weet er iemand of het mogelijk is om een lisp te schrijven die ervoor zorgt dat als we een rechthoek selecteren, deze automatisch bemaat word?

groetjes benny

------------- ~\\|//~ ------------
------------- (o)-(o) -------------
-------ooO---(_)---Ooo--------

Beste Benny,

Ik heb nog eens vlug naar mijn programma gekeken, en een klein aantal veranderingen aangebracht.
Er wordt nu o.a. gekeken of de polylijn wel exact vier hoekpunten heeft, maar er wordt nog niet gekeken
hoe die vier hoekpunten liggen.
(Bij een vierkant met het commando POLYGON geeft dit nu nog problemen.)
Ook wordt de bemating op een speciale laag gezet, waar van je de naam en kleur makkelijk kan veranderen.
Zie in het begin van het programma RECBM

(setq
       layFL         "Figuur"             ;Laagnaam voor figuurlijnen
       collayFL     "Cyan"               ;Kleur van de figuurlijnenlaag
       layBM        "Bemating"         ;Laagnaam voor bemating
       collayBM     "Yellow"            ;Kleur van de bematingslaag
  )

Zie ook het begin van het programma BMREC

  (setq   
      layBM   Â   "Bemating"   ;Laagnaam voor bemating
      collayBM     "Yellow"   ;Kleur van de bematingslaag
  )

De afstand tussen de bematingslijn en de rechthoek is afhankelijk geworden van de AutoCAD
variabele Dimscale; zie bij Dimstyle en de tab Fit 'Scale for Dimension Features'.
Verder worden ook een aantal variabelen gezet en later weer teruggezet.

Groetjes HofCAD CSI

Code Selecteer Uitklappen


(defun RecErr (msg)
(if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)))
(setq msg nil)
(ResVarRec)
(princ)
)
(defun ResVarRec ()
(setvar "CLAYER" ~CLY)
(setvar "OSMODE" ~OSM)
(setvar "PLINEWID" ~PLW)
(setvar "CMDECHO" ~CMD)
(setq *error* olderr ~CLY nil ~OSM nil ~PLW nil ~CMD nil)
)
(defun c:RECBM (/ @dtr lop rbp layFL collayFL layBM collayBM x1 y1 z1 x2 y2 z2)
  (setq
      layFL    "Figuur" ;Laagnaam voor figuurlijnen
collayFL "Cyan" ;Kleur van de figuurlijnenlaag
layBM    "Bemating" ;Laagnaam voor bemating
collayBM "Yellow" ;Kleur van de bematingslaag
  )
(setq olderr *error* *error* RecErr
       ~CMD (getvar "CMDECHO")
       ~PLW (getvar "PLINEWID")
       ~OSM (getvar "OSMODE")
       ~CLY (getvar "CLAYER")
)
  (defun @dtr (a)
    (setq a (/ (* a pi) 180))
  )
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setvar "PLINEWID" 0)
  (setq lop
(getpoint
   "\nLinker onderhoekpunt aub (De bemating is afhankelijk van Dimscale): "
)
  )
  (setq rbp (getcorner lop "\nRechter bovenhoekpunt aub: "))
  (if (not (tblsearch "LAYER" layFL))
    (command "_LAYER" "M" layFL "C" collayFL "" "")
    (command "_LAYER" "T" layFL "ON" layFL "S" layFL "")
  )
  (if (< (car lop) (car rbp))
    (setq x1 (car lop)
  x2 (car rbp)
    )
    (setq x1 (car rbp)
  x2 (car lop)
    )
  )
  (if (< (cadr lop) (cadr rbp))
    (setq y1 (cadr lop)
  y2 (cadr rbp)
    )
    (setq y1 (cadr rbp)
  y2 (cadr lop)
    )
  )
  (if (< (caddr lop) (caddr rbp))
    (setq z1 (caddr lop)
  z2 (caddr rbp)
    )
    (setq z1 (caddr rbp)
  z2 (caddr lop)
    )
  )
  (setq lop (list x1 y1 z1)
rbp (list x2 y2 z1)
  )
  (command "_PLINE"
   lop
   (list (car rbp) (cadr lop))
   rbp
   (list (car lop) (cadr rbp))
   "C"
  )
  (if (not (tblsearch "LAYER" layBM))
    (command "_LAYER" "M" layBM "C" collayBM "" "")
    (command "_LAYER" "T" layBM "ON" layBM "S" layBM "")
  )
  (command "_DIM"
   "_HOR"
   lop
   (list (car rbp) (cadr lop))
   (polar lop (@dtr 270) (* 8 (getvar "DIMSCALE")))
   ""
   "_VER"
   (list (car rbp) (cadr lop))
   rbp
   (polar rbp 0 (* 8 (getvar "DIMSCALE")))
   ""
   "_EXIT"
  )
  (ResVarRec)
  (princ)
)
(defun c:BMREC (/ layBM collayBM @dxf @dtr @vert NotOke e)
  (setq
      layBM    "Bemating" ;Laagnaam voor bemating
      collayBM     "Yellow" ;Kleur van de bematingslaag
  )
  (defun @dxf (code elist)
    (cdr (assoc code elist))
  )
  (defun @dtr (a)
    (setq a (/ (* a pi) 180))
  )
  (defun @vert (e v / name en ev i vl zn)
    (setq name (@dxf 0 (entget e)))
    (if (= name "POLYLINE")
      (progn
(setq en e)
(repeat v
  (setq en (entnext en))
)
(setq p! (cdr (assoc 10 (entget en))))
      )
    )
    (if (= name "LWPOLYLINE")
      (progn
(setq ev (entget e)
      i 0
      zn (cdr (assoc 38 ev))
      vl (list '(0 0 0))
)
(while (/= (nth i ev) nil)
  (if (= (car (nth i ev)) 10)
    (setq
      vl (append
   vl
   (list
     (list 10 (cadr (nth i ev)) (caddr (nth i ev)) zn)
   )
)
    )
  )
  (setq i (1+ i))
)
(setq p! (cdr (nth v vl)))
      )
    )
    (setq p! p!)
  )
(setq olderr *error* *error* RecErr
       ~CMD (getvar "CMDECHO")
       ~PLW (getvar "PLINEWID")
       ~OSM (getvar "OSMODE")
       ~CLY (getvar "CLAYER")
)
  (defun @dtr (a)
    (setq a (/ (* a pi) 180))
  )
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (if (not (tblsearch "LAYER" layBM))
    (command "_LAYER" "M" layBM "C" collayBM "" "")
    (command "_LAYER" "T" layBM "ON" layBM "S" layBM "")
  )
  (While
    (setq e
   (car
     (entsel
       "\nSelecteer een rechthoek (De bemating is afhankelijk van Dimscale):"
     )
   )
    )
     (progn
       (setq NOToke 1)
       (if (or (= (cdr (assoc 0 (entget e))) "POLYLINE")
       (= (cdr (assoc 0 (entget e))) "LWPOLYLINE")
   )
(setq NOToke nil)
       )
       (if (= NOToke nil)
(progn
   (if (= (@vert e 4) nil)
     (setq NOToke 1)
   )
   (if (/= (@vert e 5) nil)
     (setq NOToke 1)
   )
)
       )
       (if (= NOToke nil)
(progn
   (command
     "DIM"
     "ALI"
     (@vert e 1)
     (@vert e 2)
     (polar (@vert e 2) (@dtr 270) (* 8 (getvar "DIMSCALE")))
     ""
     "ALI"
     (@vert e 2)
     (@vert e 3)
     (polar (@vert e 3) 0 (* 8 (getvar "DIMSCALE")))
     ""
     "_EXIT"
   )
)
       )

     )
  )
  (ResVarRec)
  (princ)
)


PS Ik ben blond, en ik verzoek dus iedereen om kritisch naar dit programma te kijken. 

[HofCAD]

Misschien ben je dan wel beter af met een routine die zowel de rechthoeken tekent als bemaat en die je enkel vraagt wat de afmetingen moeten zijn en waar het ding moet komen.

Alex

------------- ~\\|//~ ------------
------------- (o)-(o) -------------
-------ooO---(_)---Ooo--------

Beste Benny en Alex,

Ik heb het bovenstaande programma, nog eens aangepast.
Er zijn nu twee programmacommando's nl BMREC en RECBM, en met een betere foutafhandeling.
Met BMREC kun je rechthoeken bematen, en met RECBM kun je rechthoeken tekenen die meteen
ook bemaat worden.

Groetjes HofCAD CSI

[martin]

hallo, ik heb een vraag over dit onderwerp.
(beetje laat, langzame leerling blijkbaar)
kan je ook meerdere rechthoeken tegelijk selecteren ?
het is om platenschema`s te bematen en dat zijn er nogal veel.
groet, Martin

[HofCAD]

Beste Martin,

Nu nog niet.

Met vriendelijke groet, HofCAD CSI.

[EddyBeerke]

Da's voor jou een eitje HofCad!
Je hebt mij ook eens geholpen met een selectie te ver werken.