Author Topic: Whats wrong with this Lisp? (Read 11056 times)

HasanCAD · « **on:** July 12, 2009, 05:24:27 AM »

Whats wrong with this lisp?

This lisp for insert points (in sequence) then create a table contains the points and position of each one

Code: [Select]

(defun derr (s)                       ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
  (if (/= s "Function cancelled")
    (princ (strcat "\n*Error: " s))
  )
  (setvar "cmdecho" echo)
  (setvar "blipmode" blip)
  (setvar "luprec" decimal)
  (setq *error* olderr)               ; Restore old *error* handler
  (close file)
  (princ)
)
;----------------------------------------------------------------------------
(defun c:pt()
 
   (setq olderr *error*
                *error* derr)
   (setq echo (getvar "cmdecho"))
   (setq blip (getvar "blipmode"))
   (setq decimal (getvar "luprec"))
   (setvar "cmdecho" 0)
   (setvar "blipmode" 0)
 
      (setq pt_file (getstring "\nPoints File Name <points.txt>:"))
      (if (= pt_file "")
          (setq file (open "points.txt" "w"))
          (setq file (open pt_file "w"))
      )
      (setq h-scale (getint "\nHorizontal Scale  1:"))
      (setq pre_code (getstring "\nPrefix Code:"))
      (setq start_pn (getint "\nStart Number:"))
 
      (setq pn  start_pn)
      (setq hs-factor (/ h-scale 100))
      (setq p 0)
      (setq n 1)
      (while p
             (setq p (getpoint "\nSelect Point <Exit>:"))
             (if p
                 (progn
                    (setq str_pn (itoa pn))
                    (setq pt_code (strcat pre_code str_pn))
                    (setq ptxt (list
                                  (- (car p) (* 0.5 hs-factor))
                                  (+ (cadr p) (* 0.5 hs-factor))
                               ))
 
                    (command "point" p)
                    (command "text" "m" ptxt "0" pt_code)
 
                    ;Writting Selected point to the file
                    ;-----------------------------------
                    (princ (strcat "\n" pt_code " " (rtos (car p)) " " 
                                   (rtos (cadr p)) ) file)
                    (setq pn (+ pn 1))
 
                    (setq pt_list1 (list (append (list pt_code) p)))
                    (if (= n 1)
                        (setq pt_list pt_list1)
                        (setq pt_list (append pt_list pt_list1))
                    )
                    (setq n (+ n 1))
                 )
             )
      )
   (prompt "\n** Points Coordinates Table **")
 
   (setq p_l_up (getpoint "\nSelect Upper Left Cornner :\n"))
   (setq p_r_up (list (+ (car p_l_up) (* 7.2 hs-factor))
                      (cadr p_l_up) ))
   (setq ph1 (list (car P_l_up)
                   (- (cadr p_l_up) (* 1 hs-factor)) ))
   (setq ph2 (list (car P_r_up)
                   (- (cadr p_r_up) (* 1 hs-factor)) ))
   (setq ph_txt1 (list (+ (car p_l_up) (* 0.6 hs-factor))
                       (- (cadr p_l_up) (* 0.5 hs-factor)) ))
   (setq ph_txt2 (list (+ (car p_l_up) (* 2.7 hs-factor))
                       (- (cadr p_l_up) (* 0.5 hs-factor)) ))
   (setq ph_txt3 (list (+ (car p_l_up) (* 5.7 hs-factor))
                       (- (cadr p_l_up) (* 0.5 hs-factor)) ))
   (command "line" p_l_up p_r_up "")
   (command "line" ph1 ph2 "")
   (command "text" "m" ph_txt1 "0" "Pt.")
   (command "text" "m" ph_txt2 "0" "X")
   (command "text" "m" ph_txt3 "0" "Y")
 
   (setq len_ptlst (length pt_list))
   (setq n_lst 0)
   (repeat len_ptlst
           (progn
              (setq p1 (list (car ph1)
                             (- (cadr ph1) (* 1 (+ n_lst 1) hs-factor)) ))
              (setq p2 (list (car ph2)
                             (- (cadr ph2) (* 1 (+ n_lst 1) hs-factor)) ))
 
              (setq ptxt1 (list 
                            (car ph_txt1)
                            (- (cadr ph_txt1)(* 1 (+ n_lst 1) hs-factor)) ))
              (setq ptxt2 (list 
                            (car ph_txt2)
                            (- (cadr ph_txt2)(* 1 (+ n_lst 1) hs-factor)) ))
              (setq ptxt3 (list 
                            (car ph_txt3)
                            (- (cadr ph_txt3)(* 1 (+ n_lst 1) hs-factor)) ))
              (setq x (rtos (nth 1 (nth n_lst pt_list))))
              (setq y (rtos (nth 2 (nth n_lst pt_list))))
 
              (princ (strcat "\rPoint Number " (nth 0 (nth n_lst pt_list))))
              (command "text" "m" ptxt1 "0" (nth 0 (nth n_lst pt_list)))
              (command "text" "m" ptxt2 "0" x)
              (command "text" "m" ptxt3 "0" y)
              (command "line" p1 p2 "")
 
           )
           (setq n_lst (+ n_lst 1))
   )
 
   (setq pv1 (list (+ (car p_l_up) (* 1.2 hs-factor))
                   (cadr p_l_up) ))
   (setq pv2 (list (+ (car p_l_up) (* 4.2 hs-factor))
                   (cadr p_l_up) ))
   (setq pv3 (list (+ (car p1) (* 1.2 hs-factor))
                   (cadr p1) ))
   (setq pv4 (list (+ (car p1) (* 4.2 hs-factor))
                   (cadr p1) ))
   (command "line" p_l_up p1 "")
   (command "line" pv1 pv3 "")
   (command "line" pv2 pv4 "")
   (command "line" p_r_up p2 "")
   (setvar "cmdecho" echo)
   (setvar "blipmode" blip)
   (setvar "luprec" decimal)
   (setq *error* olderr)               ; Restore old *error* handler
   (close file)
   (princ)
)

Jeff_M · « **Reply #1 on:** July 12, 2009, 10:00:42 AM »

1. The error handler should be inside the routine.
2. Only close the file if it's open
3. If the current text style has a height = 0 the Text command fails. Check for this and either prompt for a text height or use the Textsize sysvar.
4. If running Object Snaps are set, the Line & Text commands may be affected by them. Save them, set them to 0, the reset them when done.
5. The hs-factor is being set to 0 because dividing 2 INTs returns an INT. Change the the 100 to 100.0 to get the desired value.
6. A number of items need to be corrected in the table creation. Hard-coding the column widths and heights of the columns & rows will make for a funky looking table. You will likely need to play with this until you get something usable.
7. Next time, please tell us HOW it doesn't work...i.e. what error messages do you get, what output do you get that differs from what you expect, etc.

HasanCAD · « **Reply #2 on:** July 12, 2009, 10:41:18 AM »

First, Thanx for your great analysing

Second, the problem is when create the table some times comes good and some times no.

I am using AutoCAD 2007

what i want is a lisp to insert a point with number (in sequance) and create a table with the number and the posision of each point (X & Y)

Regards

Lee Mac · « **Reply #3 on:** July 12, 2009, 10:59:55 AM »

Quote from: asos2000 on July 12, 2009, 10:41:18 AM

what i want is a lisp to insert a point with number (in sequance) and create a table with the number and the posision of each point (X & Y)

How much is it worth...

?

HasanCAD · « **Reply #4 on:** July 12, 2009, 12:16:18 PM »

Quote from: Lee Mac on July 12, 2009, 10:59:55 AM

Quote from: asos2000 on July 12, 2009, 10:41:18 AM
what i want is a lisp to insert a point with number (in sequance) and create a table with the number and the posision of each point (X & Y)

How much is it worth... ?

We are a GeoTech Consultant
most of our work depends on the coordenate

suppose we have a power station.
one item of our work is PILES, each pile should be submented with the coordenate (Not dimensions).
the same for the piles of a bridges

This lisp will be very usefull for CIVIL draftmen. and im one of them

LEE your lisp in CADTutor is very good but Txt Position table is needed(See attached).

Lee Mac · « **Reply #5 on:** July 12, 2009, 02:00:45 PM »

Quote from: asos2000 on July 12, 2009, 12:16:18 PM

Quote from: Lee Mac on July 12, 2009, 10:59:55 AM
Quote from: asos2000 on July 12, 2009, 10:41:18 AM
what i want is a lisp to insert a point with number (in sequance) and create a table with the number and the posision of each point (X & Y)

How much is it worth... ?

LEE your lisp in CADTutor is very good but Txt Position table is needed...

Hmmm... I still can't see whats in it for me...

Spike Wilbury · « **Reply #6 on:** July 12, 2009, 03:00:34 PM »

Quote from: Lee Mac on July 12, 2009, 02:00:45 PM

Hmmm... I still can't see whats in it for me...

You need to get use to... and wait for more requests (and more if you end up coming with great routines)... and where to stop

Lee Mac · « **Reply #7 on:** July 12, 2009, 03:23:31 PM »

Quote from: LE on July 12, 2009, 03:00:34 PM

Quote from: Lee Mac on July 12, 2009, 02:00:45 PM
Hmmm... I still can't see whats in it for me...

You need to get use to... and wait for more requests (and more if you end up coming with great routines)... and where to stop

Well, being as I've got nothing else to do... here ya go

stevesfr · « **Reply #8 on:** July 12, 2009, 04:48:57 PM »

Lee, mighty fine program, latest NumInc. I always think and use coordinates as N & E as opposed to x, y.
I'd like to revise the program to do this. Do I have to do any revision to the dcl file? or will making proper revsions to NumInc_V7_tab.lsp make the table read North, East, Elev, comment and the x will fall in East etc.
thanks for clues,
Steve

Lee Mac · « **Reply #9 on:** July 12, 2009, 07:30:04 PM »

Only the LISP file needs to be altered, just change this list to whatever you like:

Code: [Select]

(setq valLst '("X-Value" "Y-Value" "Z-Value" "Comments")) ;;<<-- Change this list to change Table Headers, must be in correct order.

stevesfr · « **Reply #10 on:** July 12, 2009, 08:20:24 PM »

Fine, that will allow editing/revision of the table. I revised the table to read North, East, Elev. but I now need a clue on how to enter the Y in the first column instead of X, X in the second column instead of Y
I assume its in the code below the above line of revisions as you stated in previous response.
thanks for your patience and help.
Steve

HasanCAD · « **Reply #11 on:** July 13, 2009, 02:32:16 AM »

Quote

Well, being as I've got nothing else to do... here ya go

Version 7 is more than enough for me,
But there are some comments
- OSnap not working
- The increment number doest reset but continue from the last time.
- Text height dost read the textstyle format.
- See Attached

Thanks

Lee Mac · « **Reply #12 on:** July 13, 2009, 04:31:17 AM »

Quote from: stevesfr on July 12, 2009, 08:20:24 PM

Fine, that will allow editing/revision of the table. I revised the table to read North, East, Elev. but I now need a clue on how to enter the Y in the first column instead of X, X in the second column instead of Y
I assume its in the code below the above line of revisions as you stated in previous response.
thanks for your patience and help.
Steve

You will need to change the order of the titles in the list, and also change the order that the data is being compiled in the value list.

The point is compiled in the list at this point:

Code: [Select]

               (setq tbl_lst
                 (cons
                   (cons tStr
                     (vlax-safearray->list
                       (vlax-variant-value
                         (vla-get-TextAlignmentPoint tObj)))) tbl_lst))

Let me know if you get stuck.

Lee Mac · « **Reply #13 on:** July 13, 2009, 04:39:55 AM »

Quote from: asos2000 on July 13, 2009, 02:32:16 AM

- OSnap not working

Seems to work for me. F3 turns it on.

Quote from: asos2000 on July 13, 2009, 02:32:16 AM

- The increment number doest reset but continue from the last time.

Yes, that is how I engineered it

Quote from: asos2000 on July 13, 2009, 02:32:16 AM

- Text height dost read the textstyle format.

You can enter the Text Height you want.

As for the rest of your requests, I think you are being unreasonable.

This is a help and advice site, I am in no way working for you - and I have already provided you with plentiful code without renumeration.

HasanCAD · « **Reply #14 on:** July 13, 2009, 05:13:17 AM »

Mr. LEE

At fist sorry for disturbance you. and you have to be sure that I appraisate too much because of your help for all and specially for me in drafting.
Second as i told you Version 7 is more than enough for me,
Third we helping each other no one work for any one.
Forth you who make me being unreasonable because of your unlimited help.
finally, Sorry again

andrew_nao · « **Reply #15 on:** July 13, 2009, 10:22:49 AM »

how did you get the text in the dialog box to be different colors?

or is that something you did to the image?

GDF · « **Reply #16 on:** July 13, 2009, 12:20:51 PM »

Lee

Love your routines, thanks for sharing them.

When creating dialog boxes, I find it helpfully to format them and to make use of "widgets" (repeatable dcl code).
This makes it easier to read the code (similar to formatting lisp) for complex dialog boxes. Good job in
developing an easy to read dialog box.

I have enclosed examples of how I format my dcl code.

Code: [Select]

//To load master widgets used by Arch Program© for AutoCAD®
@include "..\\ARCH.dcl"
dcl_settings :default_dcl_settings {audit_level=0;}

ARCH_SEQ:dialog {key="set-title"; initial_focus="set-title"; width=93.3; height=21.875; 
  :row { //children_fixed_width=true;
    :boxed_column {label="Insert Block \"SEQ\" Sequientially";           
      :radio_row {  
        :radio_button {label="Dtext";key="RM"; width=9.5;}
        :radio_button {label="Attribute";key="RM0"; width=9.5;}
        :radio_button {label="Bubble";key="RM1"; width=9.5;}
        :radio_button {label="Line";key="RM2";}        
      }
      :boxed_column {label="Sequiential Parameters:";        
        :row {
          :edit_box {key="prefix"; label="Prefix Value :"; edit_width=9;}
          :button {label="Clear"; key="clear_prefix"; width=9; fixed_width=true;}
        }
        :row {
          :edit_box {key="midfix"; label="Start Value :"; edit_width=4;}
          :button {label="Increment"; key="incr_number"; width=9; fixed_width=true;}
        }
        :row {
          :edit_box {key="suffix"; label="Suffix Value :"; edit_width=9;}
          :button {label="Clear"; key="clear_suffix"; width=9; fixed_width=true;}
        }            
        :radio_row {key="incr_what";
          :radio_button {label="Increment No"; key="incr_num"; is_tab_stop=false;}
          :radio_button {label="Increment Suffix"; key="incr_suf"; is_tab_stop=false;}
        }
      }   
      :spacer {}      
      :row {    
        //:toggle {label="Notes"; key="SEQNOTES";}
        //:toggle {label="Title"; key="SEQTITLE";}
        :popup_list {key="txsty"; width=19.25;}
        :arch_accept {label="Accept Insert";}      
      }      
      :spacer {}     
    }
    :boxed_column {label="Edit Block or Text Sequientially";
      :boxed_column {label="Attribute Tag Value"; key="at_box";
        :popup_list {label="Tag to Edit -->"; key="renum_at"; edit_width=12;}
        :spacer {}
      }
      :column {
        :edit_box {label="Preffix Value :"; key="renum_p"; edit_width=7;}
        :edit_box {label="Start Value :"; key="renum_sv"; edit_width=7;}
        :edit_box {label="Suffix Value :"; key="renum_s"; edit_width=7;}
      }
      :column {
        :edit_box {label="Increment Range ="; key="renum_i"; edit_width=7;}
      }      
      :spacer {}
      :row {        
        :button {label="Select Objects"; key="RENUMIT"; fixed_width=true;}
        :button {label="Accept Edit"; key="accept-renumit"; width=17; fixed_width=true;}
      }      
    }
  }  
  :row {
    :spacer {} 
    :radio_button {label="Tread Cnt"; key="TRED"; width=17;}    
    //:radio_button {label="Place Dtx Only"; key="SEQTX";  width=17;}
    :radio_button {label="Edit Dtx and Blks"; key="SEQED";  width=17;}
    :radio_button {label="ReNumber"; key="NUM";  width=17;} 
    :radio_button {label="Place Dtx Index"; key="INDEX";  width=17;}  
    :spacer {}   
  }  
  :arch_program_textstyle {arch_program_textstyle;}
}

Lee Mac · « **Reply #17 on:** July 13, 2009, 12:55:50 PM »

Thanks GDF,

Tbh, I am quite new to DCL and have a lot to learn, CAB has taught me quite a bit in his contribution to my AutoNum routine.

Sorry if this is an obvious question but, do the Arch programs come with AutoCAD, or do you have to download them?

Thanks,

Lee

EDIT: just saw the attached DCL file, I must be blind

GDF · « **Reply #18 on:** July 13, 2009, 01:14:23 PM »

Arch Program is my inhouse set of routines. All of the routines use the same set of subfunctions and dcl widgets.
Thus making each individual routine part of the overall package and not a stand-alone routine...which has its good points and bad.

I am just a newby as far as programming skills. So I ask a lot of questions and get help form all of the real programmers here at theswamp.

I have enclosed a old dated pdf file of the 12 major dialog boxes of the arch progarm set of routines. Most of the routines are old and clunky, but it's fun to tinker with.

Lee Mac · « **Reply #19 on:** July 13, 2009, 01:34:34 PM »

I must say, very impressive Gary - some great dialogs, loving the images & image buttons

Thanks for sharing,

Lee

HasanCAD · « **Reply #20 on:** July 16, 2009, 03:45:44 AM »

Code: [Select]

I have enclosed examples of how I format my dcl code.
Shouldnt the lisp be attached?
or it is non free lisp?

Lee Mac · « **Reply #21 on:** July 16, 2009, 06:43:52 AM »

Quote from: asos2000 on July 16, 2009, 03:45:44 AM

Code: [Select]
I have enclosed examples of how I format my dcl code.
Shouldnt the lisp be attached?
or it is non free lisp?

If you are referring to the ARCH.dcl that Gary uploaded - it was just a set of DCL functions to be used as widgets within other code.

HasanCAD · « **Reply #22 on:** March 24, 2010, 07:52:06 AM »

Lee

Thanks for great lisp
Could I please make some change in the code?
I want to change the text insertion point

Whats code line which control text insertion point?

Lee Mac · « **Reply #23 on:** March 24, 2010, 08:15:11 AM »

The text insertion point is determined through the GrRead loop - it is not just one line. Or were you referring to the text alignment?

HasanCAD · « **Reply #24 on:** March 24, 2010, 09:06:45 AM »

Mr. Lee

Please see attached

Most of Civil work like that

Insert a point then insert a text next to the point
Then create a table with X, Y & Z (or N, E & Z) of the inserted points

All of that done by your lisp in a great way.
this lisp is helpful for Civil work
but these points if considered will be better
- Turn OSnap on to pick an object (such as a _cen, endp, ... etc)
- Insert a point
- Adding option to move text ( same as SPACE which rotate text)

finally
English is not my mother tongue so please take the light meaning of the word not bad meaning and the tutor should be respected

Lee Mac · « **Reply #25 on:** March 24, 2010, 09:43:55 AM »

Because the function uses a GrRead loop, OSnap functionality is not permitted and must be imitated. I updated my other version of this program, so that the user had the option of whether to use the GrRead loop or not, but I haven't updated this version as yet.

KOWBOI · « **Reply #26 on:** March 24, 2010, 09:53:15 AM »

Lee, your programming skills are amazing as is your generosity.

Lee Mac · « **Reply #27 on:** March 24, 2010, 09:57:50 AM »

Thanks KOWBOI

FYI The updated version is here

HasanCAD · « **Reply #28 on:** March 24, 2010, 10:00:01 AM »

Quote from: Lee Mac on March 24, 2010, 09:43:55 AM

Because the function uses a GrRead loop, OSnap functionality is not permitted and must be imitated. I updated my other version of this program, so that the user had the option of whether to use the GrRead loop or not, but I haven't updated this version as yet.

Which version has OSnap function?

Lee Mac · « **Reply #29 on:** March 24, 2010, 10:00:23 AM »

Quote from: asos2000 on March 24, 2010, 10:00:01 AM

Quote from: Lee Mac on March 24, 2010, 09:43:55 AM
Because the function uses a GrRead loop, OSnap functionality is not permitted and must be imitated. I updated my other version of this program, so that the user had the option of whether to use the GrRead loop or not, but I haven't updated this version as yet.

Which version has OSnap function?

The one linked to above (OSnap is available if 'text follows cursor' is not set) - but it has no table.

efernal · « **Reply #30 on:** March 24, 2010, 01:33:41 PM »

;;;   HI, I have some routines for this
;;;
;;;   See in
;;;
;;;   http://www.gr-acad.com.br/Pacote/ipontos.html
;;;   http://www.gr-acad.com.br/Pacote/azimute/azimute.html
;;;
;;;   and more in
;;;
;;;   http://www.gr-acad.com.br/pac.htm
;;;
;;;   e.fernal
;;;
;;;   Here is my version for your need...
;|
   please, adjust

   (LOAD_DIALOG
        (STRCAT gr-pack-usb-char-drive
           ":\\Gr-Pack-Usb\\Dlg\\DCL0110.dcl"
        )
        )

   according your paths...

and here is the necessary dcl file contents...

efpac0110:dialog{label="E.Fernal Software";key="efernal";width=54;fixed_width=true;initial_focus="numero";
:spacer{height=0.5;}
:text{label="Dados para pontos";alignment=centered;fixed_width_font=true;height=1.5;fixed_height=true;}
:column{alignment=centered;fixed_width=true;fixed_height=true;
:edit_box{label="Número inicial";key="numero";edit_width=12;edit_limit=6;}
:edit_box{label="Altura da fonte";key="hfonte";edit_width=12;edit_limit=5;}}
:spacer{height=0.5;}
:row{alignment=centered;fixed_width=true;fixed_height=true;
:button{label="Como &usar";key="help";mnemonic="u";width=15;height=2.5;fixed_width=true;fixed_height=true;alignment=top;}
:button{label="&Cancelar";key="cancel";is_cancel=true;mnemonic="C";width=15;height=2.5;
fixed_width=true;fixed_height=true;alignment=top;}
:button{label="&Prosseguir";key="accept";mnemonic="P";width=15;height=2.5;
fixed_width=true;fixed_height=true;alignment=top;}}}

|;

(DEFUN c:pts (/   pt arq sn cn dh   w@
     ;; setvars
     attreq attdia
     ;; parâmetros necessários
     numero hfonte
     ;; funçoes locais...
     exec ajuda verif make_block efernal_acet)
;; ################################################################ ;;
(DEFUN efernal_acet (s)
(IF   ACET-UI-MESSAGE
(ACET-UI-MESSAGE s "E.Fernal Software")
(ALERT s)
)
)
;; ################################################################ ;;
(DEFUN exec (/ arq file lista p1)
(SETQ arq (OPEN (STRCAT (GETVAR "TempPrefix") "EFPAC0110.TXT") "w"))
(WHILE (SETQ
     p1   (GETPOINT
        (STRCAT "\r-> Clique no ponto [ " (ITOA numero) " ] : ")
      )
     )
(ENTMAKE (LIST (CONS 0 "POINT") (CONS 10 p1)))
(ENTMAKE (LIST (CONS 0 "TEXT")
        (CONS 1 (ITOA numero))
        (CONS 10
           (LIST (+ (CAR p1) (* 2.0 hfonte))
             (- (CADR p1) (* 2.0 hfonte))
             (CADDR p1)
           )
        )
        (CONS 40 hfonte)
        (CONS 50 0.0)
        (CONS 71 0)
        (CONS 72 0)
        (CONS 73 0)
     )
)
(SETQ numero (1+ numero))
(IF (AND arq (= (TYPE arq) 'file))
   (PROGN (PRINC "(" arq)
     (PRINC (CHR 34) arq)
     (PRINC numero arq)
     (PRINC (CHR 34) arq)
     (PRINC (CHR 32) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CAR p1) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CHR 32) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CADR p1) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CHR 32) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CADDR p1) arq)
     (PRINC (CHR 34) arq)
     (PRINC ")\n" arq)
   )
   nil
)
)
(IF   (AND arq (= (TYPE arq) 'file))
(CLOSE arq)
)
(SETQ arq nil)
;; ################################################################### ;;
(IF   (SETQ
     arq (FINDFILE (STRCAT (GETVAR "TempPrefix") "EFPAC0110.TXT"))
   )
(IF (SETQ   p1
       (GETPOINT "\n-> Ponto de inserção da tabela descritiva : ")
     )
   (IF (SETQ file (OPEN arq "r"))
     (PROGN (IF (NULL (TBLSEARCH "BLOCK" "EFPAC0110"))
        (make_block)
       )
       (SETQ attreq (GETVAR "ATTREQ")
        attdia (GETVAR "ATTDIA")
       )
       (SETVAR "ATTREQ" 1)
       (SETVAR "ATTDIA" 0)
       (COMMAND "._-INSERT" "EFPAC0110" "_NON"
           p1     hfonte     hfonte
           0.0     "PT. Número"
           "Leste" "Norte"     "Cota"
          )
       (SETQ p1
         (LIST (CAR p1) (- (CAR p1) (* 2.0 hfonte)) (CADDR p1))
       )
       (WHILE   (SETQ linha (READ-LINE file))
        (SETQ lista (READ linha))
        (IF (AND (= (TYPE lista) 'LIST) (= (LENGTH lista) 4))
        (PROGN (COMMAND "._-INSERT"
              "EFPAC0110"
              "_NON"
              p1
              hfonte
              hfonte
              0.0
              (CAR lista)
              (CADR lista)
              (CADDR lista)
              (CADDDR lista)
           )
           (SETQ p1 (LIST (CAR p1)
                 (- (CAR p1) (* 2.0 hfonte))
                 (CADDR p1)
              )
           )
        )
        nil
        )
       )
       (CLOSE file)
       (SETVAR "ATTREQ" attreq)
       (SETVAR "ATTDIA" attdia)
     )
     (efernal_acet
     (STRCAT
     "Erro:\n\n\t"
     "Não foi possível abrir o arquivo para leitura!\t\n\n"
     )
     )
   )
   (PRINC "\n-> Ponto de inserção não foi fornecido...")
)
(efernal_acet
   (STRCAT   "Erro:\n\n\t"
      "Não foi possível encontrar o arquivo\t\n\t"
      "com os dados dos pontos coletados...\t\n\n"
   )
)
)
)
;; ################################################################ ;;
(DEFUN verif ()
(IF   (AND (SETQ numero (GET_TILE "numero"))
     (NUMBERP (READ numero))
     (= (TYPE (READ numero)) 'int)
     (> (ATOI numero) 0)
     ;;
     (SETQ hfonte (GET_TILE "hfonte"))
     (NUMBERP (READ hfonte))
     (> (ATOF hfonte) 0.0)
     ;;
   )
(PROGN (SETQ numero (ATOI numero)
        hfonte (ATOF hfonte)
     )
     (DONE_DIALOG 1)
)
(efernal_acet
   (STRCAT
     "Erro:\n\n\t"
     "Verifique os campos\n\t"
     "\"Número inicial\" e \"Altura da fonte\".\t\n\t"
     "O número deve ser um número inteiro e\t\n\t"
     "maior que zero e a altura da fonte deve\t\n\t"
     "ser um número, inteiro ou real, maior que\t\n\t"
     "zero.\n\n\tTente novamente...\n\n"
    )
)
)
)
;; ################################################################ ;;
(DEFUN make_block ()
(IF   (NULL (TBLSEARCH "BLOCK" "EFPAC0110"))
(PROGN
   (IF (NULL (TBLSEARCH "STYLE" "Verdana"))
     (ENTMAKE '((0 . "STYLE")
        (100 . "AcDbSymbolTableRecord")
        (100 . "AcDbTextStyleTableRecord")
        (2 . "Verdana")
        (70 . 0)
        (40 . 0.0)
        (41 . 1.0)
        (50 . 0.0)
        (71 . 0)
        (42 . 1.0)
        (3 . "verdana.TTF")
        (4 . "")
        )
     )
   )
   (ENTMAKE
     '((0 . "BLOCK") (2 . "EFPAC0110") (70 . 2) (10 0.0 0.0 0.0))
   )
   (ENTMAKE '((0 . "LWPOLYLINE")
        (100 . "AcDbEntity")
        (67 . 0)
        (8 . "0")
        (100 . "AcDbPolyline")
        (90 . 4)
        (70 . 1)
        (43 . 0.0)
        (38 . 0.0)
        (39 . 0.0)
        (10 40.0 -2.0)
        (40 . 0.0)
        (41 . 0.0)
        (42 . 0.0)
        (91 . 0)
        (10 0.0 -2.0)
        (40 . 0.0)
        (41 . 0.0)
        (42 . 0.0)
        (91 . 0)
        (10 0.0 0.0)
        (40 . 0.0)
        (41 . 0.0)
        (42 . 0.0)
        (91 . 0)
        (10 40.0 0.0)
        (40 . 0.0)
        (41 . 0.0)
        (42 . 0.0)
        (91 . 0)
        (210 0.0 0.0 1.0)
        )
   )
   (ENTMAKE '((0 . "LINE")
        (100 . "AcDbEntity")
        (67 . 0)
        (8 . "0")
        (100 . "AcDbLine")
        (10 10.0 0.0 0.0)
        (11 10.0 -2.0 0.0)
        (210 0.0 0.0 1.0)
        )
   )
   (ENTMAKE '((0 . "LINE")
        (100 . "AcDbEntity")
        (67 . 0)
        (8 . "0")
        (100 . "AcDbLine")
        (10 20.0 0.0 0.0)
        (11 20.0 -2.0 0.0)
        (210 0.0 0.0 1.0)
        )
   )
   (ENTMAKE '((0 . "LINE")
        (100 . "AcDbEntity")
        (67 . 0)
        (8 . "0")
        (100 . "AcDbLine")
        (10 30.0 0.0 0.0)
        (11 30.0 -2.0 0.0)
        (210 0.0 0.0 1.0)
        )
   )
   (ENTMAKE '((0 . "ATTDEF")
        (100 . "AcDbEntity")
        (67 . 0)
        (8 . "0")
        (100 . "AcDbText")
        (10 1.0 -1.5 0.0)
        (40 . 1.0)
        (1 . "")
        (50 . 0.0)
        (41 . 1.0)
        (51 . 0.0)
        (7 . "Verdana")
        (71 . 0)
        (72 . 0)
        (11 0.0 0.0 0.0)
        (210 0.0 0.0 1.0)
        (100 . "AcDbAttributeDefinition")
        (280 . 0)
        (3 . "Número do ponto")
        (2 . "1")
        (70 . 0)
        (73 . 0)
        (74 . 0)
        (280 . 0)
        )
   )
   (ENTMAKE '((0 . "ATTDEF")
        (100 . "AcDbEntity")
        (67 . 0)
        (8 . "0")
        (100 . "AcDbText")
        (10 11.0 -1.5 0.0)
        (40 . 1.0)
        (1 . "")
        (50 . 0.0)
        (41 . 1.0)
        (51 . 0.0)
        (7 . "Verdana")
        (71 . 0)
        (72 . 0)
        (11 0.0 0.0 0.0)
        (210 0.0 0.0 1.0)
        (100 . "AcDbAttributeDefinition")
        (280 . 0)
        (3 . "Coordenada X")
        (2 . "2")
        (70 . 0)
        (73 . 0)
        (74 . 0)
        (280 . 0)
        )
   )
   (ENTMAKE '((0 . "ATTDEF")
        (100 . "AcDbEntity")
        (67 . 0)
        (8 . "0")
        (100 . "AcDbText")
        (10 21.0 -1.5 0.0)
        (40 . 1.0)
        (1 . "")
        (50 . 0.0)
        (41 . 1.0)
        (51 . 0.0)
        (7 . "Verdana")
        (71 . 0)
        (72 . 0)
        (11 0.0 0.0 0.0)
        (210 0.0 0.0 1.0)
        (100 . "AcDbAttributeDefinition")
        (280 . 0)
        (3 . "Coordenada Y")
        (2 . "3")
        (70 . 0)
        (73 . 0)
        (74 . 0)
        (280 . 0)
        )
   )
   (ENTMAKE '((0 . "ATTDEF")
        (100 . "AcDbEntity")
        (67 . 0)
        (8 . "0")
        (100 . "AcDbText")
        (10 31.0 -1.5 0.0)
        (40 . 1.0)
        (1 . "")
        (50 . 0.0)
        (41 . 1.0)
        (51 . 0.0)
        (7 . "Verdana")
        (71 . 0)
        (72 . 0)
        (11 0.0 0.0 0.0)
        (210 0.0 0.0 1.0)
        (100 . "AcDbAttributeDefinition")
        (280 . 0)
        (3 . "Coordenada Z")
        (2 . "4")
        (70 . 0)
        (73 . 0)
        (74 . 0)
        (280 . 0)
        )
   )
   (ENTMAKE '((0 . "ENDBLK")))
)
nil
)
)
;; ################################################################ ;;
(DEFUN ajuda ()
(efernal_acet
(STRCAT "Como usar:\n\n\t"
     "Esta rotina permite inserir dados em uma\t\n\t"
     "série de pontos clicados e, ao fim, gerar\t\n\t"
     "uma tabela descritiva destes pontos.\t\n\n"
)
)
)
;; ################################################################ ;;
(IF (> (SETQ dh (LOAD_DIALOG
        (STRCAT gr-pack-usb-char-drive
           ":\\Gr-Pack-Usb\\Dlg\\DCL0110.dcl"
        )
        )
    )
    0
)
(IF   (NEW_DIALOG "efpac0110" dh)
(PROGN (ACTION_TILE "accept" "(Verif)")
     (ACTION_TILE "cancel" "(DONE_DIALOG 0)")
     (ACTION_TILE "help" "(Ajuda)")
     (SETQ w@ (START_DIALOG))
     (UNLOAD_DIALOG dh)
     (COND ((= w@ 0) (PRINC "\n-> Cancelado..."))
        ((= w@ 1) (exec))
     )
)
nil
)
(efernal_acet
(STRCAT "Erro:\n\n\t"
     "Não foi possível carregar o arquivo DCL!\t\n\n"
)
)
)
(PRINC)
)

efernal · « **Reply #31 on:** March 24, 2010, 01:39:01 PM »

PLEASE, CORRECT

(SETQ p1 (LIST (CAR p1)
                 (- (CAR p1) (* 2.0 hfonte))
                 (CADDR p1)
              )
           )

TO

(SETQ p1 (LIST (CAR p1)
                 (- (CADR p1) (* 2.0 hfonte))
                 (CADDR p1)
              )
           )

e.fernal

efernal · « **Reply #32 on:** March 24, 2010, 01:42:49 PM »

ooops, not extensively tested...

correct

(SETQ numero (1+ numero))
(IF (AND arq (= (TYPE arq) 'file))
   (PROGN (PRINC "(" arq)
     (PRINC (CHR 34) arq)
     (PRINC numero arq)
     (PRINC (CHR 34) arq)
     (PRINC (CHR 32) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CAR p1) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CHR 32) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CADR p1) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CHR 32) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CADDR p1) arq)
     (PRINC (CHR 34) arq)
     (PRINC ")\n" arq)
   )
   nil
)

to

(IF (AND arq (= (TYPE arq) 'file))
   (PROGN (PRINC "(" arq)
     (PRINC (CHR 34) arq)
     (PRINC numero arq)
     (PRINC (CHR 34) arq)
     (PRINC (CHR 32) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CAR p1) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CHR 32) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CADR p1) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CHR 32) arq)
     (PRINC (CHR 34) arq)
     (PRINC (CADDR p1) arq)
     (PRINC (CHR 34) arq)
     (PRINC ")\n" arq)
   )
   nil
)
(SETQ numero (1+ numero))

and sorry for not a king's english...

e.fernal

HasanCAD · « **Reply #33 on:** March 24, 2010, 08:49:02 PM »

efernal
Is there an english version of this website?

efernal · « **Reply #34 on:** March 24, 2010, 09:39:10 PM »

not yet...
will try to translate something...

e.fernal

HasanCAD · « **Reply #35 on:** March 25, 2010, 02:38:38 AM »

Quote from: efernal on March 24, 2010, 09:39:10 PM

not yet...
will try to translate something...

e.fernal

I think that It will better to start with the lisp name.

PS the lisp not working?

efernal · « **Reply #36 on:** March 25, 2010, 07:23:18 AM »

try it by yourself...
type POINTS to run...
e.fernal

News:

Author Topic: Whats wrong with this Lisp? (Read 11056 times)

Spike Wilbury

andrew_nao

KOWBOI