Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
hhhhgggg

[Đã xong] Lisp copy text số, tăng theo hàm bậc nhất !

Các bài được khuyến nghị

Còn một dòng mà e loay hoay đổi các kiểu nửa tiếng mà không được, Bác nào check lỗi giúp em với ạ !

Chọn 1 tron 2 cách: hoặc Int hoặc Real:

[b]Nếu Int:[/b]

(or *m* (setq *m* [color=#FF0000]20[/color]))

(setq m ([color=#FF0000]getint[/color] (strcat "\nSo phan tu <" [color=#FF0000](itoa *m*)[/color] ">: ")))

(if (not m) (setq m *m*) (setq *m* m))

[b]Nếu Real:[/b]

(or *m* (setq *m* 20.0))

(setq m ([color=#0000CD]getreal[/color] (strcat "\nSo phan tu <" [color=#0000CD](rtos *m* 2 0)[/color] ">: ")))

(if (not m) (setq m *m*) (setq *m* m))

Nhưng, số phần tử thì nên Int thôi.

Thân thương!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

hic. lúc trước em cũng được gợi ý ITOA đó rùi, nhưng không hiểu sao lỗi. E đổi giống bác hướng dẫn nhưng mà bị lỗi ko chạy được ? chẳng hiểu vì sao. Bác xem cho em nhé

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175903&st=20entry175903
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175482&st=0entry175482
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0entry115904
(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
 (setq temperr *error*)
 (setq *error* bloi)
 ;;;;;;;;;;;;;;;;;;;
 (setq p1 (getpoint "\n Nhap diem P1 :") L '())
 ;(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(or *z1* (setq *z1* 10.0))
(setq z1 (getreal (strcat "\nCao do Z1 <" (rtos *z1* 2) ">: ")))
(if (not z1) (setq z1 *z1*) (setq *z1* z1))
 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
; (setq Z2 (getreal "\n Nhap cao do Z2 :"))
(or *z2* (setq *z2* 20.0))
(setq z2 (getreal (strcat "\nCao do Z2 <" (rtos *z2* 2) ">: ")))
(if (not z2) (setq z2 *z2*) (setq *z2* z2))
 (setq dis (distance p1 p2)
ang (angle p1 p2))
 (setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(or *m* (setq *m* 20))
(setq m (getint (strcat "\nSo phan tu <" (itoa m) ">: ")))

(or cao (setq cao 2)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu:  <" (vl-princ-to-string cao) " > :")))(cao)))
; (setq cao (getdist "\n Nhap chieu cao chu :"))  ;
 (Setq oldos (getvar "OSMODE"))
 (SETVAR "OSMODE" 0)
 (Repeat (+ m 2)
 (setq p (polar p1 ang (* i (/ dis (1+ m)))))
 (setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)   
(progn (setq Z (+ Z1 (* tana (- a) )))
 (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
  (progn (setq Z (+ Z1 (* tana (+ a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)   
(progn (setq Z (+ Z2 (* tana (- a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
  (progn (setq Z (+ Z2 (* tana (+ a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
)
)
(command "point" p)
(setq i (1+ i))
 );while
(COMMAND "LINE" P1 P2 "")
  (if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
 (vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
  (SETVAR "OSMODE" oldos)
 (setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq  ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
 (cons 72 1) (cons 73 1)
 )
)
)

 

hic. Mà e không hiểu sao cái GETINT mình thay bằng GETREAL không được nhỉ ? e hiểu nôm na thì getreal là tập hợp mẹ của getint mà ? hức !

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Thay nhưng không hiểu, thành ra bị lỗi. Thay nhưng không đọc hướng dẫn nên cũng sinh lỗi. m chưa được gán giá trị bao giờ thì bạn I toa sao được ? (Chắc bác ĐVH nhầm chỗ này)

Lỗi nhưng không thèm copy thông báo lỗi lên nên mất bao nhiêu bài vẫn chưa giải quyết xong!

 

Bạn đọc kỹ những đoạn tương tự trong lisp và lắp ghép máy móc cho đúng (chưa cần hiểu vội) là lisp chạy thôi

 

@hanam, nokia, hhhhhhgggg : Hóa ra bắt đầu từ Hhhhhhhhhhgggggggggggg :D Thâm niên Request Lisp cả mấy năm rồi đấy..Haiza

Bạn chọn 1 nick để lại đi, mình xóa những nick còn lại. Diễn đàn không có quy định về vấn đề này, tuy nhiên thep mình thấy như vậy khá là vô duyên. Thân !

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

hic. lúc trước em cũng được gợi ý ITOA đó rùi, nhưng không hiểu sao lỗi. E đổi giống bác hướng dẫn nhưng mà bị lỗi ko chạy được ? chẳng hiểu vì sao. Bác xem cho em nhé

hic. Mà e không hiểu sao cái GETINT mình thay bằng GETREAL không được nhỉ ? e hiểu nôm na thì getreal là tập hợp mẹ của getint mà ? hức !

Bạn 4h4g+hanam1210 thân mến!

Các bạn sửa chưa đúng, chưa đủ, lại còn bỏ bớt thì làm sao lisp chạy được. Tôi sửa lại cho 2 bạn đây (chú ý mấy dòng có dấu ;!!!!!!)

(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
 (setq temperr *error*)
 (setq *error* bloi)
 ;;;;;;;;;;;;;;;;;;;
 (setq p1 (getpoint "\n Nhap diem P1 :") L '())
 ;(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(or *z1* (setq *z1* 10.0))
(setq z1 (getreal (strcat "\nCao do Z1 <" (rtos *z1* 2) ">: ")))
(if (not z1) (setq z1 *z1*) (setq *z1* z1))
 (setq p2 (getpoint p1 "\n Nhap diem P2 :"))
; (setq Z2 (getreal "\n Nhap cao do Z2 :"))
(or *z2* (setq *z2* 20.0))
(setq z2 (getreal (strcat "\nCao do Z2 <" (rtos *z2* 2) ">: ")))
(if (not z2) (setq z2 *z2*) (setq *z2* z2))
 (setq dis (distance p1 p2)
ang (angle p1 p2))
 (setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(or *m* (setq *m* 20))
(setq m (getint (strcat "\nSo phan tu <" (itoa *m*) ">: ")))				;!!!!!!!!
(if (not m) (setq m *m*) (setq *m* m))						;!!!!!!!!
(or cao (setq cao 2)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu:  <" (vl-princ-to-string cao) " > :")))(cao)))
; (setq cao (getdist "\n Nhap chieu cao chu :"))  ;
 (Setq oldos (getvar "OSMODE"))
 (SETVAR "OSMODE" 0)
 (setq i 0)									;!!!!!!!
 (Repeat (+ m 2)
 (setq p (polar p1 ang (* i (/ dis (1+ m)))))
 (setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)  
(progn (setq Z (+ Z1 (* tana (- a) )))
 (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
  (progn (setq Z (+ Z1 (* tana (+ a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
)
)
(alert "OK")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)  
(progn (setq Z (+ Z2 (* tana (- a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
  (progn (setq Z (+ Z2 (* tana (+ a) )))
  (setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
 )
)
)
(command "point" p)
(setq i (1+ i))
 );while
(COMMAND "LINE" P1 P2 "")
  (if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
 (vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
  (SETVAR "OSMODE" oldos)
 (setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq  ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
 (cons 72 1) (cons 73 1)
 )
)
)

P/S (9h12'): hoá ra "các" bạn là 1 bạn, thế là không tốt đâu nhé!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×