Topic: INCL-lisp

[Fabricio28]

Hey all,
 I 'm trying to make this lisp better, insert the text in the midpoint.

Anybody Can help me help, please?

Thanks in advance

Code: [Select]

(defun c:incl(/ pv1 pv2 y1 y2 x1 x2 h l l1 i inc ang ang1 ptx1 texto)
 (command "layer" "s" "inclinação" "") 
  (SETQ pv1(getpoint "\nSaida:"))
   (SETQ pv2(getpoint "\nChegada:"))
   (SETQ Y1(NTH 1 PV1))
   (SETQ Y2(NTH 1 PV2))
   (SETQ X1(NTH 0 PV1))
   (SETQ X2(NTH 0 PV2))
   (SETQ H(- Y1 Y2))
   (SETQ L(- X2 X1))
   (SETQ L1(* 10 L))
   (SETQ I(/ H L1))
   (SETQ INC(RTOS I 2 4))
   (SETQ ANG (angle PV1 PV2))
   (SETQ ang1 (angtos ang 4 4))
   (SETQ PTXT1 (getpoint "\nInclinação:"))
   (SETQ TEXTO (Strcat "i=" INC))
   (command "text" "s" "incl" "c" PTXT1 ANG1 texto)
)



[d2010]

1) You downloading pp_fabricio28.fas
2) you enter the command C:Q2 or (Defun C:q2( /)
3) you open the drawing "testfabr.dwg"
4)if you need the 100%source autolisp please contact me....
5) the code cpp bellow it is converted to 100% autolispsource
 

Code - C++: [Select]

1. /*c2s:
2.        x1=nil,
3.        y1=nil,
4.        x2=nil,
5.        y2=nil,
6.        lnam=ACRX_T("inclinaçao");
7.        if (dfn_layer_isexist(lnam)<1)
8.            dfn_layer_new(lnam,7,0,nil);
9.  
10.        setvar("clayer",lnam);
11.        pv1=getpoint("\nSaida:"),
12.        if (dfn_var_ispoint(pv1))
13.          x1=car(pv1),
14.          Y1=cadr(pv1);
15.         else
16.          vl_exit_with_value("\nAcadstr::eInvalidDxf2dPoint");
17.  
18.  
19.        pv2=getpoint(pv1,"\nChegada:");
20.        if (dfn_var_ispoint(pv2))
21.          x2=car(pv2),
22.          Y2=cadr(pv2);
23.         else
24.          vl_exit_with_value("\nAcadstr::eInvalidDxf2dPoint");
25.  
26.        H= (Y1-Y2);
27.        L= (X2-X1);
28.        L1= (10*L);
29.        I= (H/L1) ;
30.        INC=rtos(I,2,4);
31.        ANG=angle(PV1,PV2);
32.        ang1=angtos(ang,4,4);
33.        pmid=list((x1+x2)/2.0,(y1+y2)/2.0,0.0);
34.        TEXTO=strcat("i=",INC);  
35.        k1=dfn_enamk_text(pmid,nil,texto,"ML",ang,lnam,50,"");
36. */
37.  

[Fabricio28]

Dear d2010,
  Thanks for replay. Your program works perfect!
  I'm really appreciate that.

I'd like to share the excellent program from Tharwat.

Thanks Tharwat and d2010.

Regards

Code: [Select]

(defun c:incl (/ *error* pv1 pv2 p y1 y2 x1 x2 y1 y2)
  ;;; Tharwat Al Shoufi 17. Oct. 2012  ;;;
  (defun *error* (x) (princ "\n ...") (princ "\n *Cancel*"))
  (if (not (tblsearch "LAYER" "INCLINAÇÃO"))
    (entmakex '((0 . "LAYER")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbLayerTableRecord")
                (62 . 4)
                (2 . "INCLINAÇÃO")
                (70 . 0)
                (6 . "Continuous")
                (370 . -3)
               )
    )
  )
  (if (not (tblsearch "STYLE" "INCL"))
    (entmakex '((0 . "STYLE")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbTextStyleTableRecord")
                (2 . "INCL")
                (70 . 0)
                (40 . 0.175)
                (41 . 1.0)
                (50 . 0.0)
                (71 . 0)
                (42 . 0.175)
                (3 . "SIMPLEX.shx")
                (4 . "")
               )
    )
  )
  (if (setq pv1 (getpoint "\n Specify First point:"))
    (while (setq pv2 (getpoint "\n Next point:" pv1))
      (progn
        (setq y1 (cadr pv1))
        (setq y2 (cadr pv2))
        (setq x1 (car pv1))
        (setq x2 (car pv2))
        (entmakex
          (list
            '(0 . "TEXT")
            (cons 1
                  (strcat "i=" (rtos (/ (- y1 y2) (* 10 (- x2 x1))) 2 4))
            )
            '(40 . 0.175)
            '(7 . "INCL")
            '(8 . "INCLINAÇÃO")
            (cons 10
                  (setq p
                         (polar (mapcar '(lambda (p q) (/ (+ p q) 2.)) pv1 pv2)
                                (+ (angle pv1 pv2) (/ pi 2.))
                                0.05
                         )
                  )
            )
            (cons 11 p)
            (cons 50 (angle pv1 pv2))
            '(72 . 1)
            '(73 . 0)
          )
        )
      )
      (setq pv1 pv2)
    )
  )
(princ "\n Written by Tharwat Al Shoufi")
  (princ)
)
[\code]



[Tharwat]

I'd like to share the excellent program from Tharwat.

Thanks Tharwat and d2010.

Regards

You're very welcome . 

[cadplayer]

Many bugs in compiler... I´m not realy understand to use it

[d2010]

Many bugs in compiler... I´m not realy understand to use it

After  two years, i  fixed many bugs..
you make user -account and click-again on blue-string "inregistrare"
http://lisp2arx.3xforum.ro/post/22/1/DOWNLOADING_vlacompilator_Here_/
or  you open ,& open  after register first time......