[Nhờ chỉnh sửa] Lisp ghi cao độ

Tháng 8 6, 2011

Em viết lisp cd (tham khảo code có sẵn và chỉnh sửa):

 ; Thiet lap cac thong so
 (defun c:cd()
 (if (not h) (setq h 1))
(if (= tx nil) (setq tx 1))
(if (= ty nil) (setq ty 1))
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
        tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
        ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/")))
(if h1 (setq h h1))
(if tx1 (setq tx (/ 1 tx1)))
(if ty1 (setq ty (/ 1 ty1)))
 ; Ket thuc thiet lap
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0)); Lay toa do diem tim
;; Chon text
    (setq ed (entget (car (entsel "\nChon cao do tim: "))))
    (setq sst1 (entget ed))                      ;;hien thi record doi tuong
    (setq sst (cdr (assoc 1 sst1)))                 ;;Lay noi dung text:ma DXF=1
    (setq sta1 (atof sst))
;; ket thuc chon
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))
(While (/= pt nil)
(command "osmode" 0)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq x1 (car pt) y1 (cadr pt)); Lay toa do diem chen
(setq y (- sta1 (- y1 y0)))
(setq x (- x1 x0))
;(setvar "DIMZIN" 0)         
(cond ((> x 0) (setq x (strcat "" (rtos (* x tx) 2 2))))
        ((< x 0) (setq x (rtos (abs (* x tx)) 2 2)))
        ((= x 0) (setq x "0.00"))         )
(cond ((> y 0) (setq y (strcat "+" (rtos (* y ty) 2 2))))
        ((< y 0) (setq y (rtos (* y ty) 2 2)))
        ((= y 0) (setq y "%%p0.00")))
(progn
(if (AND (>= ang 0) (< ang (/ pi 2)))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (/ pi 2)) (< ang pi))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang pi) (< ang (+ pi (/ pi 2))))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.6 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (+ pi (/ pi 2))) (< ang (* 2 pi)))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
);progn
(command "pline" pt "w" 0 (* 0.45 h) pt3 "w" 0 0 pt4 pt5 ""
 "text" "m" pt6 h 0 y
 "text" "m" pt7 h 0 x)
;(setvar "DIMZIN" DZ)
(command "osmode" 15359)
(setq pt (getpoint "\nDiem chen: "))
);progn
);while 
;;;;;;;;;;;
 (princ)
);end

Sau khi em thực hiện lệnh bị lỗi :

Command: cd

Cao text < 1.00 >:

Ty le theo phuong X <1/1.00>: 1/

Ty le theo phuong Y <1/0.10>: 1/

Diem tim TN tu nhien

Chon cao do tim: ; error: bad argument type: lentityp ((-1 . <Entity name:

7eff2c40>) (0 . "TEXT") (330 . <Entity name: 7ed16cf8>) (5 . "9CB8") (100 .

"AcDbEntity") (67 . 0) (410 . "Model") (8 . "ENTTDTUNHIEN") (62 . 0) (100 .

"AcDbText") (10 164.527 -129.537 0.0) (40 . 2.0) (1 . "6.37") (50 . 1.5708) (41

. 1.0) (51 . 0.0) (7 . "ChuSo") (71 . 0) (72 . 2) (11 163.527 -124.099 0.0)

(210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))

Lisp cd có tác dụng ghi cao độ của 1 điểm chưa biết dựa vào điểm gốc đã biết cao độ

Tháng 8 6, 2011

Em viết lisp cd (tham khảo code có sẵn và chỉnh sửa):

;; Viet ham moi by Son Pro
;;;;;;
 ; Thiet lap cac thong so
 (defun c:cd()
 (if (not h) (setq h 1))
(if (= tx nil) (setq tx 1))
(if (= ty nil) (setq ty 1))
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
        tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
        ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/")))
(if h1 (setq h h1))
(if tx1 (setq tx (/ 1 tx1)))
(if ty1 (setq ty (/ 1 ty1)))
 ; Ket thuc thiet lap
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0)); Lay toa do diem tim
;; Chon text
    (setq ed (entget (car (entsel "\nChon cao do tim: "))))
    (setq sst1 (entget ed))                      ;;hien thi record doi tuong
    (setq sst (cdr (assoc 1 sst1)))                 ;;Lay noi dung text:ma DXF=1
    (setq sta1 (atof sst))
;; ket thuc chon
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))
(While (/= pt nil)
(command "osmode" 0)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq x1 (car pt) y1 (cadr pt)); Lay toa do diem chen
(setq y (- sta1 (- y1 y0)))
(setq x (- x1 x0))
;(setvar "DIMZIN" 0)         
(cond ((> x 0) (setq x (strcat "" (rtos (* x tx) 2 2))))
        ((< x 0) (setq x (rtos (abs (* x tx)) 2 2)))
        ((= x 0) (setq x "0.00"))         )
(cond ((> y 0) (setq y (strcat "+" (rtos (* y ty) 2 2))))
        ((< y 0) (setq y (rtos (* y ty) 2 2)))
        ((= y 0) (setq y "%%p0.00")))
(progn
(if (AND (>= ang 0) (< ang (/ pi 2)))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (/ pi 2)) (< ang pi))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang pi) (< ang (+ pi (/ pi 2))))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.6 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (+ pi (/ pi 2))) (< ang (* 2 pi)))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
);progn
(command "pline" pt "w" 0 (* 0.45 h) pt3 "w" 0 0 pt4 pt5 ""
 "text" "m" pt6 h 0 y
 "text" "m" pt7 h 0 x)
;(setvar "DIMZIN" DZ)
(command "osmode" 15359)
(setq pt (getpoint "\nDiem chen: "))
);progn
);while 
;;;;;;;;;;;
 (princ)
);end

Sau khi em thực hiện lệnh bị lỗi :

Command: cd

Cao text < 1.00 >:

Ty le theo phuong X <1/1.00>: 1/

Ty le theo phuong Y <1/0.10>: 1/

Diem tim TN tu nhien

Chon cao do tim: ; error: bad argument type: lentityp ((-1 . <Entity name:

7eff2c40>) (0 . "TEXT") (330 . <Entity name: 7ed16cf8>) (5 . "9CB8") (100 .

"AcDbEntity") (67 . 0) (410 . "Model") (8 . "ENTTDTUNHIEN") (62 . 0) (100 .

"AcDbText") (10 164.527 -129.537 0.0) (40 . 2.0) (1 . "6.37") (50 . 1.5708) (41

. 1.0) (51 . 0.0) (7 . "ChuSo") (71 . 0) (72 . 2) (11 163.527 -124.099 0.0)

(210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2))

Lisp cd có tác dụng ghi cao độ của 1 điểm chưa biết dựa vào điểm gốc đã biết cao độ.

Mong các bác xem giúp.Hi vọng em có thể hoàn thành nó !

Cám ơn sự quan tâm !

Bạn code bị dư nên lỗi, sửa như thế này thì hết lỗi đó, và còn lỗi nào kế tiếp (nếu có) thì bạn tự sửa cho mau lên tay.

Sửa 2 dòng dưới đây

(setq sst1 (entget ed)) ;;hien thi record doi tuong

(setq sst (cdr (assoc 1 sst1))) ;;Lay noi dung text:ma DXF=1

Thành 1 dòng duy nhất

(setq sst (cdr (assoc 1 ed))) ;;Lay noi dung text:ma DXF=1

Thân thương!

Tháng 8 7, 2011

;; Chon text

(setq ed (entget (car (entsel "\nChon cao do tim: "))))

(setq sst1 (entget ed)) ;;hien thi record doi tuong

Bạn bị entget 2 lần, lần đầu thì ok vì đối số là ename của đối tượng (car (entsel)) => ed đã là record của đối tượng rồi, lần thứ 2 lấy entget của record chắc chắn báo lỗi rồi

=>

Bạn Bỏ 1 trong 2 thằng entget đi thôi :)

Tháng 8 7, 2011

Lisp này chinh xác là của mình viết mà. sao lại có ";; Viet ham moi by Son Pro"

Tháng 8 7, 2011

Lisp này chinh xác là của mình viết mà. sao lại có ";; Viet ham moi by Son Pro"

Nguyenngocson có nói trong nhập đề "Em viết lisp cd (tham khảo code có sẵn và chỉnh sửa)" nhưng trong file lại ghi "Viet ham moi by Son Pro" nên chưa được Pro lắm. Tuy nhiên, có thể du di được. Nhân sáng nay đọc 2 bài liên quan tới bản quyền, xin góp ý với CADViet:

CADViet đã có 2 dòng đầu mỗi khi tải lsp từ CADViet về, rất hay, nhưng nếu thêm 1 dòng "Copyright by XYZ" nữa thì càng hay hơn, bởi tránh bớt sự cầm nhầm. (Trước đây tôi tải lsp về, quên ghi tên tác giả nên mỗi khi share lại cho mọi người hoặc bổ sung rồi share thì cứ áy náy chỗ này mãi).

Thân thương!

Tháng 8 7, 2011

Lisp này chinh xác là của mình viết mà. sao lại có ";; Viet ham moi by Son Pro"

:D thế bạn ấy mới bẩu là "tham khảo có chỉnh sửa" còn gì, mặc dù đoạn chỉnh sửa không biết là bao nhiêu % ^^ (diễn đàn ít emotion cười quá, hok lăn lộn hoặc đập tay xuống đất được ^^). Thôi thì cũng là điều tất cả mọi người nên suy nghĩ. Ở các diễn đàn Tây (trừ Tàu) như thế này dễ bị tẩy chay lắm ^^.

E vẫn còn nhớ câu chuyện dùng hàm Listbox show của LeeMac, mới xóa đi cái ngày tháng viết hàm + ghi chú các đối số (vẫn để nguyên tên tác giả) mà còn bị cháo hành giềng tỏi, xin lỗi đến khổ, mà TA thì dốt chứ có phải giỏi như người ta đâu, nói mãi không diễn tả được câu "Em không cố ý" :lol:

Tháng 8 7, 2011

Lisp này chinh xác là của mình viết mà. sao lại có ";; Viet ham moi by Son Pro"

Rất xin lỗi 'Thaistreetz' về việc này. Vì em nói là tham khảo lisp và chỉnh sửa nhưng cái file lisp em lấy sửa không thấy có thông tin gì chắc người trước đó đã xóa hết thông tin về tác giả? :D. Thú thực là em mới code lisp và tối qua code khá muộn nên không để ý lắm, đôi khi Viet ham moi by Son Pro với 1 người mới code cho có hứng thú. Quả thật lisp hay thật, và cái lisp gốc rất hay vì cv nên mình sửa cho đơn giản và phù hợp với công việc!

Nhân tiện nếu mình muốn thêm hàm con để thiết lập các thông số nhập vào như h, tx, ty để chương trình giảm thiểu số lần nhập thì sử lý thế nào nhỉ ?

Rất cám ơn mọi người.

Thân !

Tháng 8 7, 2011

Rất xin lỗi 'Thaistreetz' về việc này. Vì em nói là tham khảo lisp và chỉnh sửa nhưng cái file lisp em lấy sửa không thấy có thông tin gì chắc người trước đó đã xóa hết thông tin về tác giả? :D. Thú thực là em mới code lisp và tối qua code khá muộn nên không để ý lắm, đôi khi Viet ham moi by Son Pro với 1 người mới code cho có hứng thú. Quả thật lisp hay thật, và cái lisp gốc rất hay vì cv nên mình sửa cho đơn giản và phù hợp với công việc!

Nhân tiện nếu mình muốn thêm hàm con để thiết lập các thông số nhập vào như h, tx, ty để chương trình giảm thiểu số lần nhập thì sử lý thế nào nhỉ ?

Rất cám ơn mọi người.

Thân !

Gợi ý nhé, bạn tự làm cho mau lên tay:

1). Tạo hàm con chứa 3 thằng cần nhập h, tx, ty.

2). Thêm một dòng nhập hỏi bạn có muốn thay đổi các thông số hay không, dòng này có 2 tuỳ chọn Y và N.

3). Nếu Y thì chạy tiếp hàm con, nếu N thì bỏ qua khỏi nhập lại.

Hy vọng bạn làm được.

Thân thương!

Tháng 8 7, 2011

Gợi ý nhé, bạn tự làm cho mau lên tay:

1). Tạo hàm con chứa 3 thằng cần nhập h, tx, ty.

2). Thêm một dòng nhập hỏi bạn có muốn thay đổi các thông số hay không, dòng này có 2 tuỳ chọn Y và N.

3). Nếu Y thì chạy tiếp hàm con, nếu N thì bỏ qua khỏi nhập lại.

Hy vọng bạn làm được.

Thân thương!

Mình đã sửa hàm con:

  ; Thiet lap cac thong so
(defun tso (h tx ty)
   (if (not h) (setq h 1))
(if (= tx nil) (setq tx 1))
(if (= ty nil) (setq ty 1))
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
        tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
        ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/")))
(if h1 (setq h h1))
(if tx1 (setq tx tx1))
(if ty1 (setq ty ty1))
)
 ; Ket thuc khoi tao
 (defun c:cdtn()
(tso h tx ty); Goi ham
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0)); Lay toa do diem tim
;; Chon text
    (setq ed (entget (car (entsel "\nChon cao do tim: "))))
    (setq sst (cdr (assoc 1 ed)))                 ;;Lay noi dung text:ma DXF=1
    (setq sta1 (atof sst))
;; ket thuc chon
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))
(While (/= pt nil)
(command "osmode" 0)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq x1 (car pt) y1 (cadr pt)); Lay toa do diem chen
(setq dty (- y1 y0))
(setq dtx (- x1 x0))
(setq y (+ sta1 (* dty ty)))
(setq x (* dtx tx))
;(setvar "DIMZIN" 0)         
(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
        ((< x 0) (setq x (rtos (abs x) 2 2)))
        ((= x 0) (setq x "0.00"))         )
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
        ((< y 0) (setq y (rtos y 2 2)))
        ((= y 0) (setq y "%%p0.00")))
(progn
(if (AND (>= ang 0) (< ang (/ pi 2)))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (/ pi 2)) (< ang pi))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang pi) (< ang (+ pi (/ pi 2))))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.6 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (+ pi (/ pi 2))) (< ang (* 2 pi)))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
);progn
(command "pline" pt "w" 0 (* 0.45 h) pt3 "w" 0 0 pt4 pt5 ""
 "text" "m" pt6 h 0 y
 "text" "m" pt7 h 0 x)
;(setvar "DIMZIN" DZ)
(command "osmode" 15359)
(setq pt (getpoint "\nDiem chen: "))
);progn
);while 
;;;;;;;;;;;
 (princ)
);end

Nhưng khi chạy lisp báo lỗi ??? Cao text < 1.00 >:

Ty le theo phuong Y <1/1.00>: 1/10

Diem tim TN tu nhien

Chon cao do tim: osmode

Enter new value for OSMODE <15359>: 15359

Command:

Diem chen: osmode

Enter new value for OSMODE <15359>: 0

Command:

Phia chen: <Ortho off> ; error: bad argument type: numberp: nil

Hình như là khi khai báo tx trong hàm con.Khi load nó vào trong lisp không nhận ?

Mong bạn check giùm !

Tháng 8 7, 2011

Bạn chú ý về biến cục bộ và biến toàn cục :) Dòng (/ h tx ty) sẽ xóa (set nil) h, tx, ty của bạn sau khi thực hiện hàm con. Thành ra hàm con của bạn sẽ không còn ý nghĩa gì nữa

Tháng 8 7, 2011

Mình đã sửa hàm con:

  ; Thiet lap cac thong so
(defun tso (h tx ty)
   (if (not h) (setq h 1))
(if (= tx nil) (setq tx 1))
(if (= ty nil) (setq ty 1))
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
        tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
        ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/")))
(if h1 (setq h h1))
(if tx1 (setq tx tx1))
(if ty1 (setq ty ty1))
)
 ; Ket thuc khoi tao
 (defun c:cdtn()
(tso h tx ty); Goi ham
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0)); Lay toa do diem tim
;; Chon text
    (setq ed (entget (car (entsel "\nChon cao do tim: "))))
    (setq sst (cdr (assoc 1 ed)))                 ;;Lay noi dung text:ma DXF=1
    (setq sta1 (atof sst))
;; ket thuc chon
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))
(While (/= pt nil)
(command "osmode" 0)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq x1 (car pt) y1 (cadr pt)); Lay toa do diem chen
(setq dty (- y1 y0))
(setq dtx (- x1 x0))
(setq y (+ sta1 (* dty ty)))
(setq x (* dtx tx))
;(setvar "DIMZIN" 0)         
(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
        ((< x 0) (setq x (rtos (abs x) 2 2)))
        ((= x 0) (setq x "0.00"))         )
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
        ((< y 0) (setq y (rtos y 2 2)))
        ((= y 0) (setq y "%%p0.00")))
(progn
(if (AND (>= ang 0) (< ang (/ pi 2)))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (/ pi 2)) (< ang pi))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang pi) (< ang (+ pi (/ pi 2))))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.6 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (+ pi (/ pi 2))) (< ang (* 2 pi)))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
);progn
(command "pline" pt "w" 0 (* 0.45 h) pt3 "w" 0 0 pt4 pt5 ""
 "text" "m" pt6 h 0 y
 "text" "m" pt7 h 0 x)
;(setvar "DIMZIN" DZ)
(command "osmode" 15359)
(setq pt (getpoint "\nDiem chen: "))
);progn
);while 
;;;;;;;;;;;
 (princ)
);end

Nhưng khi chạy lisp báo lỗi ??? Cao text < 1.00 >:

Ty le theo phuong Y <1/1.00>: 1/10

Diem tim TN tu nhien

Chon cao do tim: osmode

Enter new value for OSMODE <15359>: 15359

Command:

Diem chen: osmode

Enter new value for OSMODE <15359>: 0

Command:

Phia chen: <Ortho off> ; error: bad argument type: numberp: nil

Hình như là khi khai báo tx trong hàm con.Khi load nó vào trong lisp không nhận ?

Mong bạn check giùm !

1). Bạn dùng hàm con chỉ 1 lần thì viết nó làm chi cho nó mệt, vì trong lsp không thấy sử dụng lại nó nếu muốn.

2). Có vài sai sót nữa.

Bạn thử dùng cái này xem sao (xin lỗi Bác Thaistreet)

(defun tso ()
   (if (not h) (setq h 1))
(if (= tx nil) (setq tx 1))
(if (= ty nil) (setq ty 1))
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
        tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
        ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/")))
(if h1 (setq h h1))
(if tx1 (setq tx tx1))
(if ty1 (setq ty ty1))
)
 ; Ket thuc khoi tao
 (defun c:cdtn()
(tso); Goi ham
;(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
(osnap (setq pt0 (getpoint "Diem tim TN tu nhien")) "end") (print)
(setq x0 (car pt0) y0 (cadr pt0)); Lay toa do diem tim
;; Chon text
    (setq ed (entget (car (entsel "\nChon cao do tim: "))))
    (setq sst (cdr (assoc 1 ed)))                 ;;Lay noi dung text:ma DXF=1
    (setq sta1 (atof sst))
;; ket thuc chon
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))
(While (/= pt nil)
(command "osmode" 0)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq x1 (car pt) y1 (cadr pt)); Lay toa do diem chen
(setq dty (- y1 y0))
(setq dtx (- x1 x0))
(setq y (+ sta1 (* dty ty)))
(setq x (* dtx tx))
;(setvar "DIMZIN" 0)         
(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
        ((< x 0) (setq x (rtos (abs x) 2 2)))
        ((= x 0) (setq x "0.00"))         )
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
        ((< y 0) (setq y (rtos y 2 2)))
        ((= y 0) (setq y "%%p0.00")))
(progn
(if (AND (>= ang 0) (< ang (/ pi 2)))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (/ pi 2)) (< ang pi))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang pi) (< ang (+ pi (/ pi 2))))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.6 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (+ pi (/ pi 2))) (< ang (* 2 pi)))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
);progn
(command "pline" pt "w" 0 (* 0.45 h) pt3 "w" 0 0 pt4 pt5 ""
 "text" "m" pt6 h 0 y
 "text" "m" pt7 h 0 x)
;(setvar "DIMZIN" DZ)
(command "osmode" 15359)
(setq pt (getpoint "\nDiem chen: "))
);progn
);while 
;;;;;;;;;;;
 (princ)
);end

Tháng 8 7, 2011

@Bác ĐVH :e cũng có vài góp ý :

- Trong hàm con (tso) nên khử các biến tx1,ty1,h1. Hàm chính cũng thế ạ ^^

- Vì Hàm con là setting nên nên cho phép người dùng gọi lại nó trong mỗi bước input , kiểu như

(initget "S")(setq ed (car (entsel "\nChon cao do tim hoac nhan S de vao Setting: ")))(if (ed = "S") => (tso))

Tháng 8 7, 2011

- Trong hàm con (tso) nên khử các biến tx1,ty1,h1. Hàm chính cũng thế ạ ^^

- Vì Hàm con là setting nên nên cho phép người dùng gọi lại nó trong mỗi bước input , kiểu như

(initget "S")(setq ed (car (entsel "\nChon cao do tim hoac nhan S de vao Setting: ")))(if (ed = "S") => (tso))

Mình code thử :

  ; Thiet lap cac thong so
(defun tso ()
   (if (not h) (setq h 0.4))
(if (= tx nil) (setq tx 1))
(if (= ty nil) (setq ty 1))
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
        tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
        ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/")))
(if h1 (setq h h1))
(if tx1 (setq tx (/ 1 tx1)))
(if ty1 (setq ty (/ 1 ty1)))
)
 ; Ket thuc khoi tao
 (defun c:cdtn()
;;;;
(prompt "\n Thiet lap thong so ban dau:")
 (initget 1 "YES NO")
 (setq caidat (getkword (strcat "YES/NO/<" caidat "> :")))
(cond ((= caidat "Y") (tso))
     ((= caidat "N"))
)

Đoạn này để lựa chọn như sau:Nếu chọn Y sẽ mặc định thông số ban đầu. Nếu N sẽ thiết lập lại. Không hiểu sao code lại lỗi. Em check mà không được?

Các bạn góp ý giùm. Thân !

Tháng 8 7, 2011

@Bác ĐVH :e cũng có vài góp ý :

- Trong hàm con (tso) nên khử các biến tx1,ty1,h1. Hàm chính cũng thế ạ ^^

- Vì Hàm con là setting nên nên cho phép người dùng gọi lại nó trong mỗi bước input , kiểu như

(initget "S")(setq ed (car (entsel "\nChon cao do tim hoac nhan S de vao Setting: ")))(if (ed = "S") => (tso))

1). Tôi chỉ giải đáp thằng (tso) cho bạn NNS. Chứ khử biến thì còn hằng hà sa số biến phải khử nữa.

2). Cái này tôi đã hướng dẫn NNS, sau đó mới hỏi lại để NNS tự làm. Có lẽ NNS mới làm đến đó thì bị lỗi nên hỏi cái đã.

Nói thêm: thôi để NNS tự mày mò thêm thì hay hơn. Vả lại, cứ đem ra sửa hoài chắc đụng đến cả Bác Thaistreetz.

Tôi dừng ở đây.

Thânthương!

Tháng 8 7, 2011

Cũng đâu đến mức là động chạm đến ai? Vì mình mới học nên hay hỏi vậy thôi.

Mình muốn biết cách tạo hàm con để sau này sử dụng cho các lisp khác nữa, không đơn thuần chỉ là cho riêng lisp này.

Nhưng nếu gọi hàm (tso ) thì sau mỗi lần thực hiện lệnh nó luôn bắt thiết lập lại? Có cách nào mình thiết lập hàm tso trước, sau đó mới thực hiện lệnh, nếu N không nhập lại, Y thì có. Mình đã search trên diễn đàn nhưng chưa được ?

Thân !

Tháng 8 7, 2011

Cũng đâu đến mức là động chạm đến ai? Vì mình mới học nên hay hỏi vậy thôi.

Mình muốn biết cách tạo hàm con để sau này sử dụng cho các lisp khác nữa, không đơn thuần chỉ là cho riêng lisp này.

Nhưng nếu gọi hàm (tso ) thì sau mỗi lần thực hiện lệnh nó luôn bắt thiết lập lại? Có cách nào mình thiết lập hàm tso trước, sau đó mới thực hiện lệnh, nếu N không nhập lại, Y thì có. Mình đã search trên diễn đàn nhưng chưa được ?

Thân !

Thôi thì, code cho Bạn vậy. Do code hơi vội (đang hơi bận), nếu có lỗi tớ sẽ sửa lại.

PS: sửa đổi lại chút xíu luc 5h36'. Bạn xem ưng bụng không?

(defun tso ()
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
         tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
         ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/"))))
(defun c:cdtn()
(if (not h)  (setq h 1))
(if (not tx) (setq tx 1))
(if (not ty) (setq ty 1))
(initget "Y N")
(setq caidat (getkword "Ban co muon dat lai cac gia tri h-tx-ty khong? Y<N>:  "))
(cond ((= caidat "Y") (tso))
           ((or (= caidat nil) (= caidat "N")) T))
(if h1 (setq h h1))
(if tx1 (setq tx (/ 1 tx1)))
(if ty1 (setq ty (/ 1 ty1)))
(osnap (setq pt0 (getpoint "Diem tim TN tu nhien")) "end") (print)
(setq x0 (car pt0) y0 (cadr pt0)); Lay toa do diem tim
    (setq ed (entget (car (entsel "\nChon cao do tim: "))))
    (setq sst (cdr (assoc 1 ed)))                 ;;Lay noi dung text:ma DXF=1
    (setq sta1 (atof sst))
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))
(While (/= pt nil)
(command "osmode" 0)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq x1 (car pt) y1 (cadr pt)); Lay toa do diem chen
(setq dty (- y1 y0))
(setq dtx (- x1 x0))
(setq y (+ sta1 (* dty ty)))
(setq x (* dtx tx))
;(setvar "DIMZIN" 0)         
(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
        ((< x 0) (setq x (rtos (abs x) 2 2)))
        ((= x 0) (setq x "0.00"))         )
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
        ((< y 0) (setq y (rtos y 2 2)))
        ((= y 0) (setq y "%%p0.00")))
(progn
(if (AND (>= ang 0) (< ang (/ pi 2)))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (/ pi 2)) (< ang pi))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang pi) (< ang (+ pi (/ pi 2))))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.6 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (+ pi (/ pi 2))) (< ang (* 2 pi)))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.15 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
);progn
(command "pline" pt "w" 0 (* 0.45 h) pt3 "w" 0 0 pt4 pt5 ""
 "text" "m" pt6 h 0 y
 "text" "m" pt7 h 0 x)
;(setvar "DIMZIN" DZ)
(command "osmode" 15359)
(setq pt (getpoint "\nDiem chen: "))
);progn
);while 
;;;;;;;;;;;
 (princ)
);end

Tháng 8 7, 2011

:D thế bạn ấy mới bẩu là "tham khảo có chỉnh sửa" còn gì, mặc dù đoạn chỉnh sửa không biết là bao nhiêu % ^^ (diễn đàn ít emotion cười quá, hok lăn lộn hoặc đập tay xuống đất được ^^). Thôi thì cũng là điều tất cả mọi người nên suy nghĩ. Ở các diễn đàn Tây (trừ Tàu) như thế này dễ bị tẩy chay lắm ^^.

E vẫn còn nhớ câu chuyện dùng hàm Listbox show của LeeMac, mới xóa đi cái ngày tháng viết hàm + ghi chú các đối số (vẫn để nguyên tên tác giả) mà còn bị cháo hành giềng tỏi, xin lỗi đến khổ, mà TA thì dốt chứ có phải giỏi như người ta đâu, nói mãi không diễn tả được câu "Em không cố ý" :lol:

Gà vãi

Tháng 8 7, 2011

Mình code thử :

(setq caidat (getkword (strcat "YES/NO/<" caidat "> :")))

Đoạn này để lựa chọn như sau:Nếu chọn Y sẽ mặc định thông số ban đầu. Nếu N sẽ thiết lập lại. Không hiểu sao code lại lỗi. Em check mà không được?

Các bạn góp ý giùm. Thân !

Đoạn màu đỏ sẽ khiến lisp crash, vì bạn nhớ khi mới chạy đến dòng đó, caidat vẫn chưa nhận giá trị nào, (caidat = nil), mà hàm Strcat thì không chơi với Nil

Để khắc phục bạn có thể phải thiết lập giá trị ban đầu cho nó bằng dòng này :

(or caidat (setq caidat "N"))
(setq caidat (getkword (strcat "YES/NO/<" caidat "> :")))

Hoặc bỏ chữ caidat màu đỏ đi.

Gà vãi

Không chơi ém từ ngoài vào chứ :angry2:

Tháng 8 7, 2011

Cũng đâu đến mức là động chạm đến ai? Vì mình mới học nên hay hỏi vậy thôi.

Mình muốn biết cách tạo hàm con để sau này sử dụng cho các lisp khác nữa, không đơn thuần chỉ là cho riêng lisp này.

Nhưng nếu gọi hàm (tso ) thì sau mỗi lần thực hiện lệnh nó luôn bắt thiết lập lại? Có cách nào mình thiết lập hàm tso trước, sau đó mới thực hiện lệnh, nếu N không nhập lại, Y thì có. Mình đã search trên diễn đàn nhưng chưa được ?

Thân !

Đã hiệu chỉnh cho Bạn ở #16, Bạn xem có ưng cái bụng chưa nhé!

Thân thương!

Tháng 8 7, 2011

Đã hiệu chỉnh cho Bạn ở #16, Bạn xem có ưng cái bụng chưa nhé!

Thân thương!

Cám ơn mọi người rất nhiều.Đã giúp đỡ em code khi cần :).

Nhân tiện cho em hỏi ?

Khai báo biến toàn cục cho lisp như nào? Với ví dụ trên của em: Nếu trước khi thực hiện lisp cdtn, em muốn có muốn một lisp ts để cài đặt các thông số ban đầu khi chạy lisp.Và các biến này sẽ tự nhận vào lisp cdtn?

Thân !

Tháng 8 7, 2011

Xét trong phạm vi hẹp thì có thể hiểu nôm na :

Biến cục bộ : chỉ tồn tại sau khi thực hiện xong chức năng của hàm / phiên làm việc, sau đó sẽ bị trả về Nil

Bạn thường làm việc này khi khai báo hàm (defun abc (/ x y z)....). Dấu / + danh sách các biến bị khử sẽ tương đương với việc bạn thêm dòng này ở cuối hàm (setq x nil y nil z nil)

Biến toàn cục : không làm 2 việc trên ^^, nghĩa là muốn x,y,z tồn tại cùng giá trị của nó, hãy xóa hết / x y z đi, hoặc không ép nó về Nil ^^

Tháng 8 11, 2011

Giờ em muốn cải tiến lisp có tính năng như file sau : My link

Mong các bác xem giúp ??

Em có tham khảo code tại: http://www.cadviet.com/forum/index.php?showtopic=13203&st=3500

và chỉnh sửa nhưng chưa được:

Tháng 8 12, 2011

Em đã code thử như sau:

; Thiet lap cac thong so
(defun tso ()
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
         tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
         ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/"))))
 ; Ket thuc khoi tao
(defun ktra ()
(if (not (tblsearch "layer" "CaodoTN"))
 (command "-LAYER" "m" "CaodoTN" "c" 6 "CaodoTN" "" )
 (setvar "clayer" "CaodoTN" )
)
)
 (defun c:cdtn()
;;;;
(prompt "\n Thiet lap thong so ban dau: Cao chu=0.4;TL-X=1;TL-Y=1")
;; Thiet lap thong so
(if (not h)  (setq h 0.4))
(if (not tx) (setq tx 1))
(if (not ty) (setq ty 1))
(initget "Y N")
(setq caidat (getkword "\n Ban co muon thiet lap lai thong so ban dau khong? Y<N>:  "))
(cond ((= caidat "Y") (tso))
           ((or (= caidat nil) (= caidat "N")) T))
(if h1 (setq h h1))
(if tx1 (setq tx tx1))
(if ty1 (setq ty ty1))
;;;;; Ket thuc thiet lap
(Ktra)
(setvar "cecolor" "bylayer")
;(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
;(osnap (setq pt0 (getpoint "Diem tim TN tu nhien")) "end") (print)
(command "osmode" 33) (princ) 
(setq pt0 (getpoint "Diem tim TN tu nhien"))
(setq x0 (car pt0) y0 (cadr pt0)); Lay toa do diem tim
;; Chon text
    (setq ed (entget (car (entsel "\nChon cao do tim: "))))
    (setq sst (cdr (assoc 1 ed)))                 ;;Lay noi dung text:ma DXF=1
    (setq sta1 (atof sst))
;; ket thuc chon
;(command "osmode" 15359) 
;(setq pt (getpoint "\nDiem chen: "))
; Doan ma them
;;;;;;;;;(setq pt (getpoint "\nDiem chen: "))
(alert "\n Chon cac duong chuan")
(setq sslg (acet-ss-to-list (ssget (list (cons 0 "*LINE") (cons 8 "chuan")(cons 62 2)))))
;;;;;;;;lng (car (entsel "\n Hay chon line goc"))
(alert "\n Chon cac duong can xac dinh giao diem")
(setq ssln (ssget (list (cons 0 "*LINE") (cons 8 "LINEDONGTN,ENTTNTHIETKE")))
       sslst (acet-ss-to-list ssln)
)
;;;;;(While (/= pt nil)
(foreach lng sslg
(foreach ln sslst
(setq pt (car (acet-geom-intersectwith lng ln 0)))
(if pt
;; Ket thuc ma them

;(While (/= pt nil)
(command "osmode" 0) (princ)
(command "ORTHO" "OFF") (princ)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq x1 (car pt) y1 (cadr pt)); Lay toa do diem chen
(setq dty (- y1 y0))
(setq dtx (- x1 x0))
(setq y (+ sta1 (* dty (/ 1 ty))))
(setq x (* dtx (/ 1 tx)))
;(setvar "DIMZIN" 0)         
(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
        ((< x 0) (setq x (rtos (abs x) 2 2)))
        ((= x 0) (setq x "0.00")))
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
        ((< y 0) (setq y (rtos y 2 2)))
        ((= y 0) (setq y "%%p0.00")))
(progn
(if (AND (>= ang 0) (< ang (/ pi 2)))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.0 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 4.5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (/ pi 2)) (< ang pi))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.0 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 4.5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang pi) (< ang (+ pi (/ pi 2))))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.0 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 4.5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (+ pi (/ pi 2))) (< ang (* 2 pi)))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.0 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 4.5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
);progn
(command "pline" pt "w" 0 (* 0.35 h) pt3 "w" 0 0 pt4 pt5 ""
 "text" "m" pt6 h 0 y
 "text" "m" pt7 h 0 x)
;(setvar "DIMZIN" DZ)
(command "osmode" 15359) (princ)
(command "osmode" 33) (princ) 
;(setq pt (getpoint "\nDiem chen: "))
);progn
);if
);foreach
);;;foreach1
(command "osmode" 15359) (princ)
;;;;;;;;;;;
(princ)
);end

Nhưng lisp lỗi ?

Thông báo lỗi là gì đây ????

- Lỗi syntax cơ bản của hàm If ở dòng này :

(if pt
;; Ket thuc ma them

;(While (/= pt nil)

(command "osmode" 0) (princ)

(command "ORTHO" "OFF") (princ)

Tháng 8 12, 2011

Em đã code thử như sau:

Hề hề hề,

Lỗi đúng như bạn đã biết, là do cú pháp của hàm if

Do hàm if chỉ chấp nhận một hàm hành động nên khi bạn muốn có nhiều hành động với cùng một điều kiện thì bạn phải dùng thêm hàm (progn ..... và nhét tất cả các hành động bạn muốn thực hiện vào trong hàm này rồi đóng nó lại.

Vì dụ: (if diều kiện a

(progn

Hành động b

hành động c

.........

hành động n

);;;;;end progn

(progn

..........

............

);;;;;end progn

);;;;;;end if

Mình đã sửa lại cái đoạn code trên của bạn thành cái có lẽ bạn muốn. Tuy nhiên, trong trường hợp các giao điểm nằm gần nhau thì các text sẽ bị chồng lên nhau đó. Tùy bạn test và lựa chọn.


; Thiet lap cac thong so
(defun tso ()
(setq h1 (getreal (strcat "\n Cao text < " (rtos h 2 2) " >: "))
         tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
         ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/"))))
 ; Ket thuc khoi tao
(defun ktra ()
(if (not (tblsearch "layer" "CaodoTN"))
 (command "-LAYER" "m" "CaodoTN" "c" 6 "CaodoTN" "" )
 (setvar "clayer" "CaodoTN" )
)
)
 (defun c:cdtn()
(command "undo" "be")
;;;;
(prompt "\n Thiet lap thong so ban dau: Cao chu=0.4;TL-X=1;TL-Y=1")
;; Thiet lap thong so
(if (not h)  (setq h 0.4))
(if (not tx) (setq tx 1))
(if (not ty) (setq ty 1))
(initget "Y N")
(setq caidat (getkword "\n Ban co muon thiet lap lai thong so ban dau khong? Y<N>:  "))
(cond ((= caidat "Y") (tso))
           ((or (= caidat nil) (= caidat "N")) T))
(if h1 (setq h h1))
(if tx1 (setq tx tx1))
(if ty1 (setq ty ty1))
;;;;; Ket thuc thiet lap
(Ktra)
(setvar "cecolor" "bylayer")
;(setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
;(osnap (setq pt0 (getpoint "Diem tim TN tu nhien")) "end") (print)
(command "osmode" 33) (princ) 
(setq pt0 (getpoint "Diem tim TN tu nhien"))
(setq x0 (car pt0) y0 (cadr pt0)); Lay toa do diem tim
;; Chon text
    (setq ed (entget (car (entsel "\nChon cao do tim: "))))
    (setq sst (cdr (assoc 1 ed)))                 ;;Lay noi dung text:ma DXF=1
    (setq sta1 (atof sst))
;; ket thuc chon
;(command "osmode" 15359) 
;(setq pt (getpoint "\nDiem chen: "))
; Doan ma them
;;;;;;;;;(setq pt (getpoint "\nDiem chen: "))
(alert "\n Chon cac duong chuan")
(setq sslg (acet-ss-to-list (ssget (list (cons 0 "*LINE") (cons 8 "chuan")(cons 62 2)))))
;;;;;;;;lng (car (entsel "\n Hay chon line goc"))
(alert "\n Chon cac duong can xac dinh giao diem")
(setq ssln (ssget (list (cons 0 "*LINE") (cons 8 "LINEDONGTN,ENTTNTHIETKE")))
       sslst (acet-ss-to-list ssln)
)
;;;;;(While (/= pt nil)
(setq ptside (getpoint "\nPhia chen:"))
(foreach lng sslg
(foreach ln sslst
(setq pt (car (acet-geom-intersectwith lng ln 0)))
(if pt
;; Ket thuc ma them
(Progn
;(While (/= pt nil)
(command "osmode" 0) (princ)
(command "ORTHO" "OFF") (princ)
(setq ;;;;;;;;; ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq x1 (car pt) y1 (cadr pt)); Lay toa do diem chen
(setq dty (- y1 y0))
(setq dtx (- x1 x0))
(setq y (+ sta1 (* dty (/ 1 ty))))
(setq x (* dtx (/ 1 tx)))
;(setvar "DIMZIN" 0)         
(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
        ((< x 0) (setq x (rtos (abs x) 2 2)))
        ((= x 0) (setq x "0.00")))
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
        ((< y 0) (setq y (rtos y 2 2)))
        ((= y 0) (setq y "%%p0.00")))
(progn
(if (AND (>= ang 0) (< ang (/ pi 2)))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.0 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 4.5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (/ pi 2)) (< ang pi))
(setq 	pt3 (list (car pt) (+ (cadr pt) (* 1.0 h)))
pt4 (list (car pt) (+ (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 4.5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang pi) (< ang (+ pi (/ pi 2))))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.0 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (- (car pt4) (* 4.5 h)) (cadr pt4))
pt6 (list (- (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (- (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
(if (AND (>= ang (+ pi (/ pi 2))) (< ang (* 2 pi)))
(setq 	pt3 (list (car pt) (- (cadr pt) (* 1.0 h)))
pt4 (list (car pt) (- (cadr pt) (* 2.5 h)))
pt5 (list (+ (car pt4) (* 4.5 h)) (cadr pt4))
pt6 (list (+ (car pt4) (* 2.5 h)) (+ (cadr pt4) (* 0.8 h)))
pt7 (list (+ (car pt4) (* 2.5 h)) (- (cadr pt4) (* 0.8 h)))))
);progn
(command "pline" pt "w" 0 (* 0.35 h) pt3 "w" 0 0 pt4 pt5 ""
 "text" "m" pt6 h 0 y
 "text" "m" pt7 h 0 x)
;(setvar "DIMZIN" DZ)
(command "osmode" 15359) (princ)
(command "osmode" 33) (princ) 
;(setq pt (getpoint "\nDiem chen: "))
);progn
);if
);foreach
);;;foreach1
(command "osmode" 15359) (princ)
(command "undo" "e")
;;;;;;;;;;;
(princ)
);end

Chúc bạn vui

Chỉnh sửa Tháng 8 12, 2011 theo phamthanhbinh
Bổ sung code đã chỉnh sửa

Tháng 8 12, 2011

Hề hề hề,

Lỗi đúng như bạn đã biết, là do cú pháp của hàm if

Do hàm if chỉ chấp nhận một hàm hành động nên khi bạn muốn có nhiều hành động với cùng một điều kiện thì bạn phải dùng thêm hàm (progn ..... và nhét tất cả các hành động bạn muốn thực hiện vào trong hàm này rồi đóng nó lại.

Chúc bạn vui

Hề hề, cái phần đấy là e edit luôn vào bài của bạn ấy sau lời nhắc "post nội dung lỗi", cho đỡ tốn đất, quên hem để Edit by :lol:

P/S : Bạn NNS đã nhiều lần post sửa code nhưng đều nói chung chung là "LỖI"

Đăng nhập

[Nhờ chỉnh sửa] Lisp ghi cao độ

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

NguyenNgocSon 43

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

Doan Van Ha 3212

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

ketxu 3018

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

Thaistreetz 539

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

Doan Van Ha 3212

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

ketxu 3018

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

NguyenNgocSon 43

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

Doan Van Ha 3212

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

NguyenNgocSon 43

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

ketxu 3018

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

Doan Van Ha 3212

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

ketxu 3018

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

NguyenNgocSon 43

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

Doan Van Ha 3212

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

NguyenNgocSon 43

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

Doan Van Ha 3212

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

Thaistreetz 539

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

ketxu 3018

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

Doan Van Ha 3212

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

NguyenNgocSon 43