Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#3761 3d.decor

3d.decor

    biết vẽ arc

  • Members
  • PipPip
  • 44 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 28 June 2011 - 03:42 PM

bác nào viết hộ em cái lisp xoay góc line
có đường line thẳng
pick điểm 1 ( gốc xoay ) pick điểm 2 lấy chiều xoay
dau đó chỉ hướng bằng chuột và gỗ 15 độ
đường line sẽ quay lên 15 đọ
  • 0

#3762 hakhoailang

hakhoailang

    biết lệnh rotate

  • Members
  • PipPipPip
  • 132 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 28 June 2011 - 04:33 PM

Hề hề hề,
Nó đây nè. Dùng thử coi nhé. Chú ý rằng khi quét vùng chọn tren trắc dọc, chớ có ôm nhầm mấy em ở khu lý trình vào nghen. Vì các em này có trùng tên, trùng layer và cả trùng màu nữa nên mình chưa loại được. nếu tách được mấy em này qua lớp khác thì tuyệt hảo luôn.
Khi quét vùng chọn các trăc ngang, lưu ý sao cho cái trắc ngang đầu tiên đúng với cái vị trí trên trắc dọc nhé.


(defun c:retn (/ tsl1 tsl2 txt tx t1 t2 t3 elt)
(vl-load-com)
(command "undo" "be")
(alert "\n Chon ten coc tren trac doc theo vung thay the")
(setq tsl1 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "TEXTTENCOC")))))
(setq tsl1 (vl-sort tsl1 '(lambda (x y) (< (car (cdr (assoc 11 (entget x)))) (car (cdr (assoc 11 (entget y))))))))
(alert "\n Chon ten coc tren trac ngang theo vung thay the")
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))
(setq tsl2 (vl-sort tsl2 '(lambda (x y) (> (cadr (cdr (assoc 11 (entget x)))) (cadr (cdr (assoc 11 (entget y))))))))
(foreach txt tsl1
(setq t1 (cdr (assoc 1 (entget txt))))
(setq n (vl-position txt tsl1))
(setq tx (nth n tsl2))
(if tx
(progn
(setq elt (entget tx)
t2 (substr (cdr (assoc 1 elt)) 1 4)
t3 (strcat t2 " " t1)
elt (subst (cons 1 t3) (assoc 1 elt) elt)
)
(entmod elt)
)
)
)
(command "undo" "e")
(princ)
)

Do cái hình trắc ngang trắc dọc của bạn hơi ti hin nên bạn có thể chơi làm nhiều phát cho dễ kiểm hoặc chơi tổng một phát cũng Ok. mà hình như số trắc ngang còn thiếu cũng khơ khớ thì phải.... Chạy phát một thì chỉ tới trắc ngang TC95 là hết trong khi trên trắc dọc có tới quá TC105 lận. hề hề hề, kiểu này khó mà lười lắm........

bác ơi em quét đối tượng trên trắc dọc thì nó nhận còn các đối tượng tên cọc trên trắc ngang nó lại không nhận bác nhỉ nó báo là Select objects: Specify opposite corner: 0 found, 0 total
bây giờ phải làm thế nào đây bác nhỉ
chọn một hay quét
  • 0

#3763 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 04:46 PM

bác ơi em quét đối tượng trên trắc dọc thì nó nhận còn các đối tượng tên cọc trên trắc ngang nó lại không nhận bác nhỉ nó báo là Select objects: Specify opposite corner: 0 found, 0 total
bây giờ phải làm thế nào đây bác nhỉ

Hề hề hề,
Kiểm tra lại xem text tên cọc có phải nằm trên lớp "ENTDAUCO" không nhé và cái font của text có đúng như font trong file bạn đã gửi không. Bởi vì mình tạo bộ lọc text theo lớp và nội dung text để hạn chế bớt số đối tượng ngoại lai làm chậm tốc độ lisp và còn gây nhầm lẫn nữa.
Đó cũng chính là nhược điểm của phương pháp chọn theo phương pháp quét, nhất là với các bản vẽ nhỏ ti hin như của bạn.
Hề hề hề,
Với bản vẽ bạn post lên mình chạy thử thì ngon choét, chả phải khiếu nại gì????
Hề hề hề,
Về cách sửa bạn có thể làm như sau:
1/- Gõ (entget (car (entsel))) trên dòng command và enter. Chọn vào cái text Cọc: ....... trên bản vẽ trắc ngang.
2/- Nhấn F2 để hiện màn hình văn bản của CAD.
3/- Mở file lisp, tìm đến dòng code:
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))
4/- Mở màn hình CAD copy đoạn text sau trong elist (8. "tênlayer") nghĩa là chỉ copy cái "tênlayer" thoi nhé
5/- Mở màn hình chứa file lisp dán cái text đó vào hàm cons thành (cons 8 "tênlayer")
6/- Mở màn hình CAD copy text trong elist (1 . "têncọc")
7/- Mở màn hình lisp dán text đó vào hàm cons thành (cons 1 "têncọc")
8/- Xóa bớt các ký tự trong "têncọc" chỉ để lại 3 ký tự đầu tiên và thêm ký tự (*) vào để thành (cons 1 "tên*")
9/- save lại file lisp thành tên khác và chạy file lisp này.

Hề hề hề, vậy hy vọng là bạn sẽ thỏa mãn và cười tít mắt.
Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3764 hakhoailang

hakhoailang

    biết lệnh rotate

  • Members
  • PipPipPip
  • 132 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 28 June 2011 - 05:11 PM

Hề hề hề,
Kiểm tra lại xem text tên cọc có phải nằm trên lớp "ENTDAUCO" không nhé và cái font của text có đúng như font trong file bạn đã gửi không. Bởi vì mình tạo bộ lọc text theo lớp và nội dung text để hạn chế bớt số đối tượng ngoại lai làm chậm tốc độ lisp và còn gây nhầm lẫn nữa.
Đó cũng chính là nhược điểm của phương pháp chọn theo phương pháp quét, nhất là với các bản vẽ nhỏ ti hin như của bạn.
Hề hề hề,
Với bản vẽ bạn post lên mình chạy thử thì ngon choét, chả phải khiếu nại gì????
Hề hề hề,
Về cách sửa bạn có thể làm như sau:
1/- Gõ (entget (car (entsel))) trên dòng command và enter. Chọn vào cái text Cọc: ....... trên bản vẽ trắc ngang.
2/- Nhấn F2 để hiện màn hình văn bản của CAD.
3/- Mở file lisp, tìm đến dòng code:
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))
4/- Mở màn hình CAD copy đoạn text sau trong elist (8. "tênlayer") nghĩa là chỉ copy cái "tênlayer" thoi nhé
5/- Mở màn hình chứa file lisp dán cái text đó vào hàm cons thành (cons 8 "tênlayer")
6/- Mở màn hình CAD copy text trong elist (1 . "têncọc")
7/- Mở màn hình lisp dán text đó vào hàm cons thành (cons 1 "têncọc")
8/- Xóa bớt các ký tự trong "têncọc" chỉ để lại 3 ký tự đầu tiên và thêm ký tự (*) vào để thành (cons 1 "tên*")
9/- save lại file lisp thành tên khác và chạy file lisp này.

Hề hề hề, vậy hy vọng là bạn sẽ thỏa mãn và cười tít mắt.
Chúc bạn vui.

em dùng cái antxt ẩn hết line rồi dùng layiso sau đó dùng retn rồi quét thôi .bản vẽ thì em vvãn lấy cái gửi lên cho bác đó .có sử cái gì đâu .
nếu ko ẩn line quét hết cả nó có dc ko bác nhỉ hay lại sai.
  • 0

#3765 hakhoailang

hakhoailang

    biết lệnh rotate

  • Members
  • PipPipPip
  • 132 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 28 June 2011 - 07:24 PM

Hề hề hề,
Kiểm tra lại xem text tên cọc có phải nằm trên lớp "ENTDAUCO" không nhé và cái font của text có đúng như font trong file bạn đã gửi không. Bởi vì mình tạo bộ lọc text theo lớp và nội dung text để hạn chế bớt số đối tượng ngoại lai làm chậm tốc độ lisp và còn gây nhầm lẫn nữa.
Đó cũng chính là nhược điểm của phương pháp chọn theo phương pháp quét, nhất là với các bản vẽ nhỏ ti hin như của bạn.
Hề hề hề,
Với bản vẽ bạn post lên mình chạy thử thì ngon choét, chả phải khiếu nại gì????
Hề hề hề,
Về cách sửa bạn có thể làm như sau:
1/- Gõ (entget (car (entsel))) trên dòng command và enter. Chọn vào cái text Cọc: ....... trên bản vẽ trắc ngang.
2/- Nhấn F2 để hiện màn hình văn bản của CAD.
3/- Mở file lisp, tìm đến dòng code:
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))
4/- Mở màn hình CAD copy đoạn text sau trong elist (8. "tênlayer") nghĩa là chỉ copy cái "tênlayer" thoi nhé
5/- Mở màn hình chứa file lisp dán cái text đó vào hàm cons thành (cons 8 "tênlayer")
6/- Mở màn hình CAD copy text trong elist (1 . "têncọc")
7/- Mở màn hình lisp dán text đó vào hàm cons thành (cons 1 "têncọc")
8/- Xóa bớt các ký tự trong "têncọc" chỉ để lại 3 ký tự đầu tiên và thêm ký tự (*) vào để thành (cons 1 "tên*")
9/- save lại file lisp thành tên khác và chạy file lisp này.

Hề hề hề, vậy hy vọng là bạn sẽ thỏa mãn và cười tít mắt.
Chúc bạn vui.

bác ơi lem làm như bác rồi thay vào rồi mà nó báo là 0 cả bác à .
khi em ấn F2 nó như sau

Select objects: Specify opposite corner: 0 found, 0 total

Select objects: *Cancel*
; error: Function cancelled

Command: *Cancel*

Command: *Cancel*

Command: *Cancel*

Command: (entget (car (entsel)))

Select object: ((-1 . <Entity name: 7efadac8>) (0 . "TEXT") (330 . <Entity
name: 7ef71cf8>) (5 . "1868A9") (100 . "AcDbEntity") (67 . 0) (410 . "Model")
(8 . "ENTDAUCO") (100 . "AcDbText") (10 43541.3 3782.85 0.0) (40 . 0.6) (1 .
"Cäc:H8") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 1)
(11 43542.9 3782.85 0.0) (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0))

em thay cái này vào hàm cons "ENTDAUCO" nhưng rồi cũng bó tay rồi bác .
cuối cungv vẫn chưa tít mắt dc rồi .
bác xem có hướng nào khác ko bác .
thank bác .
  • 0

#3766 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 07:49 PM

bác ơi lem làm như bác rồi thay vào rồi mà nó báo là 0 cả bác à .
khi em ấn F2 nó như sau

Select objects: Specify opposite corner: 0 found, 0 total

Select objects: *Cancel*
; error: Function cancelled

Command: *Cancel*

Command: *Cancel*

Command: *Cancel*

Command: (entget (car (entsel)))

Select object: ((-1 . <Entity name: 7efadac8>) (0 . "TEXT") (330 . <Entity
name: 7ef71cf8>) (5 . "1868A9") (100 . "AcDbEntity") (67 . 0) (410 . "Model")
(8 . "ENTDAUCO") (100 . "AcDbText") (10 43541.3 3782.85 0.0) (40 . 0.6) (1 .
"Cäc:H8") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 1)
(11 43542.9 3782.85 0.0) (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0))

em thay cái này vào hàm cons "ENTDAUCO" nhưng rồi cũng bó tay rồi bác .
cuối cungv vẫn chưa tít mắt dc rồi .
bác xem có hướng nào khác ko bác .
thank bác .

Hề hề hề,
Ây da, nếu đúng như cái elist bạn pót này thì chả phải thay thiếc gì sốt. Bạn gửi bản vẽ lên đây mình coi xem nào chứ vô cái lý, bản vẽ bạn gửi mình nó chạy phăm phăm cơ mà.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3767 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 28 June 2011 - 08:07 PM

Hề hề hề,
Bạn có thể tự mình làm được điều này mà.
Này nhé, hãy vô hiệu hóa các dòng code có dính tới cái stt đi là Ok thôi. Cách vô hiệu hóa một dòng code là thêm vào phía trước dòng code đó một hay vài ký tự chấm phẩy ( ; ) bạn ạ.
Trước hết bạn hãy thử thêm vào phía trước dòng code:
stt (append stt (list N))
để thành:
;;;; stt (append stt (list N))

Sau đó lưu file lisp lại thành file mới và chạy thử file mới này xem sao nhé. Có gì ta sẽ lại trao đổi tiếp.
Hề hề hề....


:( :( :( huhu em làm theo bác nhưng vẫn chưa được bác ạ. bác xem lại hộ em cái.
  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#3768 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 08:47 PM

:( :( :( huhu em làm theo bác nhưng vẫn chưa được bác ạ. bác xem lại hộ em cái.

Hề hề hề,
Vậy chứ nó ra cái chi và không được ở chỗ nào chớ????
Hề hề hề
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3769 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 28 June 2011 - 08:54 PM

bác nào viết hộ em cái lisp xoay góc line
có đường line thẳng
pick điểm 1 ( gốc xoay ) pick điểm 2 lấy chiều xoay
dau đó chỉ hướng bằng chuột và gỗ 15 độ
đường line sẽ quay lên 15 đọ

Ồ, sao nghe giống cái lisp Rotate thế bạn nhỉ ^^
Banj 3d chú ý : post file kèm để minh hoạ ý tưởng!
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3770 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 28 June 2011 - 08:59 PM

Hề hề hề,
Vậy chứ nó ra cái chi và không được ở chỗ nào chớ????
Hề hề hề



em sửa cái dòng như bác chỉ. vậy mà nó vẫn có số thứ tự như cũ,nó lỳ thật chẳng thay đổi gì cả. thế mới khổ chứ.
em đã sửa thêm trên dòng đó nữa. thằn số thứ tự đã mất nhưng thằng vòng tròn vẫn trơ trơ ra đó bác à. giả quyết cho em cái vòng tròn đó nhé.
  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#3771 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 10:00 PM

em sửa cái dòng như bác chỉ. vậy mà nó vẫn có số thứ tự như cũ,nó lỳ thật chẳng thay đổi gì cả. thế mới khổ chứ.
em đã sửa thêm trên dòng đó nữa. thằn số thứ tự đã mất nhưng thằng vòng tròn vẫn trơ trơ ra đó bác à. giả quyết cho em cái vòng tròn đó nhé.

Hề hề hề,
Vậy là bạn sắp thành lisper rồi đó. Ráng lên chút xíu nữa là tới thiên đường thôi mà.
Hề hề hề,...
Bạn xài cái này coi có ưng cái bụng không hè???
Hãy so sánh với cái bạn đã sửa để biết mình đã làm gì và từ đó có thêm kinh nghiệm sửa lisp theo ý mình và trở thành lisper hỉ...


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12225
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td1 (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:"))

(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos(car diem) 2 4)
y (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
;;; N (strcat "N" (rtos k 2 0))
;;;stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
;;; "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
;;; "text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
;;; tstt(nth k stt)
)
(command ;;;;; "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3772 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 28 June 2011 - 10:22 PM

Hề hề hề,
Vậy là bạn sắp thành lisper rồi đó. Ráng lên chút xíu nữa là tới thiên đường thôi mà.
Hề hề hề,...
Bạn xài cái này coi có ưng cái bụng không hè???
Hãy so sánh với cái bạn đã sửa để biết mình đã làm gì và từ đó có thêm kinh nghiệm sửa lisp theo ý mình và trở thành lisper hỉ...



;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12225
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td1 (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:"))

(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos(car diem) 2 4)
y (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
;;; N (strcat "N" (rtos k 2 0))
;;;stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
;;; "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
;;; "text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
;;; tstt(nth k stt)
)
(command ;;;;; "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado



hì hì bác quá khen. em chẳng qua meo mù vớ phải cá chiên thui. cái lsp của bác em dùng thử thấy y như của em pác ạ. cái vòng tròn đó nó ko chịu biến mất thì làm thế nào hở bác. thank bác trước nhìu nhé.
  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#3773 hakhoailang

hakhoailang

    biết lệnh rotate

  • Members
  • PipPipPip
  • 132 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 28 June 2011 - 10:38 PM

Hề hề hề,
Ây da, nếu đúng như cái elist bạn pót này thì chả phải thay thiếc gì sốt. Bạn gửi bản vẽ lên đây mình coi xem nào chứ vô cái lý, bản vẽ bạn gửi mình nó chạy phăm phăm cơ mà.

file em nó đây bác
bác xem hộ em cái
http://www.mediafire...x4b13z5zzvdykwt
thank bác
  • 0

#3774 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 11:04 PM

hì hì bác quá khen. em chẳng qua meo mù vớ phải cá chiên thui. cái lsp của bác em dùng thử thấy y như của em pác ạ. cái vòng tròn đó nó ko chịu biến mất thì làm thế nào hở bác. thank bác trước nhìu nhé.

Hề hề hề,
Ây da, nó y chang là đúng rồi, tại vì cái lisp mình sửa do láu táu nên bị lỗi, khi bạn load nó sẽ thấy báo lỗi là ; error: malformed list on input
Mà khổ nỗi là mình không sửa lệnh nên khi bạn nhập lệnh td1 thì CAD vẫn chạy theo cái lisp cũ của bạn. Vậy chả u như kỹ làm sao được.
Bây chừ bạn làm tiếp như ri chắc là Ok liền.
1/- Tìm tới dòng code:
;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )
2/- Đưa con trỏ về vị trí trước dấu ngoặc đóng cuối cùng rồi enter một phát để thành:
;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N
)

3/- Save lại và load nó lên chạy thử coi.

Sở dĩ vậy là do cái ngoặc ấy nó đóng hàm command, chứ không phải đóng "text". Mình vẫn để nó trên dòng đó mà thêm ;;; vào đầu nên nó bị vô hiệu hóa và làm cho thằng command khôing được đóng lại. Vậy nên lisp bị lỗi.
Nay bạn enter một phát là nó nhẩy xuống dòng khác và không bị vô hiệu hóa nữa, hề hề hề vậy là OK.
Đảm bảo sau khi bạn làm vậy sẽ không còn cái vòng tròn nào nữa do toàn bộ lisp chỉ có mỗi một dòng code để tạo vòng tròn thì mình đã vô hiệu hóa rồi còn đâu.
Không tin hãy test thử sẽ biết....
Hề hề hề...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3775 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 28 June 2011 - 11:16 PM

Hề hề hề,
Ây da, nó y chang là đúng rồi, tại vì cái lisp mình sửa do láu táu nên bị lỗi, khi bạn load nó sẽ thấy báo lỗi là ; error: malformed list on input
Mà khổ nỗi là mình không sửa lệnh nên khi bạn nhập lệnh td1 thì CAD vẫn chạy theo cái lisp cũ của bạn. Vậy chả u như kỹ làm sao được.
Bây chừ bạn làm tiếp như ri chắc là Ok liền.
1/- Tìm tới dòng code:
;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )
2/- Đưa con trỏ về vị trí trước dấu ngoặc đóng cuối cùng rồi enter một phát để thành:
;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N
)

3/- Save lại và load nó lên chạy thử coi.

Sở dĩ vậy là do cái ngoặc ấy nó đóng hàm command, chứ không phải đóng "text". Mình vẫn để nó trên dòng đó mà thêm ;;; vào đầu nên nó bị vô hiệu hóa và làm cho thằng command khôing được đóng lại. Vậy nên lisp bị lỗi.
Nay bạn enter một phát là nó nhẩy xuống dòng khác và không bị vô hiệu hóa nữa, hề hề hề vậy là OK.
Đảm bảo sau khi bạn làm vậy sẽ không còn cái vòng tròn nào nữa do toàn bộ lisp chỉ có mỗi một dòng code để tạo vòng tròn thì mình đã vô hiệu hóa rồi còn đâu.
Không tin hãy test thử sẽ biết....
Hề hề hề...



hì hì bác quả là hay. rất biết cách chỉ bảo. em đã sửa ok rùi. cám ơn bác rất rất nhìu. em rất muốn học về lsp nhưng do não em nó phẳng quá hay sao ý. em đọc hướng dẫn cách viết lsp mà chẳng hỉu cái mô tê gì cả, bác cho em hỏi các hàm trong lsp là do cad định sẵn hay là mình thêm vô :excl:
  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#3776 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 11:34 PM

file em nó đây bác
bác xem hộ em cái
http://www.mediafire...x4b13z5zzvdykwt
thank bác

Hề hề hề,
Giời ạ, chả hiểu bạn làm thế nào chứ mình test một phát nó chạy phăm phăm hết cả ngót 300 cái trắc ngang của bạn luôn. Bắt đầu từ tằng cọc H8 đến tụt nõ là thằng cọc 41 hay 42 gì đó mà .
Vậy là lisp hổng có sao, chỉ có cái cách bạn thao tác thôi. hãy thử lại xem nhé. Nếu không được thì bạn nói yêu cầu chạy từ đâu đến đâu mình sẽ chạy xong rồi gửi bạn. Chứ chịu bó tay rồi, hổng sửa Tthêm gì được nữa cả.
Hề hề hề....
Bác nào rảnh giúp mình test thử một phát kẻo bạn khoai hà này hổng chịu tin.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3777 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 11:45 PM

hì hì bác quả là hay. rất biết cách chỉ bảo. em đã sửa ok rùi. cám ơn bác rất rất nhìu. em rất muốn học về lsp nhưng do não em nó phẳng quá hay sao ý. em đọc hướng dẫn cách viết lsp mà chẳng hỉu cái mô tê gì cả, bác cho em hỏi các hàm trong lsp là do cad định sẵn hay là mình thêm vô :excl:

Hế hế hề,
Các hàm trong lisp là do lisp nó định nghĩa, dưng mà CAD nó hiểu được cái thằng lisp nó nói cái chi nên nó cứ làm như thằng lisp bảo thôi. Tức mỗi cái là thằng CAD nó chả chịu học tiếng ta nên ta bảo nó đếch nghe nên phải nhờ thằng lísp nó nói hộ. Muốn vậy ta lại phải học cái tiếng của thằng lisp kiểu như học ngoại ngữ ý mà. Ban đầu học cũng thấy nó khoai khoai khoai, nhưng học được một ít rồi cứ nói vong mạng lên là quen dần ngay, cứ làm tới rồi sai đâu ta sửa đó là OK. Chỉ cần đừng có sai ĐÂY mà lại sửa ĐÓ là bỏ u thôi.
Vậy nên bạn chịu khó sửa lisp cho vừa ý bạn là một việc nên làm lắm lắm. Từ đó sẽ vỡ ra nhanh hơn và việc trở thành lisper chả mấy hồi.
Hề hề hề, chúc bạn chóng thành lisper.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3778 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 28 June 2011 - 11:57 PM

Hế hế hề,
Các hàm trong lisp là do lisp nó định nghĩa, dưng mà CAD nó hiểu được cái thằng lisp nó nói cái chi nên nó cứ làm như thằng lisp bảo thôi. Tức mỗi cái là thằng CAD nó chả chịu học tiếng ta nên ta bảo nó đếch nghe nên phải nhờ thằng lísp nó nói hộ. Muốn vậy ta lại phải học cái tiếng của thằng lisp kiểu như học ngoại ngữ ý mà. Ban đầu học cũng thấy nó khoai khoai khoai, nhưng học được một ít rồi cứ nói vong mạng lên là quen dần ngay, cứ làm tới rồi sai đâu ta sửa đó là OK. Chỉ cần đừng có sai ĐÂY mà lại sửa ĐÓ là bỏ u thôi.
Vậy nên bạn chịu khó sửa lisp cho vừa ý bạn là một việc nên làm lắm lắm. Từ đó sẽ vỡ ra nhanh hơn và việc trở thành lisper chả mấy hồi.
Hề hề hề, chúc bạn chóng thành lisper.



hì hì OK để em thử tạo ít nếp nhăn trên não xem có được không.tại em làm bên khảo sát giao thông nên rất mún biết về lsp và biết viết lsp để cho nó nhẹ bớt cái đầu đi. chứ không làm thủ công hoài mất time lắm và còn đau cả đầu nữa chứ.à còn cái này mún hỏi pác nưa. mình muốn biết các hàm của lsp thì xem ở đâu hả bác?
  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#3779 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 29 June 2011 - 12:17 AM

hì hì OK để em thử tạo ít nếp nhăn trên não xem có được không.tại em làm bên khảo sát giao thông nên rất mún biết về lsp và biết viết lsp để cho nó nhẹ bớt cái đầu đi. chứ không làm thủ công hoài mất time lắm và còn đau cả đầu nữa chứ.à còn cái này mún hỏi pác nưa. mình muốn biết các hàm của lsp thì xem ở đâu hả bác?

Hề hề hề, cái ni bạn qua bên topic Hỏi về lísp và Hướng dẫn học lisp sẽ có khá đầy đủ bạn ạ. Post vô đây e hơi bị vượt rào. Hề hề hề
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3780 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 29 June 2011 - 06:43 AM

Hề hề hề, cái ni bạn qua bên topic Hỏi về lísp và Hướng dẫn học lisp sẽ có khá đầy đủ bạn ạ. Post vô đây e hơi bị vượt rào. Hề hề hề


ok. để em tìm hiểu.nhiều cái em vẫn còn gà nên không hiểu rõ nguyên tắc của diễn đàn. có gì sai các bác chỉ cho đi tù chung thân thui chứ đừng tử hình nhé. :D :unsure: :blush:
  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html