lisp2arx
Visual Programming for AutoLisp
Mathématiques en programmation Lisp..
doc2cpp,doc2lsp, sld2lsp, bmp2dcl,
free__GifCcapture for all-CAD'platforms..
|
Lista Forumurilor Pe Tematici
|
lisp2arx | Reguli | Inregistrare | Login
POZE LISP2ARX
Nu sunteti logat.
|
Nou pe simpatie:
ciocolata4u
 | Femeie
20 ani
Bucuresti
cauta Barbat
24 - 45 ani |
|
|
admin
Administrator
Din: Bucharest
Inregistrat: acum 13 ani
Postari: 516
|
|
You programe.lisp contain too many internal error/s.
==I do not known, you nick-name , even you keepsecret your nick-name from freelancer.com. I need your put nickname.
So; I put your program,to nickname pp_bombaylisp.zip
==You must break entire source.lisp to many subroutines
---(defun js_lookupswitch ( / $rr))
---(defun js_newdatum
---(defun js_newlayer
---(defun js_plotcenter
==You must separate local-variabiles with global-variabiles.
{--}
==Always di will contain the last-value from list-var named "dislfli".
You do not calculate nothing inside your source.Lisp
Code:
(repeat ptcount
(setq di1 (nth r dislfli))
(setq di1 (- 0 di1))
(setq di di1)
(setq r (+ r 1))
) |
You replace with (command "layer" "s" "CS_CENTRE" "" with (setvar...)
Code:
(setvar "CLAYER" "CS_CENTRE") |
You replace this (command with line+emakex, at line (Command "line" censt cenen ""
with this -code
Code:
(dfn_enamk_line cest cenen "CS_CENTRE" nil "") |
You do not need more set-current Layer with (command, because
the (command slow-down your-programeLisp-speed.
You remove
Code:
(command "layer" "s" "ANNOC" "") |
with the function (dfn_enamk_line, because the function "dfn_enamk_line", do not
need resetset-currentLAYER every-time.the function "dfn_enamk_line" draw line inside
each line on his layer-name.
Code:
We develope VlaxCompile for Visual-Lisp. You can develope libraries files with 2120functions inside zip file.
You can compile :All 2120function" to AutoLisp for BrisCAd, NanoCad, ProgeCad-Lisp..
{---}
You can test thisCompilator.exe. Convert C+/C# to autoLisp. If you need moreC++ then you hire me at this job.
This compilator can compile C+L to 100%Lisp, Parse Lto Lisp, tokenizerLisp. Reverse Lisp to C+, C#.
Visual Programming for AutoLisp Mathématiques en programmation Lisp.. doc2cpp,doc2lsp, sld2lsp, bmp2dcl, free__GifCcapture for all-CAD'platforms |
You make a anew procedure js_newlayer for checking all ready exists.
all layer/s names.
(js_newlayer "You must be sure exists al LayerNeeds"
Code:
(Defun js_newlayer(trinitastv / $rr condorC ldc nop)
(setq;|a33440|;
condorC (list "CS_CENTRE" "ANNOC" "ORDINATE" "TOP_SURFACE" "MISC"))
(foreach ldc condorC (if (tblsearch "LAYER") "ok" (dfn_enamk_layer ldc 100)))
$rr) |
http://www.filedropper.com/ppbombaylisp
Code:
(defun dfn_enamk_layer(namelayer epscolor / $rr xls nam fnd old)
(setq;|a39656|;
nam (if (= (type namelayer) (quote STR)) namelayer "0")
epscolor (if (= (type epscolor) (quote INT)) epscolor 7)
old nil
xls (tblsearch "LAYER" "0")
fnd (if xls 0 (- 1))) (if (and (= fnd 0) (/= nam "0")) (setq;|a39856|;
old (list (tblsearch "LAYER" nam)))) (setq;|a39896|;
$rr (cond ( (and (/= old nil) (= (car old) nil)) (list 5100 (entmakex (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 nam) (cons 70 0) (cons 62 epscolor)))))( (= old nil) (list (- 5003) "InternalError"))( (car old) (list 1 "AlreadyExista"))( (list (- 5002) "error"))))
$rr) |
http://www.filedropper.com/ppbombaylisp
http://www.filedropper.com/ppbombaylisp
http://www.filedropper.com/ppbombaylisp
library_test=*.* PLEASE YOU HIRE ME, FOR FINISH YOUR-PROJECT TOGETHER
library_autorun=zip=pp_bombaylisp.vlax/autoexec.bat
library_logmessage=https://www.freelancer.com/projects/aut ... AD/details
40.3KB
_______________________________________
|
|
| pus acum 3 ani |
|
|
zauchan
Moderator
Inregistrat: acum 13 ani
Postari: 180
|
|
Code:
(alert "Start with command name cs")
(defun c:cs()
(progn
(setq gv (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq hs (getstring "Enter horizontal scale (500/1000): "))
(setq hscale (atoi hs))
(setq vs (getstring "Enter vertical scale (500/1000): "))
(setq vscale (atoi vs))
(setq h1 2) (setq h2 1.75) (setq h3 2.5)
(setq fn (getfiled "Select data file" "" "csv" 4))
(setq rd (open fn "r"))
(setq rl (read-line rd))
(setq arrtot (vlax-make-safearray vlax-vbString (cons 1 10000) (cons 1 70) ))
(setq ss (ssadd))
(setq i 1)
(setq j 1)
(setq count 0)
(while (/= rl nil)
(setq l (strlen rl))
(setq sto1 (vl-string-search "," rl))
(setq sto2 (vl-string-search "," rl (+ sto1 1)))
(setq dis (atof (substr rl 1 sto1)))
(setq a (+ sto1 2))
(setq b (- (- sto2 sto1) 1))
(setq ht (atof (substr rl a b)))
(setq c (+ sto2 2))
(setq d (- (- l sto2) 1))
(setq chain (atof (substr rl c d)))
(if (= count 0)
(progn
(setq chain1 chain)
(vlax-safearray-put-element arrtot i j rl)
(setq j (+ j 1))
)
(progn
(if (= chain chain1)
(progn
(vlax-safearray-put-element arrtot i j rl)
(setq j (+ j 1))
)
(progn
(setq i (+ i 1))
(setq j 1)
(vlax-safearray-put-element arrtot i j rl)
(setq j (+ j 1))
(setq chain1 chain)
)
)
)
)
(setq count (+ count 1))
(setq rl (read-line rd))
)
(close rd)
(setq inp (getpoint "\nClick the point where to draw the sections: "))
(setq inx (car inp))
(setq iny (cadr inp))
(setq i 1)
(setq j 1)
(setq txt (vlax-safearray-get-element arrtot i j))
(while (/= txt "")
(setq htlfli (list 0))
(setq htrtli (list 0))
(setq dislfli (list 0))
(setq disrtli (list 0))
(while (/= txt "")
(setq l (strlen txt))
(setq sto1 (vl-string-search "," txt))
(setq sto2 (vl-string-search "," txt (+ sto1 1)))
(setq dis (atof (substr txt 1 sto1)))
(setq a (+ sto1 2))
(setq b (- (- sto2 sto1) 1))
(setq ht (atof (substr txt a b)))
(setq c (+ sto2 2))
(setq d (- (- l sto2) 1))
(setq chain (substr txt c d))
(setq title (strcat "C/S AT CHAINAGE : " chain " M."))
(if (< dis 0)
(progn
(setq dislfli (cons dis dislfli))
(setq htlfli (cons ht htlfli))
)
)
(if (= dis 0)
(progn
(setq cendi dis)
(setq cenht ht)
)
)
(if (> dis 0)
(progn
(setq disrtli (cons dis disrtli))
(setq htrtli (cons ht htrtli))
)
)
(vl-remove 0 dislfli)
(vl-remove 0 disrtli)
(vl-remove 0 htlfli)
(vl-remove 0 htrtli)
;;(setq disrtli (reverse disrtli))
;;(setq htrtli (reverse htrtli))
(setq j (+ j 1))
(setq txt (vlax-safearray-get-element arrtot i j))
)
;; DATUM SETTING ;;
(setq ptcount (- (length htlfli) 1))
(setq x (- ptcount 1))
(setq r 1)
(setq htmin (nth 0 htlfli))
(repeat x
(setq htr (nth r htlfli))
(if (<= htr htmin) (setq htmin htr))
(setq r (+ r 1))
)
(setq ptcount (- (length htrtli) 1))
(setq x (- ptcount 1))
(setq r 0)
(repeat x
(setq htr (nth r htrtli))
(if (<= htr htmin) (setq htmin htr))
(setq r (+ r 1))
)
(if (<= cenht htmin)
(setq htmin cenht)
)
(setq re (rem htmin 5))
(setq re (+ re 5))
(setq datum (- htmin re))
(setq datu (rtos datum))
(setq x (strlen datu))
(setq datu (substr datu 1 (- x 1)))
;; DATUM SETTING COMPLETE ;;
;; PLOTTING THE CENTRE LINE ;;
(setq stpx (+ inx 55))
(setq stpy (+ iny 35.75))
(setq ptcount (- (length dislfli) 1))
(setq r 0)
(setq di 0)
(repeat ptcount
(setq di1 (nth r dislfli))
(setq di1 (- 0 di1))
(setq di di1)
(setq r (+ r 1))
)
(setq p3 (/ (* di 1000) hscale))
(setq midx1 (+ stpx p3))
(setq midy1 stpy)
(setq midzp (/ (* (- cenht datum) 1000) vscale))
(setq midx2 midx1)
(setq midy2 (+ midy1 midzp))
(setq censt (list midx1 midy1 0))
(setq cenen (list midx2 midy2 0))
(setq layer1 (tblsearch "layer" "CS_CENTRE" next))
(if (= layer1 nil)
(command "layer" "Make" "CS_CENTRE" "color" "magenta" "" "")
)
(command "layer" "s" "CS_CENTRE" "")
(command "line" censt cenen "")
(setq layer1 (tblsearch "layer" "ANNOC" next))
(if (= layer1 nil)
(command "layer" "Make" "ANNOC" "color" "blue" "" "")
)
(command "layer" "s" "ANNOC" "")
(setq annoc1 (list midx1 (- midy1 1.75) 0))
(command "line" censt annoc1 "")
(setq annoc2x midx1)
(setq annoc2y (- (- midy1 1.75) 15.25))
(setq annoc3x midx1)
(setq annoc3y (- annoc2y 1.75))
(setq annoc2 (list annoc2x annoc2y 0))
(setq annoc3 (list annoc3x annoc3y 0))
(command "line" annoc2 annoc3 "")
(setq annoc4y (- annoc3y 15.25))
(setq annoc5y (- annoc4y 1.75))
(setq annoc4 (list midx1 annoc4y 0))
(setq annoc5 (list midx1 annoc5y 0))
(command "line" annoc4 annoc5 "")
(setq anntxt1y (+ annoc2y 7.625))
(setq anntxt1 (list midx1 anntxt1y 0))
(setq anntxt2y (+ annoc4y 7.625))
(setq anntxt2 (list midx1 anntxt2y 0))
(command "text" "j" "mc" anntxt1 h2 "90" (rtos cenht 2 3))
(command "text" "j" "mc" anntxt2 h2 "90" "0.000")
;; PLOTTING CENTRE LINE COMPLETE ;;
;; PLOTTING LEFT SIDE ;;
(setq ll (- (length dislfli) 1))
(setq ll1 (- (length htlfli) 1))
(setq r 0)
(setq c11 cenen)
(repeat ll
(setq c4 (nth r dislfli))
(setq c4 (- 0 c4))
(setq c5 (/ (* c4 1000) hscale))
(setq c6 (- midx1 c5))
(setq c1z (nth r htlfli))
(setq c7 (/ (* (- c1z datum) 1000) vscale))
(setq c10 (+ c7 midy1))
(setq c8 (list c6 midy1 0))
(setq c9 (list c6 c10 0))
(setq layer1 (tblsearch "layer" "ORDINATE" next))
(if (= layer1 nil)
(command "layer" "Make" "ORDINATE" "color" "white" "" "")
)
(command "layer" "s" "ORDINATE" "")
(command "line" c8 c9 "")
(setq layer1 (tblsearch "layer" "TOP_SURFACE" next))
(if (= layer1 nil)
(command "layer" "Make" "TOP_SURFACE" "color" "red" "" "")
)
(command "layer" "s" "TOP_SURFACE" "")
(command "line" c9 c11 "")
(setq c11 c9)
(setq annoc1 (list c6 (- midy1 1.75) 0))
(command "layer" "s" "ANNOC" "")
(command "line" c8 annoc1 "")
(setq annoc2x c6)
(setq annoc2y (- (- midy1 1.75) 15.25))
(setq annoc3x c6)
(setq annoc3y (- annoc2y 1.75))
(setq annoc2 (list annoc2x annoc2y 0))
(setq annoc3 (list annoc3x annoc3y 0))
(command "line" annoc2 annoc3 "")
(setq annoc4y (- annoc3y 15.25))
(setq annoc5y (- annoc4y 1.75))
(setq annoc4 (list c6 annoc4y 0))
(setq annoc5 (list c6 annoc5y 0))
(command "line" annoc4 annoc5 "")
(setq anntxt1y (+ annoc2y 7.625))
(setq anntxt1 (list c6 anntxt1y 0))
(setq anntxt2y (+ annoc4y 7.625))
(setq anntxt2 (list c6 anntxt2y 0))
(command "text" "j" "mc" anntxt1 h2 "90" (rtos c1z 2 3))
(setq strtxt (rtos c4 2 3))
(command "text" "j" "mc" anntxt2 h2 "90" strtxt)
(setq c3 c2)
(setq r (+ r 1))
)
;; PLOTTING LEFT SIDE COMPLETE ;;
;; PLOTTING RIGHT SIDE ;;
(setq ll (- (length disrtli) 1))
(setq ll1 (- (length htrtli) 1))
(setq r (- ll 1))
(setq x11 cenen)
(repeat ll
(setq x4 (nth r disrtli))
(setq x5 (/ (* x4 1000) hscale))
(setq x6 (+ midx1 x5))
(setq x1z (nth r htrtli))
(setq x7 (/ (* (- x1z datum) 1000) vscale))
(setq x10 (+ x7 midy1))
(setq x8 (list x6 midy1 0))
(setq x9 (list x6 x10 0))
(setq layer1 (tblsearch "layer" "ORDINATE" next))
(if (= layer1 nil)
(command "layer" "Make" "ORDINATE" "color" "white" "" "")
)
(command "layer" "s" "ORDINATE" "")
(command "line" x8 x9 "")
(setq layer1 (tblsearch "layer" "TOP_SURFACE" next))
(if (= layer1 nil)
(command "layer" "Make" "TOP_SURFACE" "color" "red" "" "")
)
(command "layer" "s" "TOP_SURFACE" "")
(command "line" x9 x11 "")
(setq x11 x9)
(setq annoc1 (list x6 (- midy1 1.75) 0))
(command "layer" "s" "ANNOC" "")
(command "line" x8 annoc1 "")
(setq annoc2x x6)
(setq annoc2y (- (- midy1 1.75) 15.25))
(setq annoc3x x6)
(setq annoc3y (- annoc2y 1.75))
(setq annoc2 (list annoc2x annoc2y 0))
(setq annoc3 (list annoc3x annoc3y 0))
(command "line" annoc2 annoc3 "")
(setq annoc4y (- annoc3y 15.25))
(setq annoc5y (- annoc4y 1.75))
(setq annoc4 (list x6 annoc4y 0))
(setq annoc5 (list x6 annoc5y 0))
(command "line" annoc4 annoc5 "")
(setq anntxt1y (+ annoc2y 7.625))
(setq anntxt1 (list x6 anntxt1y 0))
(setq anntxt2y (+ annoc4y 7.625))
(setq anntxt2 (list x6 anntxt2y 0))
(command "text" "j" "mc" anntxt1 h2 "90" (rtos x1z 2 3))
(command "text" "j" "mc" anntxt2 h2 "90" (rtos x4 2 3))
(setq x3 x2)
(setq r (- r 1))
)
;; PLOTTING RIGHT SIDE COMPLETE ;;
;; FORMATTING ;;
(setq a (- stpy 1.75))
(setq b (+ iny 1.75))
(setq c (+ inx 1.75))
(setq d (+ b 15.25))
(setq e (+ d 1.75))
(setq f (+ e 15.25))
(setq n1 (list x6 iny 0))
(setq n2 (list inx iny 0))
(setq n3 (list inx stpy 0))
(setq n4 (list x6 stpy 0))
(setq n5 (list x6 a 0))
(setq n6 (list c f 0))
(setq n7 (list c e 0))
(setq n8 (list x6 e 0))
(setq n9 (list x6 d 0))
(setq n10 (list c d 0))
(setq n11 (list c b 0))
(setq n12 (list x6 b 0))
(setq layer2 (tblsearch "layer" "MISC" next))
(if (= layer2 nil)
(command "layer" "Make" "MISC" "color" "magenta" "" "")
)
(command "layer" "s" "MISC" "")
(command "line" n1 n2 "")
(command "line" n2 n3 "")
(command "line" n3 n4 "")
(command "line" n4 n5 "")
(command "line" n5 n6 "")
(command "line" n6 n7 "")
(command "line" n7 n8 "")
(command "line" n8 n9 "")
(command "line" n9 n10 "")
(command "line" n10 n11 "")
(command "line" n11 n12 "")
(setq ab (/ (distance n1 n2) 2))
(setq t1 (list (+ inx ab) (- iny 5.5) 0))
(command "text" "j" "mc" t1 h3 "0" title)
(setq allx (+ c 1.1))
(setq y1 (+ b 6.6))
(setq y2 (+ e 6.6))
(setq y3 (+ stpy 1.6))
(setq t2 (list allx y1 0))
(setq t3 (list allx y2 0))
(setq t4 (list allx y3 0))
(setq txt (strcat "Datum = " datu " M. above MSL"))
(command "text" t2 h1 "0" "Offset in Meter")
(command "text" t3 h1 "0" "Elevation in Meter")
(command "text" t4 h1 "0" txt)
;; FORMATTING COMPLETE ;;
(setq a (distance n1 n2))
(setq b (+ a 20))
(setq inx (+ inx b))
(setq i (+ i 1))
(setq j 1)
(setq txt (vlax-safearray-get-element arrtot i j))
)
(setvar "osmode" gv)
(setvar "cmdecho" 1)
) |
_______________________________________
psw: cea de la wjndowsXP gigabyte..
|
|
| pus acum 3 ani |
|
