Display posts from previous
Sort by

autolisp wireedm

#1 by vlade@profimold,com
My autolisp for calculate gcode for wire edm don start

Code: Select all

(defun c:wire-edm ()
  (setq program-number (getint "\nUnesite broj programa (4 cifre): "))
  (setq use-r (getstring "\nKoristiti R za lukove? (Da/Ne): "))
  (setq use-r (eq (strcase use-r) "DA"))
  
  (setq contours (ssget '((0 . "LWPOLYLINE"))))
  (setq output-file (open "wire_edm_program.cnc" "w"))
  
  (write-line "%" output-file)
  (write-line (strcat "O" (itoa program-number)) output-file)
  (write-line "N1 G90" output-file)
  (write-line "N2 G92 X0 Y0" output-file)
  (write-line "N3 G41" output-file)
  
  (setq i 4)
  (setq contour-count (sslength contours))
  
  (repeat contour-count
    (setq contour-entity (ssname contours (setq contour-count (1- contour-count))))
    (setq contour-data (entget contour-entity))
    (setq vertices (vlax-curve-getCoordinates contour-entity))
    (setq bulge-list (vlax-curve-getBulges contour-entity))
    
    (setq start-pt (car vertices))
    (setq start-x (car start-pt))
    (setq start-y (cadr start-pt))
    
    (if (or (/= start-x 0) (/= start-y 0))
      (progn
        (write-line (strcat "N" (itoa i) " G00 X" (rtos start-x 2 4) " Y" (rtos start-y 2 4)) output-file)
        (write-line (strcat "N" (itoa (setq i (1+ i))) " M60") output-file)
      )
    )
    
    (setq prev-pt nil)
    (foreach vertex vertices
      (setq x (car vertex))
      (setq y (cadr vertex))
      
      (if prev-pt
        (progn
          (setq bulge (nth (vl-position prev-pt vertices) bulge-list))
          (if (/= bulge 0.0)
            (progn
              (setq start-pt prev-pt))
              (setq end-pt vertex))
              (setq center (vlax-curve-getPointAtBulge contour-entity (vl-position prev-pt vertices))))
              (setq radius (distance center start-pt))
              
              (if use-r
                (write-line (strcat "N" (itoa i) " G02 X" (rtos (car end-pt) 2 4) " Y" (rtos (cadr end-pt) 2 4) " R" (rtos radius 2 4)) output-file)
                (write-line (strcat "N" (itoa i) " G02 X" (rtos (car end-pt) 2 4) " Y" (rtos (cadr end-pt) 2 4) " I" (rtos (- (car center) (car start-pt)) 2 4) " J" (rtos (- (cadr center) (cadr start-pt)) 2 4)) output-file)
              )
              (setq i (1+ i))
            )
            (progn
              (write-line (strcat "N" (itoa i) " G01 X" (rtos x 2 4) " Y" (rtos y 2 4)) output-file)
              (setq i (1+ i))
            )
          )
        )
      )
      (setq prev-pt vertex))
    )
    
    (if (> contour-count 1)
      (progn
        (write-line (strcat "N" (itoa i) " M50") output-file)
        (setq i (1+ i))
        (setq next-start-pt (car (vlax-curve-getCoordinates (ssname contours (1- contour-count)))))
        (write-line (strcat "N" (itoa i) " G00 X" (rtos (car next-start-pt) 2 4) " Y" (rtos (cadr next-start-pt) 2 4)) output-file)
        (write-line (strcat "N" (itoa (setq i (1+ i))) " M60") output-file)
      )
    )
  )
  
  (write-line (strcat "N" (itoa i) " M02") output-file)
  (write-line "%" output-file)
  
  (close output-file)
  
  (princ "\nG-code generisan i sacuvan u 'wire_edm_program.cnc'")
)
What is problem
Can somebody help me

Re: autolisp wireedm

#5 by vlade@profimold,com
Is this code OK

Code: Select all

(defun c:wire-edm ()
  ;; Učitaj Visual LISP ekstenzije
  (vl-load-com)

  ;; Funkcija za obradu grešaka
  (defun wire_err (s)
    (if (/= s "Function cancelled")
      (princ (strcat "\nError: " s))
    )
    (redraw)
    (if wire_oce
      (setvar "cmdecho" wire_oce))
    (setq *error* olderr)
    (princ)
  )

  ;; Inicijalizacija
  (setq wire_oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq olderr *error*)
  (setq *error* wire_err)

  ;; Unos parametara
  (setq program-number (getint "\nUnesite broj programa (4 cifre): "))
  (setq use-r (getstring "\nKoristiti R za lukove? (Da/Ne): "))
  (setq use-r (eq (strcase use-r) "DA"))

  ;; Izbor polilinija
  (princ "\nIzaberite polilinije...") ; Debug ispis
  (setq contours (ssget '((0 . "LWPOLYLINE"))))
  (if (not contours)
    (progn
      (princ "\nNiste izabrali nijednu poliliniju.") ; Debug ispis
      (exit)
    )
  )

  ;; Otvaranje fajla za pisanje
  (setq output-file (open "D:/CNCProgrami/wire_edm_program.cnc" "w"))
  (if (not output-file)
    (progn
      (princ "\nGreska pri otvaranju fajla.") ; Debug ispis
      (exit)
    )
  )

  ;; Zapisivanje zaglavlja G-koda
  (write-line "%" output-file)
  (write-line (strcat "O" (itoa program-number)) output-file)
  (write-line "N1 G90" output-file)
  (write-line "N2 G92 X0 Y0" output-file)
  (write-line "N3 G41" output-file)

  ;; Inicijalizacija brojača
  (setq i 4)
  (setq contour-count (sslength contours))

  ;; Obrada svake polilinije
  (princ (strcat "\nBroj polilinija: " (itoa contour-count))) ; Debug ispis
  (repeat contour-count
    (setq contour-entity (ssname contours (setq contour-count (1- contour-count))))
    (setq contour-data (entget contour-entity))
    (setq vertices (vl-remove-if-not '(lambda (x) (= (car x) 10)) contour-data)) ; Izvuci tačke iz polilinije
    (setq bulge-list (vl-remove-if-not '(lambda (x) (= (car x) 42)) contour-data)) ; Izvuci "bulge" vrednosti

    ;; Početna tačka
    (setq start-pt (cdr (car vertices)))
    (setq start-x (car start-pt))
    (setq start-y (cadr start-pt))

    ;; Ako početna tačka nije X0 Y0, dodaj G00 i M60
    (if (or (/= start-x 0) (/= start-y 0))
      (progn
        (write-line (strcat "N" (itoa i) " G00 X" (rtos start-x 2 4) " Y" (rtos start-y 2 4)) output-file)
        (write-line (strcat "N" (itoa (setq i (1+ i))) " M60") output-file)
      )
    )

    ;; Obrada tačaka polilinije
    (setq prev-pt nil)
    (foreach vertex vertices
      (setq pt (cdr vertex))
      (setq x (car pt))
      (setq y (cadr pt))

      (if prev-pt
        (progn
          (setq bulge (cdr (assoc 42 (member vertex contour-data))))
          (if (/= bulge 0.0)
            (progn
              ;; Obrada lukova
              (setq start-pt prev-pt))
              (setq end-pt pt))
              (setq center (vlax-curve-getPointAtBulge contour-entity (vl-position vertex vertices))))
              (setq radius (distance center start-pt))
              (setq direction (if (> bulge 0) "G02" "G03"))

              (if use-r
                (write-line (strcat "N" (itoa i) " " direction " X" (rtos (car end-pt) 2 4) " Y" (rtos (cadr end-pt) 2 4) " R" (rtos radius 2 4)) output-file)
                (write-line (strcat "N" (itoa i) " " direction " X" (rtos (car end-pt) 2 4) " Y" (rtos (cadr end-pt) 2 4) " I" (rtos (- (car center) (car start-pt)) 2 4) " J" (rtos (- (cadr center) (cadr start-pt)) 2 4)) output-file)
              )
              (setq i (1+ i))
            )
            (progn
              ;; Obrada linija
              (write-line (strcat "N" (itoa i) " G01 X" (rtos x 2 4) " Y" (rtos y 2 4)) output-file)
              (setq i (1+ i))
            )
          )
        )
      )
      (setq prev-pt pt))
    )

    ;; Dodavanje M50 i G00 za prelazak na sledeću poliliniju
    (if (> contour-count 1)
      (progn
        (write-line (strcat "N" (itoa i) " M50") output-file)
        (setq i (1+ i))
        (setq next-start-pt (cdr (car (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname contours (1- contour-count))))))
        (write-line (strcat "N" (itoa i) " G00 X" (rtos (car next-start-pt) 2 4) " Y" (rtos (cadr next-start-pt) 2 4)) output-file)
        (write-line (strcat "N" (itoa (setq i (1+ i))) " M60") output-file)
      )
    )
  )

  ;; Završetak programa
  (write-line (strcat "N" (itoa i) " M02") output-file)
  (write-line "%" output-file)

  ;; Zatvaranje fajla i čišćenje
  (close output-file)
  (setvar "cmdecho" wire_oce)
  (setq *error* olderr)
  (princ "\nG-code generisan i sacuvan u 'D:/CNCProgrami/wire_edm_program.cnc'")
)

Re: autolisp wireedm

#6 by QuanNguyen
Hi,
I'm not sure the result is what you expected but this routine can be loading and running.
It also needs the vlax-curve-getPointAtBulge function.

Code: Select all

(defun c:wire-edm ()
;; Ucitaj Visual LISP ekstenzije
(vl-load-com)

;; Funkcija za obradu gre啾ka
  (defun wire_err (s)
    (if (/= s "Function cancelled")
      (princ (strcat "\nError: " s)))
    (redraw)
    (if wire_oce
      (setvar "cmdecho" wire_oce))
    (setq *error* olderr)
    (princ))

;; Inicijalizacija
  (setq wire_oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq olderr *error*)
  (setq *error* wire_err)

;; Unos parametara
  (setq program-number 3);(getint "\nUnesite broj programa (4 cifre): "))
;;;  (setq use-r (getstring "\nKoristiti R za lukove? (Da/Ne): "))
;;;  (setq use-r (eq (strcase use-r) "DA"))

;; Izbor polilinija
  (princ "\nIzaberite polilinije...") ; Debug ispis
  (setq contours (ssget '((0 . "LWPOLYLINE"))))
  (if (not contours)
    (progn
      (princ "\nNiste izabrali nijednu poliliniju.") ; Debug ispis
      (exit)))

;; Otvaranje fajla za pisanje
  (setq output-file (open "C:\\IntelliCad\\wire_edm_program.cnc" "w"))
  (if (not output-file)
    (progn
      (princ "\nGreska pri otvaranju fajla.") ; Debug ispis
      (exit)      ))

;; Zapisivanje zaglavlja G-koda
  (write-line "%" output-file)
  (write-line (strcat "O" (itoa program-number)) output-file)
  (write-line "N1 G90" output-file)
  (write-line "N2 G92 X0 Y0" output-file)
  (write-line "N3 G41" output-file)

;; Inicijalizacija brojaca
  (setq i 4)
  (setq contour-count (sslength contours))

;; Obrada svake polilinije
  (princ (strcat "\nBroj polilinija: " (itoa contour-count))) ; Debug ispis
(repeat contour-count
  (setq contour-entity (ssname contours (setq contour-count (1- contour-count))))
  (setq contour-data (entget contour-entity))
  (setq vertices (vl-remove-if-not '(lambda (x) (= (car x) 10)) contour-data)) ; Izvuci tacke iz polilinije
  (setq bulge-list (vl-remove-if-not '(lambda (x) (= (car x) 42)) contour-data)) ; Izvuci "bulge" vrednosti

;; Pocetna tacka
  (setq start-pt (cdr (car vertices)))
  (setq start-x (car start-pt))
  (setq start-y (cadr start-pt))

;; Ako pocetna tacka nije X0 Y0, dodaj G00 i M60
  (if (or (/= start-x 0) (/= start-y 0))
    (progn
      (write-line (strcat "N" (itoa i) " G00 X" (rtos start-x 2 4) " Y" (rtos start-y 2 4)) output-file)
      (write-line (strcat "N" (itoa (setq i (1+ i))) " M60") output-file)	))

;; Obrada tacaka polilinije
  (setq prev-pt nil)
  (foreach vertex vertices
    (setq pt (cdr vertex))
    (setq x (car pt))
    (setq y (cadr pt))

    (if prev-pt
      (progn
	(setq bulge (cdr (assoc 42 (member vertex contour-data))))
	(if (and (/= bulge 0.0) (< (setq param (vl-position vertex vertices)) (-(length vertices)1)))
	  (progn
	    ;; Obrada lukova  
	    (setq start-pt prev-pt)
	    (setq end-pt pt)
	    (setq center (vlax-curve-getPointAtBulge contour-entity param))
	    (setq radius (distance center start-pt))
	    (setq direction (if (> bulge 0) "G02" "G03"))
	    (if use-r
	      (write-line (strcat "N" (itoa i) " " direction " X" (rtos (car end-pt) 2 4) " Y" (rtos (cadr end-pt) 2 4) " R" (rtos radius 2 4)) output-file)
	      (write-line (strcat "N" (itoa i) " " direction " X" (rtos (car end-pt) 2 4) " Y" (rtos (cadr end-pt) 2 4) " I" (rtos (- (car center) (car start-pt)) 2 4) " J" (rtos (- (cadr center) (cadr start-pt)) 2 4)) output-file)
	      )
	    (setq i (1+ i))
	    )
	  (progn
	    ;; Obrada linija
	    (write-line (strcat "N" (itoa i) " G01 X" (rtos x 2 4) " Y" (rtos y 2 4)) output-file)
	    (setq i (1+ i))
	    )
	  )
	)
      )
    (setq prev-pt pt)
  )
)
;; Dodavanje M50 i G00 za prelazak na sledecu poliliniju
  (if (> contour-count 1)
    (progn
      (write-line (strcat "N" (itoa i) " M50") output-file)
      (setq i (1+ i))
      (setq next-start-pt (cdr (car (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname contours (1- contour-count))))))	)
      (write-line (strcat "N" (itoa i) " G00 X" (rtos (car next-start-pt) 2 4) " Y" (rtos (cadr next-start-pt) 2 4)) output-file)
      (write-line (strcat "N" (itoa (setq i (1+ i))) " M60") output-file)
      )
    )

;; Zavr啼tak programa
  (write-line (strcat "N" (itoa i) " M02") output-file)
  (write-line "%" output-file)

;; Zatvaranje fajla i ci喞enje
  (close output-file)
  (setvar "cmdecho" wire_oce)
  (setq *error* olderr)
  (princ "\nG-code generisan i sacuvan u 'C:\\IntelliCad\\wire_edm_program.cnc'")
)

Latest Posts
Post Reply

Return to “AutoLisp/SDS”