CADsite forum

AutoCAD => Autolisp => Topic gestart door: Sven op do 07 07 2005, 16:21:49

Titel: grid tekenen + coordinaten erbij
Bericht door: Sven op do 07 07 2005, 16:21:49
ik heb dankbaar gebruik kunnen maken van het onderwerp "getal afronden" .
Nu heb ik een routine geschreven waarbij ik een grid wil tekenen -> dit lukt  8)  8)
Toen ik het echter wou uitbreiden om er aan de zijkant ook de coordinaten bij te plaatsen gaat er echter iets fout. Het grid tekent hij nog, maar de coordinaten komen er nog niet bij  :evil:
1) kan iemand mij zeggen waar het fout gaat? Liefst eerst zonder vraag 2 te beantwoorden. (lange versie dus, die versta ik nog)
2) waarschijnlijk kan dit ook korter, maar zo gevorderd ben ik nog niet. Kan iemand mij zeggen hoe dit korter kan?




(defun c:geogrid (/ pt1 pt2 spatie schaal rijmax kolommax rij kolom claag x0 x1 x2 x3 x4 x5 x6 y0 y1 y2 y3 y4 y5 y6 tekenx tekeny pt3)
 (setvar "cmdecho" 0)
 (setq pt1 (getpoint "\nDuid de linkerbenedenhoek aan : "))
 (setq pt2 (getcorner pt1 "\nDuid de rechterbovenhoek aan: "))
 (setq spatie (getreal "\nGeef de tussenafstand (m): "))
 (setq schaal (getreal "\nGeef de grootte van de kruisjes: "))
 (initget 1 "Links Rechts Beide Geen")
 (setq linksrechts (getkword "coördinaten Links, Rechts, aan Beide kanten of Geen? "))
 (initget 1 "BOven Onder BEide Geen")
 (setq bovenonder (getkword "coördinaten BOven, Onder, aan BEide kanten of Geen? "))
 (initget 1 "BInnenkant BUitenkant _-1 1")
 (setq orient (getkword "Coördinaten aan de BInnenkant of aan de BUitenkant van het grid? "))
 (setq lh (getreal "Geef de letterhoogte van de coördinaten: "))
 (setq x0 (car pt1))
 (setq y0 (cadr pt1))
 (if (= spatie 50) (round50) (if (= spatie 25) (round25) (round10)))
 (setq sm (getvar "osmode"))
 (setvar "osmode" 0)
 (setq cl (getvar "clayer"))
 (command "-layer" "m" "grid" "c" "8" "" "")
 (setq pt3 (list x6 y6))
 (rijkolom)
 (command "-insert" "grid.dwg" pt3 schaal "" "")
 (command "-array" "l" "" "r" rij kolom spatie spatie)
 (geocoord)
 (Setvar "cmdecho" 1)
 (setvar "osmode" sm)
 (setvar "clayer" cl)
 (princ))



;Afronden op 10

(defun round10 ()
 (setq x1 (/ x0 10))
 (setq tekenx (if (< x0 0) -1 1))
 (setq x2 (fix (abs x1)))
 (setq x6 (if (< x0 0) (* 10 tekenx x2) (* 10 tekenx (+ x2 1))))
 (setq y1 (/ y0 10))
 (setq tekeny (if (< y0 0) -1 1))
 (setq y2 (fix (abs y1)))
 (setq y6 (if (< y0 0) (* 10 tekeny y2) (* 10 tekeny (+ y2 1)))))

;Afronden op 25

(defun round25 ()
 (setq x1 (/ x0 100))
 (setq tekenx (if (< x0 0) -1 1))
 (setq x2 (abs x1))
 (setq x3 (fix x2))
 (setq x4 (- x2 x3))
 (setq x5 (if (< x4 0.25) 0 (if (< x4 0.5) 0.25 (if (< x4 0.75) 0.5 0.75))))
 (setq x6 (if (< x0 0) (* 100 tekenx (+ x3 x5)) (* 100 tekenx (+ x3 x5 0.25))))
 (setq y1 (/ y0 100))
 (setq tekeny (if (< y0 0) -1 1))
 (setq y2 (abs y1))
 (setq y3 (fix y2))
 (setq y4 (- y2 y3))
 (setq y5 (if (< y4 0.25) 0 (if (< y4 0.5) 0.25 (if (< y4 0.75) 0.5 0.75))))
 (setq y6 (if (< y0 0) (* 100 tekeny (+ y3 y5)) (* 100 tekeny (+ y3 y5 0.25)))))

;Afronden op 50

(defun round50 ()
 (setq x1 (/ x0 100))
 (setq tekenx (if (< x0 0) -1 1))
 (setq x2 (abs x1))
 (setq x3 (fix x2))
 (setq x4 (- x2 x3))
 (setq x5 (if (< x4 0.5) 0.5 1))
 (setq x6 (if (< x0 0) (if (= x5 1) (* 100 tekenx (+ x3 0.5)) (* 100 tekenx x3))(* 100 tekenx (+ x3 x5))))
 (setq y1 (/ y0 100))
 (setq tekeny (if (< y0 0) -1 1))
 (setq y2 (abs y1))
 (setq y3 (fix y2))
 (setq y4 (- y2 y3))
 (setq y5 (if (< y4 0.5) 0.5 1))
 (setq y6 (if (< y0 0) (if (= y5 1) (* 100 tekeny (+ y3 0.5)) (* 100 tekeny y3))(* 100 tekeny (+ y3 y5)))))

;aantal kolommen en rijen bepalen

(defun rijkolom ()
 (setq rijmax (- (cadr pt2) y6))
 (setq kolommax (- (car pt2) x6))
 (setq rij (+ 1 (fix (/ rijmax spatie))))
 (setq kolom (+ 1 (fix (/ kolommax spatie)))))

;coordinaten plaatsen

(defun geocoord ()
 (setvar "dimstyle" "standard")
 (setvar "dimtxt" lh)
 (if (= linksrechts links) (links) (if (= linksrechts rechts) (rechts) (if (= linksrechts beide) (lr) )))
 (if (= bovenonder boven) (boven) (if (= bovenonder onder) (onder) (if (= bovenonder beide) (bo) ))))

(defun links ()
 (setq y7 (y6))
 (while (<= y7 (+ y6 (* rij schaal)))
   (setq pt4 (list x6 y7))
   (setq x7 (- x6 (* schaal orient)))
   (setq pt5 (list x7 y7))
   (command "_dimordinate" pt4 pt5)
   (command "explode" "l" "")
   (setq y7 (+ y7 spatie))))

(defun rechts ()
 (setq y7 (y6))
 (setq x8 (+ x6 (* rij schaal)))
 (while (<= y7 (+ y6 (* rij schaal)))
   (setq pt4 (list x8 y7))
   (setq x7 (+ x8 (* schaal orient)))
   (setq pt5 (list x7 y7))
   (command "_dimordinate" pt4 pt5)
   (command "explode" "l" "")    
   (setq y7 (+ y7 spatie))))

(defun onder ()
 (setq x7 (x6))
 (while (<= x7 (+ x6 (kolom schaal)))
   (setq pt4 (list x7 y6))
   (setq y7 (- y6 (* schaal orient)))
   (setq pt5 (list x7 y7))
   (command "_dimordinate" pt4 pt5)
   (command "explode" "l" "")
   (setq x7 (+ x7 spatie))))

(defun boven ()
 (setq x7 (x6))
 (setq y8 (+ y6 (* kolom schaal)))
 (while (<= x7 (+ x6 (kolom schaal)))
   (setq pt4 (list x7 y8 ))
   (setq y7 (- y8 (* schaal orient)))
   (setq pt5 (list x7 y7))
   (command "_dimordinate" pt4 pt5)
   (command "explode" "l" "")
   (setq x7 (+ x7 spatie))))

(defun lr ()
 (links)
 (rechts))

(defun bo ()
 (boven)
 (onder))
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op do 07 07 2005, 17:17:21
(setvar "dimstyle" "standard")

die is READ-ONLY,
euh uw programma lang, ja dat kan, ingewikkeld dat mss ook, maar als het doet wat het moet doen, dan is het goed genoeg!!

BTW, heeft dit toevallig te maken met Aquafin kaders voor schema polygonatie?
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op do 07 07 2005, 17:20:45
(if (= linksrechts links) (links) (if (= linksrechts rechts) (rechts) (if (= linksrechts beide) (lr) )))
(if (= bovenonder boven) (boven) (if (= bovenonder onder) (onder) (if (= bovenonder beide) (bo) ))))

moet zijn "Links" en "Rechts"
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op do 07 07 2005, 17:40:10
(defun c:geogrid (/ pt1 pt2 spatie schaal rijmax kolommax rij kolom claag x0 x1 x2 x3 x4 x5 x6 y0 y1 y2 y3 y4 y5 y6 tekenx tekeny pt3)
(setvar "cmdecho" 0)
(setq pt1 (getpoint "\nDuid de linkerbenedenhoek aan : "))
(setq pt2 (getcorner pt1 "\nDuid de rechterbovenhoek aan: "))
(setq spatie (getreal "\nGeef de tussenafstand (m): "))
(setq schaal (getreal "\nGeef de grootte van de kruisjes: "))
(initget 1 "Links Rechts Beide Geen")
(setq linksrechts (getkword "coördinaten Links, Rechts, aan Beide kanten of Geen? "))
(initget 1 "Boven Onder bEide Geen")
(setq bovenonder (getkword "coördinaten Boven, Onder, aan bEide kanten of Geen? "))
(initget 1 "bInnenkant bUitenkant _-1 1")
(setq orient (getkword "Coördinaten aan de bInnenkant of aan de bUitenkant van het grid? "))
(setq lh (getreal "Geef de letterhoogte van de coördinaten: "))
(setq x0 (car pt1))
(setq y0 (cadr pt1))
(if (= spatie 50) (round50) (if (= spatie 25) (round25) (round10)))
(setq sm (getvar "osmode"))
(setvar "osmode" 0)
(setq cl (getvar "clayer"))
(command "-layer" "m" "grid" "c" "8" "" "")
(setq pt3 (list x6 y6))
(rijkolom)
(command "-insert" "grid.dwg" pt3 schaal "" "")
(command "-array" "l" "" "r" rij kolom spatie spatie)
(geocoord)
(Setvar "cmdecho" 1)
(setvar "osmode" sm)
(setvar "clayer" cl)
(princ))



;Afronden op 10

(defun round10 ()
(setq x1 (/ x0 10))
(setq tekenx (if (< x0 0) -1 1))
(setq x2 (fix (abs x1)))
(setq x6 (if (< x0 0) (* 10 tekenx x2) (* 10 tekenx (+ x2 1))))
(setq y1 (/ y0 10))
(setq tekeny (if (< y0 0) -1 1))
(setq y2 (fix (abs y1)))
(setq y6 (if (< y0 0) (* 10 tekeny y2) (* 10 tekeny (+ y2 1)))))

;Afronden op 25

(defun round25 ()
(setq x1 (/ x0 100))
(setq tekenx (if (< x0 0) -1 1))
(setq x2 (abs x1))
(setq x3 (fix x2))
(setq x4 (- x2 x3))
(setq x5 (if (< x4 0.25) 0 (if (< x4 0.5) 0.25 (if (< x4 0.75) 0.5 0.75))))
(setq x6 (if (< x0 0) (* 100 tekenx (+ x3 x5)) (* 100 tekenx (+ x3 x5 0.25))))
(setq y1 (/ y0 100))
(setq tekeny (if (< y0 0) -1 1))
(setq y2 (abs y1))
(setq y3 (fix y2))
(setq y4 (- y2 y3))
(setq y5 (if (< y4 0.25) 0 (if (< y4 0.5) 0.25 (if (< y4 0.75) 0.5 0.75))))
(setq y6 (if (< y0 0) (* 100 tekeny (+ y3 y5)) (* 100 tekeny (+ y3 y5 0.25)))))

;Afronden op 50

(defun round50 ()
(setq x1 (/ x0 100))
(setq tekenx (if (< x0 0) -1 1))
(setq x2 (abs x1))
(setq x3 (fix x2))
(setq x4 (- x2 x3))
(setq x5 (if (< x4 0.5) 0.5 1))
(setq x6 (if (< x0 0) (if (= x5 1) (* 100 tekenx (+ x3 0.5)) (* 100 tekenx x3))(* 100 tekenx (+ x3 x5))))
(setq y1 (/ y0 100))
(setq tekeny (if (< y0 0) -1 1))
(setq y2 (abs y1))
(setq y3 (fix y2))
(setq y4 (- y2 y3))
(setq y5 (if (< y4 0.5) 0.5 1))
(setq y6 (if (< y0 0) (if (= y5 1) (* 100 tekeny (+ y3 0.5)) (* 100 tekeny y3))(* 100 tekeny (+ y3 y5)))))

;aantal kolommen en rijen bepalen

(defun rijkolom ()
(setq rijmax (- (cadr pt2) y6))
(setq kolommax (- (car pt2) x6))
(setq rij (+ 1 (fix (/ rijmax spatie))))
(setq kolom (+ 1 (fix (/ kolommax spatie)))))

;coordinaten plaatsen

(defun geocoord ()
;(setvar "dimstyle" "standard") ; deze is READ-ONLY!!!
(setvar "dimtxt" lh)
(if (= linksrechts "Links") (links) (if (= linksrechts "Rechts") (rechts) (if (= linksrechts "beide") (lr) ))) ; hoofdlettergevoelig!!
(if (= bovenonder "Boven") (boven) (if (= bovenonder "Onder") (onder) (if (= bovenonder "bEide") (bo) ))))  ; hoofdlettergevoelig!!

(defun links ()
(setq y7 y6) ; en niet (setq y7 (y6))
(while (<= y7 (+ y6 (* rij schaal)))
(setq pt4 (list x6 y7))
(setq x7 (- x6 (* schaal (atoi orient)))) ;string to integer
(setq pt5 (list x7 y7))
(command "_dimordinate" pt4 pt5)
(command "explode" "l" "")
(setq y7 (+ y7 spatie))))

(defun rechts ()
(setq y7 y6)  ; en niet (setq y7 (y6))
(setq x8 (+ x6 (* rij schaal)))
(while (<= y7 (+ y6 (* rij schaal)))
(setq pt4 (list x8 y7))
(setq x7 (+ x8 (* schaal (atoi orient))))  ;string to integer
(setq pt5 (list x7 y7))
(command "_dimordinate" pt4 pt5)
(command "explode" "l" "")
(setq y7 (+ y7 spatie))))

(defun onder ()
(setq x7 x6)  ; en niet (setq y7 (y6))
(while (<= x7 (+ x6 (* kolom schaal))) ;* vergeten
(setq pt4 (list x7 y6))
(setq y7 (- y6 (* schaal (atoi orient))))  ;string to integer
(setq pt5 (list x7 y7))
(command "_dimordinate" pt4 pt5)
(command "explode" "l" "")
(setq x7 (+ x7 spatie))))

(defun boven ()
(setq x7 x6)  ; en niet (setq y7 (y6))
(setq y8 (+ y6 (* kolom schaal)))
(while (<= x7 (+ x6 (* kolom schaal))) ;* vergeten
(setq pt4 (list x7 y8 ))
(setq y7 (- y8 (* schaal (atoi orient))))  ;string to integer
(setq pt5 (list x7 y7))
(command "_dimordinate" pt4 pt5)
(command "explode" "l" "")
(setq x7 (+ x7 spatie))))

(defun lr ()
(links)
(rechts))

(defun bo ()
(boven)
(onder))


heb ik momenteel als fouten, maar ik veronderstel dat het niet enkel bij het plaatsen van dat ene coordinaatje is... de while werkt dus nog niet...
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op do 07 07 2005, 18:04:23
(defun links ()
(setq y7 y6) ; en niet (setq y7 (y6))
(repeat rij ;while (<= y7 (+ y6 (* rij schaal)))
(setq pt4 (list x6 y7))
(setq x7 (- x6 (* schaal (atoi orient)))) ;string to integer
(setq pt5 (list x7 y7))
(command "_dimordinate" pt4 pt5)
(command "_explode" "l")
(setq y7 (+ y7 spatie))))

(defun rechts ()
(setq y7 y6)  ; en niet (setq y7 (y6))
(setq x8 (+ x6 (* rij schaal)))
(repeat rij ;while (<= y7 (+ y6 (* rij schaal)))
(setq pt4 (list x8 y7))
(setq x7 (+ x8 (* schaal (atoi orient))))  ;string to integer
(setq pt5 (list x7 y7))
(command "_dimordinate" pt4 pt5)
(command "_explode" "l")
(setq y7 (+ y7 spatie))))

(defun onder ()
(setq x7 x6)  ; en niet (setq y7 (y6))
(repeat kolom ;while (<= x7 (+ x6 (* kolom schaal))) ;* vergeten
(setq pt4 (list x7 y6))
(setq y7 (- y6 (* schaal (atoi orient))))  ;string to integer
(setq pt5 (list x7 y7))
(command "_dimordinate" pt4 pt5)
(command "_explode" "l")
(setq x7 (+ x7 spatie))))

(defun boven ()
(setq x7 x6)  ; en niet (setq y7 (y6))
(setq y8 (+ y6 (* kolom schaal)))
(repeat kolom ;while (<= x7 (+ x6 (* kolom schaal))) ;* vergeten
(setq pt4 (list x7 y8 ))
(setq y7 (- y8 (* schaal (atoi orient))))  ;string to integer
(setq pt5 (list x7 y7))
(command "_dimordinate" pt4 pt5)
(command "_explode" "l")
(setq x7 (+ x7 spatie))))


ziezo, dit werkt ...... velen beter, ik wil wel eens weten of dit met aquafinkaders te maken heeft voor schema polygonatie Sven!
want dan mag je geen 3 nullen na de komma hebben, en moet je coordinaat eindigen op een X of een Y, en ik denk dat ik dat eigenlijk ooit eens geschreven heb... enfin veel plezier
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op do 07 07 2005, 18:11:59
jep, zie je wel ik vond het terug..., is al paar jaarkens oud:

;Dit programma plaatst Grids en coordinaten van die grids...
;gemaakt voor raster aquafin van 50x50 voor schema polygonatie
;Hautekeete Olivier 05-03-2001
(defun c:grid1 (/ pt1 pt2 pt1x pt1y pt2x pt2y pt3x pt3y aantal_op_x aantal_op_y pta ptb1 ptb2)
 (setq pt1 (getpoint "\Geef hoekpunt1 op  "))
 (setq pt2 (getcorner pt1 "\Geef hoekpunt2 op  "))
 (setq pt1x (/ (fix (* (car pt1) 100)) 100))
 (setq pt1y (/ (fix (* (cadr pt1) 100)) 100))
 (setq pt2x (/ (fix (* (car pt2) 100)) 100))
 (setq pt2y (/ (fix (* (cadr pt2) 100)) 100))

 (if (> (rem pt1x 100) 50)
   (setq pt1x (+ (- pt1x (rem pt1x 100)) 100))
   (setq pt1x (+ (- pt1x (rem pt1x 100)) 50))
 )
 (setq pt3x pt1x)
 (setq pt4x pt1x)
 (if (> (rem pt1y 100) 50)
   (setq pt1y (+ (- pt1y (rem pt1y 100)) 100))
   (setq pt1y (+ (- pt1y (rem pt1y 100)) 50))
 )
 (setq pt3y pt1y)
 (setq pt4y pt1y)
 (if (> (rem pt2x 100) 50)
   (setq pt2x (+ (- pt2x (rem pt2x 100)) 100))
   (setq pt2x (+ (- pt2x (rem pt2x 100)) 50))
 )
 (if (> (rem pt2y 100) 50)
   (setq pt2y (+ (- pt2y (rem pt2y 100)) 100))
   (setq pt2y (+ (- pt2y (rem pt2y 100)) 50))
 )
 (setq aantal_op_x (/ (- pt2y pt1y) 50))
 (princ (strcat (rtos aantal_op_x 2 0) "-"))(princ)
 (setq aantal_op_y (/ (- pt2x pt1x) 50))
 (princ (strcat (rtos aantal_op_y 2 0) "--"))(princ)
 (repeat aantal_op_y
   (repeat aantal_op_x
     (setq pta (list pt1x pt1y))
           ;het aanmaken van een lijn
      (entmake (list '(0 . "LINE")            ;type entiteit
                 '(8 . "GRID")            ;laag
                '(6 . "CONTINUOUS")         ;lijntype
                       '(62 . 1)            ;kleur
                 (cons 10 (list (- pt1x 2.5) pt1y))   ;startpunt
                (cons 11 (list (+ pt1x 2.5) pt1y))   ;eindpunt
           )    
      );einde maken lijn1
      (entmake (list '(0 . "LINE")            ;type entiteit
                 '(8 . "GRID")            ;laag
                '(6 . "CONTINUOUS")         ;lijntype
                       '(62 . 1)            ;kleur
                 (cons 10 (list pt1x (+ pt1y 2.5)))   ;startpunt
                (cons 11 (list pt1x (- pt1y 2.5)))   ;eindpunt
           )    
      );einde maken lijn2
     (setq pt1y (+ pt1y 50))
   )
   (setq pt1x (+ pt1x 50))
   (setq pt1y (- pt1y (* aantal_op_x 50)))
 )
 (repeat aantal_op_y
   (setq ptb2 (list pt3x (- pt3y 10) 0.0))
   (setq ptb1 (list (- pt3x 2.5) (- pt3y 10) 0.0))
   (setq txt_x (strcat (itoa pt3x) ".00X"))
      ;het aanmaken van een tekst
      (entmake (list '(0 . "TEXT")         ;type entiteit
                       '(8 . "TEXT")         ;laag
                       (cons '10 ptb1)         ;tekst invoegpunt
                       (cons '11 ptb2)         ;tekst invoegpunt
                       '(40 . 5.0)         ;teksthoogte
                (cons '1 txt_x)          ;de tekst zelf
                       '(50 . 4.71239)         ;tekst rotatiehoek(in radialen)
                '(41 . 1.0)         ;relatieve x-schaalfactor
                       '(51 . 0.0)         ;helling (italic)
                '(7 . "Standard")      ;tekst stijlnaam
                       '(71 . 0)         ;flags
                '(72 . 0)         ;horizontale uitlijning
                '(73 . 2)         ;vertikale uitlijning
           )
      )
   (setq pt3x (+ pt3x 50))
 )
 (repeat aantal_op_x
   (setq ptb4 (list (- pt4x 10) pt4y 0.0))
   (setq ptb3 (list (- pt4x 10) (- pt4y 2.5) 0.0))
   (setq txt_y (strcat (itoa pt4y) ".00Y"))
      ;het aanmaken van een tekst
      (entmake (list '(0 . "TEXT")         ;type entiteit
                       '(8 . "TEXT")         ;laag
                       (cons '10 ptb3)         ;tekst invoegpunt
                       (cons '11 ptb4)         ;tekst invoegpunt
                       '(40 . 5.0)         ;teksthoogte
                (cons '1 txt_y)          ;de tekst zelf
                       '(50 . 0)         ;tekst rotatiehoek(in radialen)
                '(41 . 1.0)         ;relatieve x-schaalfactor
                       '(51 . 0.0)         ;helling (italic)
                '(7 . "Standard")      ;tekst stijlnaam
                       '(71 . 0)         ;flags
                '(72 . 2)         ;horizontale uitlijning
                '(73 . 2)         ;vertikale uitlijning
           )
      )
   (setq pt4y (+ pt4y 50))
 )
 (Princ "\nDone.")(Princ)
)
(Princ "\nProgrammatie : Hautekeete Olivier 05-03-2001")(princ)
(Princ "\nVoor info typ 'info_grid'")(princ)



(Defun c:info_grid (/)
(alert (Strcat "Geschreven door Hautekeete Olivier"
            "\n-----------------------------------------------------------------------"
    "\nDuid 2 punten aan en laat een raster tekenen van 50 op 50"
         "\n    Met benaming van grid-coördinaten vlg. aquafin 1997"
          "\n\t\tstart met 'GRID1'")
  )
)


veel plezier...  :pintje:
Titel: grid tekenen + coordinaten erbij
Bericht door: Sven op do 07 07 2005, 18:38:36
Bedankt voor de reactie, maar graag een woordje uitleg:

1) repeat rij of kolom: wat doet dit?
2) ATOI : wat doet dit?


oh, ja, het heeft niks met Aquafin te maken, maar mischien ken je de applicatie GEOPUS? We hebben hier slechts 1 licentie, en de meest gebruikte functies wil ik een beetje "namaken", ik heb namelijk de kans om onze dienst een beetje te "uniformiseren". De routine die jij geeft is enkel voor 50*50, ik wou een iets uitgebreidere versie maken.

Kan er trouwens iemend met dialoogboxen werken via lisp?
Titel: grid tekenen + coordinaten erbij
Bericht door: Kenny H op do 07 07 2005, 18:42:39
Plaats gewoon uw wat ge wilt bereiken.
We zullen wel  tot een resultaat komen  :wink:

Ps ik kan overweg met dialoogboxen.
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op do 07 07 2005, 18:54:01
Sven, Atoi = Alfanummeriek TO Integer
En je berekende de variabelen rij en kolom, dan kan je ze gebruiken voor een repeat... een herhaalfunctie...
(repeat 7
(princ "Ollie is the best")(princ)
)
herhaald 7 keer die machtige zin.....
en in 'kolom' 'n 'rij' zaten je aantal kolommen en rijen...

En ja ik ken Geopus van binnen en van buiten,
jij zit dus op een landmetersbureau in Lochristie...
En ik daar zijn er niet veel.....
Titel: grid tekenen + coordinaten erbij
Bericht door: Sven op do 07 07 2005, 20:28:16
CiteerEn ja ik ken Geopus van binnen en van buiten,
jij zit dus op een landmetersbureau in Lochristie...
En ik daar zijn er niet veel.....


Ik woon wel in Lochristi, maar ik werk niet in Lochristi :wink:

Van waar ken jij Geopus? gebruik je het ook?
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op do 07 07 2005, 23:48:41
WebRacer hier, het is zalden, maar ik kom straal beopen thuis...
ik ken Geopus omdat ik het 2 jaar terug, hmm, geherformuleerd gebruik... ik gebruik het nijna wekelijks... ok je werkt niet in Lochristie... maar ik voel dat je in de branche zit dat ik zit.... gelieve eens te mailen of msn te gebruiken voor meer info... slaapwel en tot morgen..
t'is bijna congé olé olé....
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op vr 08 07 2005, 16:34:45
WebRacer wil zich excuseren voor de hierboven uitgekraamde reactie....
Ik was licht aangeschoten en kon mijn toetsen blijkbaar niet goed meer vinden... :oops:  :oops:  :oops:
Titel: grid tekenen + coordinaten erbij
Bericht door: julien op vr 08 07 2005, 17:02:50
Citaat van: WebRacerWebRacer wil zich excuseren voor de hierboven uitgekraamde reactie....
Ik was licht aangeschoten en kon mijn toetsen blijkbaar niet goed meer vinden... :oops:  :oops:  :oops:
Alé, voor ene keer.  :wink:



hips
Titel: grid tekenen + coordinaten erbij
Bericht door: Sven op vr 08 07 2005, 17:27:28
Ik hoop dat ze gesmaakt hebben  :D
Titel: grid tekenen + coordinaten erbij
Bericht door: Kenny H op za 09 07 2005, 11:25:05
;Dit programma plaatst Grids en coordinaten van die grids...
               ;gemaakt voor raster op uw eigen grootte
               ;Hautekeete Olivier & Habils Kenny 09-07-2005

(defun c:grid2 (/    pt1     pt2      pt1x       pt1y     pt2x
      pt2y    pt3x     pt3y      aantal_op_x        aantal_op_y
      pta    ptb1     ptb2
          )
 (setq pt1 (getpoint "\Geef hoekpunt1 op "))
 (setq pt2 (getcorner pt1 "\Geef hoekpunt2 op "))
 (setq
   afx   (getdist "\Geef een maat op voor de x afstand:")
 )
 (setq
   afy   (getdist "\Geef een maat op voor de y afstand:")
 )
 (setq pt1x (/ (fix (* (car pt1) 100)) 100))
 (setq pt1y (/ (fix (* (cadr pt1) 100)) 100))
 (setq pt2x (/ (fix (* (car pt2) 100)) 100))
 (setq pt2y (/ (fix (* (cadr pt2) 100)) 100))
 (setq pt3x pt1x)
 (setq pt4x pt1x)
 (setq pt3y pt1y)
 (setq pt4y pt1y)
 (setq aantal_op_x (/ (- pt2x pt1x) afx))
 (setq absmaat (abs aantal_op_x))
 (if (>= (- absmaat (fix absmaat)) 0.5)
   (setq aantal_op_x (fix (1+ absmaat)))
   (setq aantal_op_x (fix absmaat))
 )
 (princ (strcat (rtos aantal_op_x 2 0) "-"))
 (princ)
 (setq aantal_op_y (/ (- pt2y pt1y) afy))
 (setq absmaat (abs aantal_op_y))
 (if (>= (- absmaat (fix absmaat)) 0.5)
   (setq aantal_op_y (fix (1+ absmaat)))
   (setq aantal_op_y (fix absmaat))
 )
 (princ (strcat (rtos aantal_op_y 2 0) "--"))
 (princ)
 (repeat aantal_op_y
   (repeat aantal_op_x
     (setq pta (list pt1x pt1y))
               ;het aanmaken van een lijn
     (entmake
   (list '(0 . "LINE")      ;type entiteit
         '(8 . "GRID")      ;laag
         '(6 . "CONTINUOUS")   ;lijntype
         '(62 . 1)         ;kleur
         (cons 10 (list (- pt1x 2.5) pt1y)) ;startpunt
         (cons 11 (list (+ pt1x 2.5) pt1y)) ;eindpunt
   )
     )               ;einde maken lijn1
     (entmake
   (list '(0 . "LINE")      ;type entiteit
         '(8 . "GRID")      ;laag
         '(6 . "CONTINUOUS")   ;lijntype
         '(62 . 1)         ;kleur
         (cons 10 (list pt1x (+ pt1y 2.5))) ;startpunt
         (cons 11 (list pt1x (- pt1y 2.5))) ;eindpunt
   )
     )               ;einde maken lijn2
     (setq pt1y (+ pt1y afy))
   )
   (setq pt1x (+ pt1x afx))
   (setq pt1y (- pt1y (* aantal_op_x afy)))
 )

 (repeat aantal_op_y
   (setq ptb2 (list pt3x (- pt3y 10) 0.0))
   (setq ptb1 (list (- pt3x 2.5) (- pt3y 10) 0.0))
   (setq txt_x (strcat (itoa pt3x) ".00X"))
               ;het aanmaken van een tekst
   (entmake (list '(0 . "TEXT")   ;type entiteit
         '(8 . "TEXT")   ;laag
         (cons '10 ptb1)   ;tekst invoegpunt
         (cons '11 ptb2)   ;tekst invoegpunt
         '(40 . 5.0)      ;teksthoogte
         (cons '1 txt_x)   ;de tekst zelf
         '(50 . 4.71239)   ;tekst rotatiehoek(in radialen)
         '(41 . 1.0)      ;relatieve x-schaalfactor
         '(51 . 0.0)      ;helling (italic)
         '(7 . "Standard")   ;tekst stijlnaam
         '(71 . 0)      ;flags
         '(72 . 0)      ;horizontale uitlijning
         '(73 . 2)      ;vertikale uitlijning
        )
   )
   (setq pt3x (+ pt3x afx))
 )
 (repeat aantal_op_x
   (setq ptb4 (list (- pt4x 10) pt4y 0.0))
   (setq ptb3 (list (- pt4x 10) (- pt4y 2.5) 0.0))
   (setq txt_y (strcat (itoa pt4y) ".00Y"))
               ;het aanmaken van een tekst
   (entmake (list '(0 . "TEXT")   ;type entiteit
         '(8 . "TEXT")   ;laag
         (cons '10 ptb3)   ;tekst invoegpunt
         (cons '11 ptb4)   ;tekst invoegpunt
         '(40 . 5.0)      ;teksthoogte
         (cons '1 txt_y)   ;de tekst zelf
         '(50 . 0)      ;tekst rotatiehoek(in radialen)
         '(41 . 1.0)      ;relatieve x-schaalfactor
         '(51 . 0.0)      ;helling (italic)
         '(7 . "Standard")   ;tekst stijlnaam
         '(71 . 0)      ;flags
         '(72 . 2)      ;horizontale uitlijning
         '(73 . 2)      ;vertikale uitlijning
        )
   )
   (setq pt4y (+ pt4y afy))
 )
 (Princ "\nDone.")
 (Princ)
)
(Princ
 "\nProgrammatie : Hautekeete Olivier & Habils Kenny 09-06-2005"
)
(princ)
(Princ "\nVoor info typ 'info_grid'")
(princ)

EDIT

Juist programma staat op volgende pag  :wink:
Titel: grid tekenen + coordinaten erbij
Bericht door: Kenny H op za 09 07 2005, 11:26:37
Er is echter nog 1 klein probleem. Hij plaatst die coordinaten niet.
Ziet iemand de fout? Ik vind ze niet meteen.

De fout zou zich hier ergens in bevinden



Citeer(repeat aantal_op_y
   (setq ptb2 (list pt3x (- pt3y 10) 0.0))
   (setq ptb1 (list (- pt3x 2.5) (- pt3y 10) 0.0))
   (setq txt_x (strcat (itoa pt3x) ".00X"))
               ;het aanmaken van een tekst
   (entmake (list '(0 . "TEXT")   ;type entiteit
         '(8 . "TEXT")   ;laag
         (cons '10 ptb1)   ;tekst invoegpunt
         (cons '11 ptb2)   ;tekst invoegpunt
         '(40 . 5.0)      ;teksthoogte
         (cons '1 txt_x)   ;de tekst zelf
         '(50 . 4.71239)   ;tekst rotatiehoek(in radialen)
         '(41 . 1.0)      ;relatieve x-schaalfactor
         '(51 . 0.0)      ;helling (italic)
         '(7 . "Standard")   ;tekst stijlnaam
         '(71 . 0)      ;flags
         '(72 . 0)      ;horizontale uitlijning
         '(73 . 2)      ;vertikale uitlijning
        )
   )
   (setq pt3x (+ pt3x afx))
 )
 (repeat aantal_op_x
   (setq ptb4 (list (- pt4x 10) pt4y 0.0))
   (setq ptb3 (list (- pt4x 10) (- pt4y 2.5) 0.0))
   (setq txt_y (strcat (itoa pt4y) ".00Y"))
               ;het aanmaken van een tekst
   (entmake (list '(0 . "TEXT")   ;type entiteit
         '(8 . "TEXT")   ;laag
         (cons '10 ptb3)   ;tekst invoegpunt
         (cons '11 ptb4)   ;tekst invoegpunt
         '(40 . 5.0)      ;teksthoogte
         (cons '1 txt_y)   ;de tekst zelf
         '(50 . 0)      ;tekst rotatiehoek(in radialen)
         '(41 . 1.0)      ;relatieve x-schaalfactor
         '(51 . 0.0)      ;helling (italic)
         '(7 . "Standard")   ;tekst stijlnaam
         '(71 . 0)      ;flags
         '(72 . 2)      ;horizontale uitlijning
         '(73 . 2)      ;vertikale uitlijning
        )
   )
   (setq pt4y (+ pt4y afy))
 )
Titel: grid tekenen + coordinaten erbij
Bericht door: Kenny H op za 09 07 2005, 11:44:25
Sorry maar er zitten nog een paar foutjes in het programma.

Ik ga eens opnieuw beginnen. :evil:
Titel: grid tekenen + coordinaten erbij
Bericht door: Kenny H op za 09 07 2005, 12:42:58
Mijn verdeling klopt al.
Voor de coordinaten te plaatsen zal ik vanavond proberen posten. Heb nu andere verplichtingen.

edit. Ik heb mijn programma gewist aangezien er nog fouten instonden.
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op zo 10 07 2005, 01:09:43
euh, kenny even snel gekeken, er loopt precies wel meer fout...
Maar ik zou opteren voor deze verandering: ipv getdist -> getint !!

(setq afx (getint "\nGeef een maat op voor de x afstand:"))
(setq afy (getint "\nGeef een maat op voor de y afstand:"))

maar bij tekent hij de grid dus niet goed!!!
ik heb helaas even geen tijd, pas dit even aan, en bekijk het verder, en Kenny, gelieve het volledige programma niet meer te posten vooraleer het volledig werkt, het overbelast de forum een beetje met veel lisp-taal!

slaapwel en tot horens...
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op zo 10 07 2005, 01:13:29
ja kenny, net voor ik acad afsloot nog kleine test gedaan:

hij draaid ergens de aantal_op_x en aantal_op_y om bij het programma,
kijk jij even waar, vandaar dat ie de grid niet goed tekent, de coordinaten plaatst hij wel...
Titel: grid tekenen + coordinaten erbij
Bericht door: Kenny H op zo 10 07 2005, 11:12:41
Dag webracer,

Het probleem zat hem idd bij die aantal x en y.

Bij die getdist zat er ook nog een probleem. Met getint is dit probleem opgelost.
Als ik met getdist werkt kon ik die coordinaten niet plaatsen. Raar maar waar. Hij accepteerde dit gewoon niet.
Met getint werkte het PERFECT.

Sorry voor enig ongemak aangezien ik gisteren dit ook vlug probeerde te maken. :oops:  Haast en spoed is zelden goed  :wink: . En dat geeft idd problemen. Beter rustig een programma schrijven :!:


Programma.
Citeer;;;Dit programma plaatst Grids en coordinaten van die grids...
;;;gemaakt voor raster volgens willekeure afstanden
;;;Hautekeete Olivier & Habils Kenny op 10-06-2005



(defun c:grid2 (  /
      pt1     pt2      pt1x       pt1y     pt2x
      pt2y    pt3x     pt3y      aantal_op_x        aantal_op_y
      pta    ptb1     ptb2
          )
 (setq pt1 (getpoint "\nGeef hoekpunt1 op "))
 (setq pt2 (getcorner pt1 "\nGeef hoekpunt2 op "))
 (setq
   afx   (getint "\nGeef een maat op voor de x afstand:")
 )
 (setq
   afy   (getint "\nGeef een maat op voor de y afstand:")
 )
 (setq pt1x (/ (fix (* (car pt1) 100)) 100))
 (setq pt1y (/ (fix (* (cadr pt1) 100)) 100))
 (setq pt2x (/ (fix (* (car pt2) 100)) 100))
 (setq pt2y (/ (fix (* (cadr pt2) 100)) 100))
 (setq pt3x pt1x)
 (setq pt4x pt1x)
 (setq pt3y pt1y)
 (setq pt4y pt1y)
 (setq aantalx (/ (- pt2x pt1x) afx))
 (setq absmaat (abs aantalx))
 (if (>= (- absmaat (fix absmaat)) 0.5)
   (setq aantal_op_x (fix (+ absmaat 2)))
   (setq aantal_op_x (fix (1+ absmaat)))
 )

 (setq aantaly (/ (- pt2y pt1y) afy))
 (setq absmaat (abs aantaly))
 (if (>= (- absmaat (fix absmaat)) 0.5)
   (setq aantal_op_y (fix (+ absmaat 2)))
   (setq aantal_op_y (fix (1+ absmaat)))
 )


 (repeat aantal_op_x
   (repeat aantal_op_y
     (setq pta (list pt1x pt1y))
               ;het aanmaken van een lijn
     (entmake
   (list '(0 . "LINE")      ;type entiteit
         '(8 . "GRID")      ;laag
         '(6 . "CONTINUOUS")   ;lijntype
         '(62 . 1)         ;kleur
         (cons 10 (list (- pt1x 2.5) pt1y)) ;startpunt
         (cons 11 (list (+ pt1x 2.5) pt1y)) ;eindpunt
   )
     )               ;einde maken lijn1
     (entmake
   (list '(0 . "LINE")      ;type entiteit
         '(8 . "GRID")      ;laag
         '(6 . "CONTINUOUS")   ;lijntype
         '(62 . 1)         ;kleur
         (cons 10 (list pt1x (+ pt1y 2.5))) ;startpunt
         (cons 11 (list pt1x (- pt1y 2.5))) ;eindpunt
   )
     )               ;einde maken lijn2
     (setq pt1y (+ pt1y afy))
   )
   (setq pt1x (+ pt1x afx))
   (setq pt1y (- pt1y (* aantal_op_y afy)))
 )

 (repeat aantal_op_x
   (setq ptb2 (list pt3x (- pt3y 10) 0.0))
   (setq ptb1 (list (- pt3x 2.5) (- pt3y 10) 0.0))
   (setq txt_x (strcat (itoa pt3x) ".00X"))
               ;het aanmaken van een tekst
   (entmake (list '(0 . "TEXT")   ;type entiteit
         '(8 . "TEXT")   ;laag
         (cons '10 ptb1)   ;tekst invoegpunt
         (cons '11 ptb2)   ;tekst invoegpunt
         '(40 . 5.0)      ;teksthoogte
         (cons '1 txt_x)   ;de tekst zelf
         '(50 . 4.71239)   ;tekst rotatiehoek(in radialen)
         '(41 . 1.0)      ;relatieve x-schaalfactor
         '(51 . 0.0)      ;helling (italic)
         '(7 . "Standard")   ;tekst stijlnaam
         '(71 . 0)      ;flags
         '(72 . 0)      ;horizontale uitlijning
         '(73 . 2)      ;vertikale uitlijning
        )
   )
   (setq pt3x (+ pt3x afx))      
 )
 (repeat aantal_op_y
   (setq ptb4 (list (- pt4x 10) pt4y 0.0))
   (setq ptb3 (list (- pt4x 10) (- pt4y 2.5) 0.0))
   (setq txt_y (strcat (itoa pt4y) ".00Y"))
               ;het aanmaken van een tekst
   (entmake (list '(0 . "TEXT")   ;type entiteit
         '(8 . "TEXT")   ;laag
         (cons '10 ptb3)   ;tekst invoegpunt
         (cons '11 ptb4)   ;tekst invoegpunt
         '(40 . 5.0)      ;teksthoogte
         (cons '1 txt_y)   ;de tekst zelf
         '(50 . 0)      ;tekst rotatiehoek(in radialen)
         '(41 . 1.0)      ;relatieve x-schaalfactor
         '(51 . 0.0)      ;helling (italic)
         '(7 . "Standard")   ;tekst stijlnaam
         '(71 . 0)      ;flags
         '(72 . 2)      ;horizontale uitlijning
         '(73 . 2)      ;vertikale uitlijning
        )
   )
   (setq pt4y (+ pt4y afy))      
 )

 (Princ "\nDone.")
 (Princ)
)
(Princ
 "\nProgrammatie : Hautekeete Olivier & HAbils Kenny 09-06-2005"
)
(princ)
(Princ "\nVoor info typ 'info_grid'")
(princ)

(Defun c:info_grid (/)
 (alert
   (Strcat
     "Geschreven door Hautekeete Olivier & Habils Kenny"
     "\n-----------------------------------------------------------------------"
     "\nDuid 2 punten aan en geef de maten op voor de tussen afstanden"
     "\n\t\tstart met 'GRID2'"
   )
 )
)

:idea: Indien er nog problemen zijn meld mij dit dan :!:
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op zo 10 07 2005, 17:54:30
Kenny,
je mag en kan gerust GETDIST gebruiken, maar dan moet je van die verkregen REAL-getal een INTEGER maken, want daarvoor is het programma gemaakt.... afgeronde grids tekenen op regelmatige afstand, en met reals lukt dit nooit, dus indien je GETDIST gebruikt moet je ook FIX gebruiken om er een integer van te maken...

dit zou ik alvast nog aanpassen...\n = nieuwe lijn in commando bar
(setq pt1 (getpoint "\nGeef hoekpunt1 op "))
(setq pt2 (getcorner pt1 "\nGeef hoekpunt2 op "))
(setq afx (getint "\nGeef een maat op voor de x afstand:"))
(setq afy (getint "\nGeef een maat op voor de y afstand:"))

NOTA:
Als je er een DCL bij maakt met daarin:
Laagkeuze,kleur van de punten
Laagkeuze,kleur van de text
Gridafstan X en Y
Text-hoogte
Grid-lengte
dan heb je een mooier en betere lisp geschreven dan het 'geogrid' van GeopPus. Maar het werkt en das het belangrijkste....

Een dikke proficiat aan Kenny om het programma aan te passen naar gebruik voor iedereen, ipv enkel 50x50 grid te realiseren,
en ook aan mezelve om de basis zomaar weg te geven.... :roll:
Titel: grid tekenen + coordinaten erbij
Bericht door: Kenny H op zo 10 07 2005, 18:26:47
Ik heb het programma aangepast.
Als men dat echt wenst zo een dcl met alle moegelijkheden dan moet men dit hier even vermelden. Ik zal dit met volle overtuiging proberen te maken.

@ Webracer:

Gij ook bedankt voor mij te wijzen op de fouten en daar dan een oplossing voor te geven.
Het is dan ook zéér lief van u om dit programma zomaar prijs te geven.
Nog een prettige avond.
Titel: grid tekenen + coordinaten erbij
Bericht door: HofCAD op di 12 07 2005, 12:06:15
Beste Kenny en WebRacer,

Ik weet niet goed, waarvoor jullie programma gebruikt kan worden. :o
Wel heb ik een grote waardering, voor julie inzet. :D
Mijn vraag is eigenlijk, waarom gebruiken jullie losse lijntjes als
markering en is onderstaand programma ook geschikt voor het beoogde
doel?
Hopelijk zien jullie zelf wel, wat ik geknoeid heb met jullie versie. :oops:

Groetjes HofCAD CSI

;;;
;;; Ascii Text error handler
;;;
(defun $GridError (msg)   ; If an error (such as CTRL-C or ESC) occurs
            ; while this command is active...
 (if (and (/= msg "Function cancelled")
      (/= msg "quit / exit abort")
     )
   (princ (strcat "\nError: " msg))
 )
 ($GridModer)            ; Restore modified modes
 (setq *error* olderr)         ; Restore old *error* handler
 (princ)
)
;;;
;;; Save modes
;;;
(defun $GridModes (a)
 (setq   MLST '
         ()
 )
 (repeat (length a)
   (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
   (setq a (cdr a))
 )
)
;;;
;;; Restore modes
;;;
(defun $GridModer ()
 (repeat (length MLST)
   (setvar (caar MLST) (cadar MLST))
   (setq MLST (cdr MLST))
 )
)
;;;
;;; Numeric round
;;;
(defun Round50fix (num / numtek Signof)
;; Signof - returns -1 or 1 for sign of number
(defun Signof (num) (if (minusp num) -1 1))
(setq numtek (Signof num) num (abs num))
(if (>= (- num (fix num)) 0.5)
(setq num (fix (1+ num)))
(setq num (fix num))
)
(setq num (* numtek num))
)
;;;
;;; Main program
;;;
(defun c:grid4 ( /
pt1 pt2 afx afy pt1x pt1y pt2x pt2y pt3x pt3y aantal_op_x aantal_op_y
pta ptb1 ptb2 mtype e1 e2 txt_x txt_y
)
(setq   olderr *error* ; Save old *error* handler
*error* $GridError     ; Set new *error* handler to lokal
)
($GridModes '("CMDECHO" "CLAYER" "LIMCHECK" "OSMODE" "TEXTSTYLE"))
(setvar "CMDECHO" 0)(setvar "LIMCHECK" 0)(setvar "OSMODE" 0)
(setq pt1 (getpoint "\nGeef linker onderhoekpunt op:\n"))
(setq pt2 (getcorner pt1 "\nGeef rechter bovenhoekpunt op:\n"))
(initget 7)
(setq afx (getint "\nGeef een gehele maat op voor de tussenafstand in de X-richting:\n"))
(initget 7)
(setq afy (getint "\nGeef een gehele maat op voor de tussenafstand in de Y-richting:\n"))
(initget 1 "Point Block Circle Line")
(setq mtype ;markeringstype
(getkword "\nVoor markering een Point, Block, Circle of Line gebruiken?[P/B/C/L]:\n")
)
(if (not (tblsearch "LAYER" "GRID"));bestaat de laag?
(command "_LAYER" "M" "GRID" "C" "RED" "" "")
(command "_LAYER" "T" "GRID" "ON" "GRID" "S" "GRID" "")
)
(setq pt1x (* (round50fix (/ (car pt1) (float afx))) afx))
(setq pt1y (* (round50fix (/ (cadr pt1) (float afy))) afy))
(setq pt2x (* (round50fix (/ (car pt2) (float afx))) afx))
(setq pt2y (* (round50fix (/ (cadr pt2) (float afy))) afy))
(setq pt3x (fix pt1x))
(setq pt3y (fix pt1y))
(setq aantal_op_x (1+ (round50fix (/ (- pt2x pt1x) afx))))
(setq aantal_op_y (1+ (round50fix (/ (- pt2y pt1y) afy))))
(if (= mtype "Point");points
(progn
(command "_POINT" (list pt1x pt1y))
(setq e1 (entlast))
(setvar "PDMODE" 2)
(setvar "PDSIZE" 2.5)
(command "_ARRAY" e1 "" "R" aantal_op_y aantal_op_x afy afx)
));**************einde type Point
(if (= mtype "Block");blockrefs
(progn
(if (not (tblsearch "BLOCK" "gripmark"))
(progn
(entmake (list '(0 . "BLOCK") (cons 2 "gripmark");(cons 62 5)
'(70 . 64) '(10 0.0 0.0 0.0)))
(entmake
(list '(0 . "LINE") ;type entiteit
'(8 . "GRID") ;laag
'(10 -2.5 0.0 0.0) ;startpunt
'(11 2.5 0.0 0.0);eindpunt
)
);einde maken lijn1
(entmake
(list '(0 . "LINE") ;type entiteit
'(8 . "GRID") ;laag
'(10 0.0 -2.5 0.0) ;startpunt
'(11 0.0 2.5 0.0);eindpunt
)
) ;einde maken lijn2
(entmake '((0 . "ENDBLK")))))
(command "_INSERT" "GRIPMARK" (list pt1x pt1y) 1 1 0)
(setq e1 (entlast))
(command "_ARRAY" e1 "" "R" aantal_op_y aantal_op_x afy afx)
));**************einde type Block
(if (= mtype "Circle")
(progn
(command "_CIRCLE" (list pt1x pt1y) "D" "2")
(setq e1 (entlast))
(command "_ARRAY" e1 "" "R" aantal_op_y aantal_op_x afy afx)
));**************einde type Circle
(if (= mtype "Line")
(progn
(command "_LINE" (list (- pt1x 2.5) pt1y)(list (+ pt1x 2.5) pt1y) "")
(setq e1 (entlast))
(command "_LINE" (list pt1x (+ pt1y 2.5))(list pt1x (- pt1y 2.5)) "")
(setq e2 (entlast))
(command "_ARRAY" e1 e2 "" "R" aantal_op_y aantal_op_x afy afx)
));**************einde type Line
(repeat aantal_op_x
(setq ptb2 (list pt1x (- pt1y 10) 0.0))
(setq ptb1 (list (- pt1x 2.5) (- pt1y 10) 0.0))
(setq txt_x (strcat (itoa pt1x) ".00X"))
;het aanmaken van een tekst
(entmake (list '(0 . "TEXT") ;type entiteit
'(8 . "TEXT") ;laag
(cons '10 ptb1) ;tekst invoegpunt
(cons '11 ptb2) ;tekst invoegpunt
'(40 . 5.0) ;teksthoogte
(cons '1 txt_x) ;de tekst zelf
'(50 . 4.71239) ;tekst rotatiehoek(in radialen)
'(41 . 1.0) ;relatieve x-schaalfactor
'(51 . 0.0) ;helling (italic)
'(7 . "Standard") ;tekst stijlnaam
'(71 . 0) ;flags
'(72 . 0) ;horizontale uitlijning
'(73 . 2) ;vertikale uitlijning
)
)
(setq pt1x (+ pt1x afx))
)
(repeat aantal_op_y
(setq ptb4 (list (- pt3x 10) pt3y 0.0))
(setq ptb3 (list (- pt3x 10) (- pt3y 2.5) 0.0))
(setq txt_y (strcat (itoa pt3y) ".00Y"))
;het aanmaken van een tekst
(entmake (list '(0 . "TEXT") ;type entiteit
'(8 . "TEXT") ;laag
(cons '10 ptb3) ;tekst invoegpunt
(cons '11 ptb4) ;tekst invoegpunt
'(40 . 5.0) ;teksthoogte
(cons '1 txt_y) ;de tekst zelf
'(50 . 0) ;tekst rotatiehoek(in radialen)
'(41 . 1.0) ;relatieve x-schaalfactor
'(51 . 0.0) ;helling (italic)
'(7 . "Standard") ;tekst stijlnaam
'(71 . 0) ;flags
'(72 . 2) ;horizontale uitlijning
'(73 . 2) ;vertikale uitlijning
)
)
(setq pt3y (+ pt3y afy))
)
($GridModer)           ; Restore modified modes
(setq *error* olderr)   ; Restore old *error* handler
(Princ "\nDone.")
(Princ)
)
(Princ
"\nProgrammatie : Hautekeete Olivier & HAbils Kenny & HofCAD 13-07-2005"
)
(princ)
(Princ "\nVoor info typ 'info_grid'")
(princ)
;;;
;;; Info program
;;;
(Defun c:info_grid (/)
(alert
(Strcat
"Geschreven door Hautekeete Olivier & Habils Kenny & HofCAD"
"\n-----------------------------------------------------------------------"
"\nDuid 2 punten aan en geef de maten op voor de tussen afstanden"
"\n\t\tstart met 'GRID4'"
)
)
)
Titel: Re: grid tekenen + coordinaten erbij
Bericht door: WebRacer op di 12 07 2005, 12:20:12
Citaat van: Svenik heb dankbaar gebruik kunnen maken van het onderwerp "getal afronden" .
Nu heb ik een routine geschreven waarbij ik een grid wil tekenen -> dit lukt  8)  8)
Toen ik het echter wou uitbreiden om er aan de zijkant ook de coordinaten bij te plaatsen gaat er echter iets fout. Het grid tekent hij nog, maar de coordinaten komen er nog niet bij  :evil:
1) kan iemand mij zeggen waar het fout gaat? Liefst eerst zonder vraag 2 te beantwoorden. (lange versie dus, die versta ik nog)
2) waarschijnlijk kan dit ook korter, maar zo gevorderd ben ik nog niet. Kan iemand mij zeggen hoe dit korter kan?
tja, omdat beste Hofcad er een eenvoudige vraag gesteld werd, en wij er gewoon op verder gewerkt hebben, nl. Een GRID-raster laten uittekenen met de daarbijhorende coördinaten.
Ik had namelijk al een gelijkaardig programma, die ik regelmatig nodig heb en die geschreven is volgens de richtlijnen van die klant....
en zo hebben we dan van een vast raster 50x50, zonder veel te rotzooien enkel aanpassingen gedaan zodat het algemener werd.
Nu heb jij het eigenlijk al bijna tot een professioneel programma gedoopt,
dat is wat wij deze week gepland hadden, het daarna te beveiligen en op de LispDownload pagina te zetten...
Dus: het gevraagde werd meer dan opgelost voor Sven, en er werd uitgebreid doorgelispt op de basis....


Met dank aan allen die het programma perfectioneerden
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op di 12 07 2005, 20:56:38
Hoi Hofcad, ik heb het even bekeken het programma en dit is wat ik vond:(setq type (getkword "\nVoor markering een Point, Block of Line gebruiken?[P/B/L]:\n" ))
En Type is een gereserveerd KeyWord in visual lisp, dus dit kan je niet gebruiken, voor de rest ziet het er fijn uit....
Even Vermelden: Kenny is bezig met er een dialoogbox bij rond te maken....

Hoi Kenny, zoals je ziet heb ik het kleine foutje gevonden waar hij blokkeert, en rekenen wij op een DCL'leken er bij.
ik keek even naar uw sneak-versie en dit zijn mijn opmerkingen daarover:
1. Bij Geef een laag zou ik ze laten kiezen uit een bestaande laag of een eventuele nieuwe, zoals in mijn 'Coördinaten.lsp"
2. kleur kiezen niet uit keuze menu maar uit kleurdialoogvenster, zoals ook in mijn 'Coördinaten.lsp'
3. Eventueel nog de grootte van de Grids bij in opnemen....

Veel geluk, veel plezier... tot horens....

WebRacer
Titel: grid tekenen + coordinaten erbij
Bericht door: Sven op wo 13 07 2005, 08:03:07
Bedankt allemaal voor de snelle hulp en het verbeteren van het programma. Toch heb ik nog 1 wens bij dit programma. Het stoort me namelijk dat ,bij een tussenafstand van 10 en het willekeurig prikken van een eerste punt (171.56,256.89), de coordinaten komen op 172.00 en 257.00.
Volgens mij hoort een grid van 10 te komen op (180,260). dit had ik in mijn eerste versie proberen opvangen met de subroutines round10, round25 en round50. Ziet er iemand een mogelijkheid om dit deel te verbeteren? :?:
Titel: grid tekenen + coordinaten erbij
Bericht door: HofCAD op wo 13 07 2005, 11:06:55
Citaat van: SvenBedankt allemaal voor de snelle hulp en het verbeteren van het programma. Toch heb ik nog 1 wens bij dit programma. Het stoort me namelijk dat ,bij een tussenafstand van 10 en het willekeurig prikken van een eerste punt (171.56,256.89), de coordinaten komen op 172.00 en 257.00.
Volgens mij hoort een grid van 10 te komen op (180,260). dit had ik in mijn eerste versie proberen opvangen met de subroutines round10, round25 en round50. Ziet er iemand een mogelijkheid om dit deel te verbeteren? :?:

Beste Kenny, Sven en WebRacer,

Als jullie veel tijd hebben, ondanks de vakantieperikelen, wil ik jullie
aub vragen kritiek te leveren op bovenstaande nieuwe versie GRID4.
Want ik heb weer zitten knoeien. :oops:

Groetjes HofCAD CSI

PS1
Beste WebRacer nog een bedankje voor het bestuderen van mijn
vorige versie, en sorry voor de grove fout. :oops:
PS2 Jullie methode om met repeat en entmake te werken bij de
kruisjes, is natuurlijk sneller :oops:
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op wo 13 07 2005, 16:54:16
ik kijk straks even naar uw nieuwe versie...
Euh Hofcad, ik werk zoveel mogelijk met entmake en repeat, om snelheid te halen en miserie te mijden, command array ook niet slecht en ook snel...
kwestie van gebruiken en gewoontes...
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op wo 13 07 2005, 18:31:16
Citaat van: HofCAD
(setq pt1 (getpoint "\nGeef linker onderhoekpunt op:\n"))
(setq pt2 (getcorner pt1 "\nGeef rechter bovenhoekpunt op:\n"))
(initget 7)
(setq afx (getint "\nGeef een gehele maat op voor de tussenafstand in de X-richting:\n"))
(initget 7)
(setq afy (getint "\nGeef een gehele maat op voor de tussenafstand in de Y-richting:\n"))
(initget 1 "Point Block Circle Line")
(setq mtype ;markeringstype
(getkword "\nVoor markering een Point, Block, Circle of Line gebruiken?[P/B/C/L]:\n")
)

Die \n zou ik op het einde van een vraag niet plaatsen, dit doet enkel het antwoord verschijnen op de volgende regel en oogt niet zo lekker....
Het programma werkt daarintegen naar behoren, enkel de mogelijkheid om je cirkeldiameter, je block of lijn groote kunnen het nog afwerken.

Laten we zeggen dat we er bijna zijn, Kenny zal ons plezieren met een leuke DCL voor dit progje, dan zie ik dat wel allemaal eens goed uitgebreid na, en dan zal het verschijnen op een nieuwe CADsite-pagina met download-bare handige routines.( :shock: Later meer nieuws :shock: )




De inzet is groot, het werk valt mee, de bevrediging van een afwerkt programma zal immens zijn....
Titel: grid tekenen + coordinaten erbij
Bericht door: Kenny H op wo 13 07 2005, 19:11:37
Ik zal het programma aanpassen zodat het begin punt start zoals jij het wilt.
Ik zal mij morgen met alles bezighouden. :wink:
Titel: grid tekenen + coordinaten erbij
Bericht door: WebRacer op za 23 07 2005, 12:35:16
Ook dit programma is dus nu aangepast en te verkrijgen bij Kenny Habils of mij. :P

GeoGrid laat u de kans om een grid te laten uittekenen dmv punten, lijntjes, cirkels of een block (van lijntjes).
Op een op te geven afstand tekent GeoGrid dan een raster uit waarvan X en Y niet identiek moeten zijn.
Na het plaatsen van het raster, zal GeoGrid er ook de X - en Y - waarden bij plaatsen aan de linker en de onderkant van het raster.

Met vriendelijke groeten,
Hautekeete Olivier & Keny Habils