Main Menu

lisp

Creat de monge, Feb 25, 2008, 09:56 PM

« precedentul - următorul »

Corvinus

Ce simplu ar fi fost daca era dcl-u si lispu in limbaj de cartier:
(incarca_frate_fialog)
(actioneaza_frate_asta)
(porneste_frate_dialog)
 :zzz:
Dar e simplu in principiu vb ta ii zici ce sa faca si face e pe principiul GIGO (garbage in garbage out) deci daca ii dai gunoi gunoi iti scoate nu poate scoate aur.

Modificat de Corvinus (08-12-2010 11:55:59)

John Doe

#16
Ca tot am trecut pe-aici... va spun ce am patit ieri, poate o fi de folos si altora:
Voiam sa scriu un multiline text din LISP, cu o anumita marime, aliniere, si spatiat la 1.5 randuri. Deci îi scriu linia:

(command "mtext" '(10 20) "J" "TL" "L" "A" "1.5x" "H" 2.5 '(20 30) textline "")

Si observ ca nu-mi spatiaza liniile nici de-al dracului... tot la un rând scrie. Am incercat si cu "Exactly", cu tot felul de valori absurde, nimic. Dupa vreo ora, imi dau seama ca daca îi declar prima data spatierea si pe urma inaltimea textului nu-si calculeaza spatiile dintre randuri, care sunt functie de inaltimea literelor. Dar daca la linia de comanda scriu prima data inaltimea textului si dupa aia spatierea merge:

(command "mtext" '(10 20) "J" "TL"  "H" 2.5 "L" "A" "1.5x" '(20 30) textline "")

advex

#17
Referitor la intrebarea initiala privind animatia in Autocad cu autolisp va semnalez codul pentru o astfel de aplicatie.


sursa: http://www.theswamp.org

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; by qjchen@gmail.com South China University of Technology            ;;;
;; Ball collide Test V0.1  2010.12.20                                  ;;;
;; Base on momentum theorem and theorem of kinetic energy              ;;;
;; Bug: sometimes the balls are sticky                                 ;;;
;; Will be modify in the next version                                  ;;;
;; Before test, please open a new dwg                                  ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:test( / a b clst clst1 i j leng mlst newcenter res rlst ss velo velolst x)
  (setq velo 20 a 2000 b 1500)
  (makerecandcircle a b)
  (setq ss (std-sslist (ssget)) leng (length ss)) 
  (foreach x ss
    (setq x (entget x)
          clst (append clst (list (cdr (assoc 10 x))))
          rlst (append rlst(list (cdr (assoc 40 x))))
          mlst (append mlst (list (* (cdr (assoc 40 x)) (cdr (assoc 40 x)))))
          velolst (append velolst (list (list (- (random-n velo) (/ velo 2.0)) (- (random-n 10) (/ velo 2.0)))))
    )
  )
  (repeat 1500
    (setq i 0)
    (foreach x ss
      (reflect-change i 0 a 0 b)
      (setq j (1+ i))
      ; the next step will change all the veolist
      (repeat (- leng i 1)
(if
  (< (distance (nth i clst) (nth j clst)) (+ (nth i rlst)(nth j rlst)))
  (setq res (updatevelolst (nth i clst) (nth j clst) (nth i velolst) (nth j velolst) (nth i mlst) (nth j mlst))
velolst (SubstNth (car res) i velolst)
velolst (SubstNth (cadr res) j velolst)
  )
)
(setq j (1+ j))
      )
      (setq i (1+ i))
    )
   ; the next step will change all the clist 
    (setq clst1 nil i 0)   
    (foreach x ss
(setq newcenter (polar (nth i clst) 0 (car (nth i velolst)))
      newcenter (polar newcenter (/ pi 2) (cadr (nth i velolst)))
      clst1 (append clst1 (list newcenter))
      i (1+ i)
)
    )
    (setq clst clst1)
   ; this step will update all the
   ; centerlist
    (setq i 0)
    (foreach x ss
      (setq x (entget x))
      (setq x (subst (cons 10 (nth i clst)) (assoc 10 x) x))
      (entmod x)
      (setq i (1+ i))
    )
    (command "delay" "30")
  )
  (princ)
)

;;; Selection Set => ordered list of entities
(defun STD-SSLIST (ss / n lst)
  (if (eq 'PICKSET (type ss))
    (repeat (setq n (fix (sslength ss))) ; fixed
      (setq lst (cons (ssname ss (setq n (1- n))) lst))
    )
  )
)

;;; vovka
;;; http://www.theswamp.org/index.php?topic=30563.0
(defun SubstNth (NewItem Position InList /)
  (if InList
    (if (zerop Position)
      (cons NewItem (cdr InList))
      (cons (car InList) (SubstNth NewItem (1- Position) (cdr InList)))
    )
  )
)

;;; substitute the 2 dimension list's i and j element(i and j start from 0
(defun qj-setnmth (new i j lst)
  (SubstNth (SubstNth new j (nth i lst)) i lst)
)

;;;coordinate transform
(defun vxy->v12 (vx vy alpha)
  (list (+ (* vx (cos alpha)) (* vy (sin alpha))) (- (* vy (cos alpha))(* vx (sin alpha))))
)
(defun v12->vxy (v1 v2 alpha)
  (list (- (* v1 (cos alpha)) (* v2 (sin alpha))) (+ (* v2 (cos alpha))(* v1 (sin alpha))))
)
;;; from internet
(defun random ()
  (setq seed (if seed (rem (+ (* seed 15625.7) 0.21137152) 1) 0.3171943))
)
(defun random-n (n)
  (* n (random))
)

;;;;; According to the momentum theorem and theorem of kinetic energy
;;;;; change the velocity
(defun updatevelolst (center0 center1 veo1l veo2l m0 m1 / alpha v01 v01new v0xy12 v11 v11new v1xy12)
  (setq alpha (angle center0 center1))
  (setq v0xy12 (vxy->v12 (car veo1l) (cadr veo1l) alpha))
  (setq v01 (car v0xy12))
  (setq v1xy12 (vxy->v12 (car veo2l) (cadr veo2l) alpha))
  (setq v11 (car v1xy12))
  (setq v01new (/ (+ (* v01 (- m0 m1)) (* 2 m1 v11)) (+ m0 m1)))
  (setq v11new (/ (+ (* v11 (- m1 m0)) (* 2 m0 v01)) (+ m0 m1)))
  (list (v12->vxy v01new (cadr veo2l) alpha) (v12->vxy v11new (cadr v1xy12) alpha))
)
;;;;reflect the ball on the edge
(defun reflect-change (i x1 x2 y1 y2)
  (if (or
(< (- (car (nth i clst)) (nth i rlst)) x1)
(> (+ (car (nth i clst)) (nth i rlst)) x2)
      )
    (setq velolst (qj-setnmth (* -1 (car (nth i velolst))) i 0 velolst))
  )
  (if (or
(< (- (cadr (nth i clst)) (nth i rlst)) y1)
(> (+ (cadr (nth i clst)) (nth i rlst)) y2)
      )
    (setq velolst (qj-setnmth (* -1 (cadr (nth i velolst))) i 1 velolst))
  )
)
;;;;;ini
(defun makerecandcircle(a b)
  (command "rectangle" (list 0 0) (list a b))
  (q:entmake:circle (list 200 300) 150 "0" 1)
  (q:entmake:circle (list 800 600) 250 "0" 2)
  (q:entmake:circle (list 1200 500) 100 "0" 3)
  (q:entmake:circle (list 1400 300) 125 "0" 4)
  (command "ZOOM" "E" "" "zoom" ".9x")
)

(defun q:entmake:circle (center rad layer color)
  (entmake (list (cons 0 "CIRCLE") ;***
(cons 6 "BYLAYER") (cons 8 layer) (cons 10 center) ;***
(cons 40 rad) ;***
(cons 39 0.0) (cons 62 color) (cons 210 (list 0.0 0.0 1.0))
   )
  )
)

(princ "\n by qjchen@gmail.com, command is test")

Modificat de advex (20-12-2010 15:04:55)

DAN.ARBA

Super tare programul celui de la South China University of Technology. Daca sunteti atenti, veti observa ca (aproape) respecta legea conservarii impulsului (bine-nteles, masa e proportionala cu diamentrul cercului aici).

Modificat de DAN.ARBA (20-12-2010 20:54:11)

advex

#19
CitatSuper tare programul celui de la South China University of Technology. Daca sunteti atenti, veti observa ca respecta legea conservarii impulsului (bine-nteles, masa e proportionala cu diamentrul cercului aici).

Stiinta de carte... :)

ARTIFICII cu autolisp



[attach name=FireWorks.lsp.txt type=text/x-lisp]4[/attach]

DAN.ARBA

Advex, de ce mi-ai copiat comentariul?  :rolleyes:

advex

#21
CitatAdvex, de ce mi-ai copiat comentariul?  :rolleyes:

Dupa regulile generale ale unui forum, cand dai un raspuns sau faci un comentariu aceasta operatiune se incadreaza la categoria "citat", copierea este cu totul altceva!    :(  :(

Promit ca nu se va mai repeta...



Modificat de advex (21-12-2010 12:15:21)

Mit

Sau poate ca a fost postarea 666 a lui Advex; si-o fi bagat cineva coada.  ;)  :rotfl:

sacoracad

Stop joc! De unde s-a pornit subiectul? Hai sa-i lasam pe procesatorii de imagine video sau jucarele sa foloseasca alte programe gen 3Dmax, etc. Aici e vorba de CAD-uri, Lisp-uri si chesti serioase, nu cerculete si artificii. :hi:

granicub

#24
:cool:   :hi: ma simt bine aici


423/580px 11.9KB

granicub


                  poate unii dintre voi stiti ,alti,poate ca nu  http://www.3xforum.ro/img/smilies/rusine.png">am un ARX  de pe net care ma  ajuta mult la deschidera de fisiere AUTOCAD IN thumbnails si doresc sa-l fac cunoscut celor ce nu il au.Se incarca cu Load applications .Salvati in notepad ci denumirea de // MdiTab18.arx 

                           http://www.fileshare.ro/50634625460.4" target="_blank">http://www.fileshare.ro/50634625460.4



               

andreistiop


                  salutare!
as vrea sa stiu cum se poate exporta din acad map 6, din dwg si dxf, in pdf

bineinteles as vrea o varianta free daca se poate

multumesc



               

adrianc


                  Ti-am raspuns http://topograf.3xforum.ro/viewtopic.php?pid=37513#37513" target="_blank">aici

_______________________________________
La muncă! nu la întins mâna.


               
La muncă! nu la întins mâna.

andreistiop


                  
adrianc a scris:

Ti-am raspuns http://topograf.3xforum.ro/viewtopic.php?pid=37513#37513" target="_blank">aici



multumesc