Đến nội dung


Hình ảnh
5 stars - based on 24598 reviews
* * * - - 3 Bình chọn

Hướng dẫn lập trình Lisp


  • Please log in to reply
493 replies to this topic

#261 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 127 (tàm tạm)

Đã gửi 23 September 2010 - 04:57 PM

Ai sửa giúp e đoạn code này với
E nghi nó hỏng chỗ lấy tâm của đg tròn:

;; free lisp from cadviet.com
(defun BatDauVe() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThucVe() (setvar "osmode" OldOs) (princ))
(defun c:vidu (/ ten tam bk i p1 p2 p3 p4 )
(setq ss (ssget '((0 . "circle"))))
(setq i 0)
(while (< i (sslength ss))
   (setq ten (ssname ss i))
tam (cdr (assoc 10 ss))
bk (cdr (assoc 40 ss))
p1 (polar tam 0.0 (+ bk 75))
p2 (polar tam pi (+ bk 75))
p3 (polar p2 (/ pi 2) (+ bk 75 ))
p4 (polar p1 (/ (* pi 3) 2 ) (+ bk 75 ))
;(setvar "clayer" "manh")
(BatDauVe)
(command "CIRCLE" tam (+ bk 50))
;;;----------
;(setvar "clayer" "thay")
(command "RECTANG" p3 p4)
(KetThucVe)
 (setq i (1+ i))
);_ end while
);_ end defun

  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#262 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4332 Bài viết
Điểm đánh giá: 3837 (đỉnh cao)

Đã gửi 23 September 2010 - 05:06 PM

Ai sửa giúp e đoạn code này với
E nghi nó hỏng chỗ lấy tâm của đg tròn:

;; free lisp from cadviet.com
(defun BatDauVe() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThucVe() (setvar "osmode" OldOs) (princ))
(defun c:vidu (/ ten tam bk i p1 p2 p3 p4 )
(setq ss (ssget '((0 . "circle"))))
(setq i 0)
(while (< i (sslength ss))
   (setq ten (ssname ss i))
tam (cdr (assoc 10 ss))
bk (cdr (assoc 40 ss))
p1 (polar tam 0.0 (+ bk 75))
p2 (polar tam pi (+ bk 75))
p3 (polar p2 (/ pi 2) (+ bk 75 ))
p4 (polar p1 (/ (* pi 3) 2 ) (+ bk 75 ))
;(setvar "clayer" "manh")
(BatDauVe)
(command "CIRCLE" tam (+ bk 50))
;;;----------
;(setvar "clayer" "thay")
(command "RECTANG" p3 p4)
(KetThucVe)
 (setq i (1+ i))
);_ end while
);_ end defun

Không những hỏng chổ lấy tâm mà còn hỏng chổ lấy bán kính nữa
Dấu ngoặc đóng chưa đúng
Tue_NV sửa lại :

(defun BatDauVe() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThucVe() (setvar "osmode" OldOs) (princ))
(defun c:vidu (/ ten tam bk i p1 p2 p3 p4 )
(setq ss (ssget '((0 . "circle"))))
(setq i 0)
(while (< i (sslength ss))
   (setq ten (ssname ss i)
tam (cdr (assoc 10 (entget ten)))
bk (cdr (assoc 40 (entget ten)))
p1 (polar tam 0.0 (+ bk 75))
p2 (polar tam pi (+ bk 75))
p3 (polar p2 (/ pi 2) (+ bk 75 ))
p4 (polar p1 (/ (* pi 3) 2 ) (+ bk 75 ))
)

;(setvar "clayer" "manh")
(BatDauVe)
(command "CIRCLE" tam (+ bk 50))
;;;----------
;(setvar "clayer" "thay")
(command "RECTANG" p3 p4)
(KetThucVe)
 (setq i (1+ i))
);_ end while
);_ end defun

  • 0

#263 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 127 (tàm tạm)

Đã gửi 23 September 2010 - 06:23 PM

hi hi cảm ơn bác tue nhé.
  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#264 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 914 Bài viết
Điểm đánh giá: 515 (tốt)

Đã gửi 23 September 2010 - 08:18 PM

Thế thì nó..lởm ở chỗ nào ạ :( Ngố quá nên chưa hiểu ra^^
Ví dụ với 1 pl thì thấy :...

À, đây là kết quả của lá bùa mới. còn lá bùa cũ mình post trong bài #239 mới là lởm. mình tuởng bạn hỏi về bài đó
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#265 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 September 2010 - 09:56 PM

À e hiểu rồi.Đoạn code cũ mã dxf 10 lấy đúng 1 giá trị ^^
  • 0

#266 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 127 (tàm tạm)

Đã gửi 24 September 2010 - 12:02 AM

Cũng cái líp trên nhưng khi mình thêm hàn IF để chia trường hợp thì nó lại báo lỗi
Select objects: Specify opposite corner: 3 found
Select objects: ; error: bad argument type: 2D/3D point: nil

Các bác giúp e xem nó bị làm sao vơi nhé. Thank!!!

;; free lisp from cadviet.com

(defun BatDauVe() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThucVe() (setvar "osmode" OldOs) (princ))
(defun LayDiem() p1 (polar tam 0.0 (+ bk k))
p2 (polar tam pi (+ bk k))
p3 (polar p2 (/ pi 2) (+ bk k))
p4 (polar p1 (/ (* pi 3) 2 ) (+ bk k)))
(defun c:ct (/ ten tam bk i p1 p2 p3 p4 k )
(setq ss (ssget '((0 . "circle"))))
(setq i 0)
(while (< i (sslength ss))
   (setq ten (ssname ss i)
tam (cdr (assoc 10 (entget ten)))
bk (cdr (assoc 40 (entget ten))))
(if (>= bk 300)
(setq k 75)
)
(if (and (< bk 300) (> bk 100))
(setq k 50))

(if (<= bk 100)
(setq k 25)
)
(LayDiem)
(BatDauVe)
(command "CIRCLE" tam (+ bk k))
(command "RECTANG" p3 p4)
(KetThucVe)
 (setq i (1+ i))
);_ end while
);_ end defun

  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#267 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4332 Bài viết
Điểm đánh giá: 3837 (đỉnh cao)

Đã gửi 24 September 2010 - 08:07 AM

Cũng cái líp trên nhưng khi mình thêm hàn IF để chia trường hợp thì nó lại báo lỗi
Select objects: Specify opposite corner: 3 found
Select objects: ; error: bad argument type: 2D/3D point: nil

Các bác giúp e xem nó bị làm sao vơi nhé. Thank!!!

;; free lisp from cadviet.com

(defun BatDauVe() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThucVe() (setvar "osmode" OldOs) (princ))
(defun LayDiem() p1 (polar tam 0.0 (+ bk k))
p2 (polar tam pi (+ bk k))
p3 (polar p2 (/ pi 2) (+ bk k))
p4 (polar p1 (/ (* pi 3) 2 ) (+ bk k)))
(defun c:ct (/ ten tam bk i p1 p2 p3 p4 k )
(setq ss (ssget '((0 . "circle"))))
(setq i 0)
(while (< i (sslength ss))
   (setq ten (ssname ss i)
tam (cdr (assoc 10 (entget ten)))
bk (cdr (assoc 40 (entget ten))))
(if (>= bk 300)
(setq k 75)
)
(if (and (< bk 300) (> bk 100))
(setq k 50))

(if (<= bk 100)
(setq k 25)
)
(LayDiem)
(BatDauVe)
(command "CIRCLE" tam (+ bk k))
(command "RECTANG" p3 p4)
(KetThucVe)
 (setq i (1+ i))
);_ end while
);_ end defun

Bạn bất cẩn quá. Bạn bị lỗi ở dòng này :
(defun LayDiem() p1 (polar tam 0.0 (+ bk k))
Hy vọng bạn tìm ra lỗi. :(
Bạn không cần thiết phải viết bài viết như này :

hi hi cảm ơn bác tue nhé.

Chỉ cần tick Thanks là được
  • 1

#268 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 127 (tàm tạm)

Đã gửi 24 September 2010 - 10:39 PM

Mình có câu hỏi như vậy. Nếu trong lisp có đoạn code sau:

		(initget "C K") ;;;Init keywords
(setq ans (getkword "\nBan co muon... [C/K] :")) ;;;Get answer from user
(if (= ans "C") (Command ,,,,,))


khi chạy líp nó bắt mình nhập C hoặc K nhưng chỉ thấy có hàm if cho C mà không có hàm if dùng cho K. Vậy có phải là khi mình không nhập gì mà ấn ENTER hoặc Space luôn thì nó tự nhận giá trị là K luôn à ????.
Thank!!!!
  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#269 18011985

18011985

    biết lệnh hatchedit

  • Members
  • PipPipPipPip
  • 261 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 September 2010 - 05:56 PM

Mình có câu hỏi như vậy. Nếu trong lisp có đoạn code sau:

		(initget "C K") ;;;Init keywords
(setq ans (getkword "\nBan co muon... [C/K] :")) ;;;Get answer from user
(if (= ans "C") (Command ,,,,,))


khi chạy líp nó bắt mình nhập C hoặc K nhưng chỉ thấy có hàm if cho C mà không có hàm if dùng cho K. Vậy có phải là khi mình không nhập gì mà ấn ENTER hoặc Space luôn thì nó tự nhận giá trị là K luôn à ????.
Thank!!!!

Khi bạn nhập giá trị enter hay space thì nó sẽ bỏ qua dòng lệnh getkword khi đó ans nhận giá trị nil. (Tương ứng với K)
  • 1
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#270 pfievxd

pfievxd

    biết vẽ spline

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

Đã gửi 10 October 2010 - 01:28 PM

Các bác ơi em dùng cái lisp lấy DXF để xem điểm chèn của một block mà thế nào nó bị lệch so với xem ở Properties :cheers:( Block tạo mới thì đúng nhưng đây là Block có sẵn trên bản vẽ (mà bản vẽ thì em nhận từ người khác :cheers: , có bác nào bít tại sao không ah?
  • 0

#271 codered8x

codered8x

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 10 October 2010 - 05:02 PM

Các bác ơi em dùng cái lisp lấy DXF để xem điểm chèn của một block mà thế nào nó bị lệch so với xem ở Properties :cheers:( Block tạo mới thì đúng nhưng đây là Block có sẵn trên bản vẽ (mà bản vẽ thì em nhận từ người khác :cheers: , có bác nào bít tại sao không ah?

bạn thay đổi ucs về world xem sao
(command "UCS" "W")
  • 1

#272 pfievxd

pfievxd

    biết vẽ spline

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

Đã gửi 06 November 2010 - 03:10 PM

He, Em khắc phục được roài các bác ah, bổ sung thêm (getvar "ucsorg") là Okie
  • 0

#273 theduyhuynh

theduyhuynh

    Chưa sử dụng CAD

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

Đã gửi 07 November 2010 - 05:10 AM

các bác có thư viện về hàm trong lisp ko ?
Ví dụ: hàm TEXT trong cửa sổ command thì ta nhập :
1- Toa do
2- Goc
3- Danh noi dung vao con nhay

Do đó khi viết trong lisp sẽ như thế nào ở phần gõ nội dung con nháy (command "text" "@-700,-200" "0" "nộidung" )
  • 0

#274 hung22121983

hung22121983

    Chưa sử dụng CAD

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

Đã gửi 19 November 2010 - 02:45 PM

Cho em hỏi thế này mấy bác giúp em giải đáp với, nghe nói mấy cái lập trình lisp nay ko có tác dụng với 3d solid, em mò trên mạng thì thấy có cái file lisp này khá hay và có liên quan đến solid nhưng ko hiểu cho lắm, hình như là chỉnh sửa edge và mặt của solid,mấy phần acis và sat là dùng cho solid phải ko ạ,mong các đại cao thủ chỉ giúp:
(defun draw_aperture (pnt color / p1 p2 p3 p4)
(setq p1 (mapcar'+(trans(list(- aperture)(- aperture)0)2 1 T)pnt)
p2 (mapcar'+(trans(list(- aperture) aperture 0)2 1 T)pnt)
p3 (mapcar'+(trans(list aperture aperture 0)2 1 T)pnt)
p4 (mapcar'+(trans(list aperture (- aperture)0)2 1 T)pnt)
)
(grvecs(list color p1 p2 p2 p3 p3 p4 p4 p1))
)

(defun acis_poll(/ acis_translate); device point points pointn entity
entityPrev viewsize viewctr aperture sat)

(defun acis_translate(string / item letter lst)
(setq string(strcat string" ")item"")
(while(>(strlen string)0)
(setq letter(substr string 1 1)string(substr string 2))
(if(=" "letter)
(setq lst(append lst(list item))item"")
(setq item(strcat item(chr(- 159(ascii letter)))))
)
)
lst
)


(setq index_X (cond ; we'll have to figure this out soon!
('LATEST_VERSION 4)
('PREVIOUS_VERSION 2)
)
)


(while(=(car(setq device(grread T 4 2)))5)
(and pointn(draw_aperture pointn 0))
(or(=(getvar"VIEWSIZE")viewsize)
(=(getvar"VIEWCTR" )viewctr )
(setq viewctr (getvar"VIEWCTR" )
viewsize(getvar"VIEWSIZE")
aperture(*(/
viewsize(cadr(getvar"screensize")))(getvar"APERTURE"))
)
)
(setq point(cadr device)entity(nentselp point))
(if(and entity
(setq entity(entget(car entity)))
(member(cdr(assoc 0 entity))'("3DSOLID""REGION"))
(or(equal entityPrev(setq entityPrev(cdr(assoc -1 entity))))
(progn
(setq points()
sat())
(foreach group entity(and(=(car group)1)(setq sat(append
sat(list(acis_translate(cdr group)))))))
(foreach line sat
(cond
((wcmatch(car line)"point") ;;; this works for straight
edges
(setq points(cons(list 0(distof(nth index_X
line))(distof(nth(+ index_X 1)line))(distof(nth(+ index_X 2)line)))points))
)
((wcmatch(car line)"coedge") ;;; start here for curved
surface support
;(setq points(cons(compute_center_point)points))
)
)
)
)
T
)
)
(setq points(mapcar'(lambda(pnt)(cons(distance(cdr(reverse(trans point
1 2)))(cdr(reverse(trans(cdr pnt)0 2))))(cdr pnt)))points)
pointn(cdr(assoc(apply'min(mapcar'car points))points))
)
(setq pointn()entity())
)
(and pointn(draw_aperture pointn 2))
)
(and pointn(draw_aperture pointn 0))
(if entity(list(cdr(assoc -1 entity))pointn))
)
  • 0

#275 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 914 Bài viết
Điểm đánh giá: 515 (tốt)

Đã gửi 27 November 2010 - 12:48 AM

Một số hàm con của mình yêu cầu số lượng tham số tương đối lớn (khoảng 7-10 tham số) nên việc nhớ được thứ tự của từng tham số, định dạng của từng tham số là rất khó. vì thế mỗi lần dùng đến lại phải mở file thư viện ra để tra.
thay vì phải làm như thế mình muốn đưa các thông báo lỗi kèm theo hướng dẫn khai báo tham số khi khai báo tham số sai vào hàm thông báo lỗi *error* của cad, nhưng chưa biết phải làm cách nào
các bác chạy thử hàm này khi không khai báo tham số và xem thông báo trả về sẽ hiểu đc ý của mình: (ACET-SS-DRAG-MOVE)
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#276 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 914 Bài viết
Điểm đánh giá: 515 (tốt)

Đã gửi 22 December 2010 - 11:16 AM

Trong bản vẽ có nhiều UCS. làm thế nào ta có thể thay đổi hệ tọa độ qua lại giữa các UCS này?
Cụ thể: bản vẽ có 2 UCS người dùng tự định nghĩa là A và B. khi A đang hiện hành mình muốn chuyển sang B thì làm như thế nào?
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#277 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 28 December 2010 - 08:02 AM

Cho mình hỏi về hàm lọc, ban đầu chọn 1 tập hợp đối tượng => đặt biến là ss

(setq ss (ssget))

Mình muốn tách ss thành thành phần ss1 (chứ text) và ss2 (chứa line, polyline) ss3 (chứa dim) thì phải dùng lệnh như thế nào ?
  • 0

#278 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4332 Bài viết
Điểm đánh giá: 3837 (đỉnh cao)

Đã gửi 28 December 2010 - 08:52 AM

Cho mình hỏi về hàm lọc, ban đầu chọn 1 tập hợp đối tượng => đặt biến là ss

(setq ss (ssget))

Mình muốn tách ss thành thành phần ss1 (chứ text) và ss2 (chứa line, polyline) ss3 (chứa dim) thì phải dùng lệnh như thế nào ?

Có nhiều cách. Tue_NV xin trình bày 1 cách :
Đầu tiên, chọn 1 tập hợp đối tượng => đặt biến là ss
(setq ss (ssget))
-> Lập tức, lấy ss1 (chứa text)
(setq ss1 (ssget "P" '((0 . "TEXT"))))

-> Tập ss2
(setq ss2 (ssget "P" '((0 . "*LINE"))))

-> Tập ss3
(setq ss3 (ssget "P" '((0 . "DIMENSION"))))


Trong bản vẽ có nhiều UCS. làm thế nào ta có thể thay đổi hệ tọa độ qua lại giữa các UCS này?
Cụ thể: bản vẽ có 2 UCS người dùng tự định nghĩa là A và B. khi A đang hiện hành mình muốn chuyển sang B thì làm như thế nào?

Ý của bạn như thế này phải không?

(setq name (getstring t "\nnhap ten UCS"))
(vl-cmdf "UCS" "NA" "R" name)
  • 3

#279 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 28 December 2010 - 11:13 AM

@Tue_VN: thanks bạn rất nhiều, xin hỏi còn cách lọc khác nữa không (dùng hàm lọc lấy thông số từ biến ss)
  • 0

#280 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 28 December 2010 - 11:42 AM

@Tue_VN: thanks bạn rất nhiều, xin hỏi còn cách lọc khác nữa không (dùng hàm lọc lấy thông số từ biến ss)

Bạn dùng thử cái ni xem có được không nhé.

(defun c:ldt (/ ss i n e le)
(setq ss (ssget)
i 0
n (sslength ss)
ss1 (ssadd)
ss2 (ssadd)
ss3 (ssadd)
)
(while (< i n)
(setq e (ename ss i)
le (cdr (assoc 0 (entget e)))
)
(if (= le "TEXT")
(setq ss1 (ssadd e ss1))
)
(if ( or (= le "LINE") (= le "LWPOLYLINE") (= le "POLYLINE") )
(setq ss2 (ssadd e ss2))
)
(if (= le "DIMENSION")
(setq ss3 (ssadd e ss3))
)
(setq i (1+ i))
)
)

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.