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

[TRUNGNGAMY 91]

Biến hệ thống nào cho biết cad đang mở bao nhiêu bv vậy các bạn

[master_worse 88]

Biến hệ thống nào cho biết cad đang mở bao nhiêu bv vậy các bạn

Biến hệ thống thì không biết, nhưng có cái này (vla-get-count (vla-get-documents(vlax-get-acad-object))).

 

tạo 1 list các bản vẽ dang mở

-----------------------------------------------------------------------------------------------------------

(setq doc (vla-get-documents (vlax-get-acad-object))

num (vla-get-count doc)

i -1

) ;_ end setq

(repeat num (setq i (1+ i)) (setq names (cons (vla-get-path (vla-item doc i)) names)))

(setq names (reverse names))

-----------------------------------------------------------------------------------------------------------

nếu muốn chì lấy tên file không thì sửa ...(vla-get-path ... thành ...(vla-get-name ...

Chỉnh sửa Tháng 9 5, 2010 theo master_worse

[gia_bach 1553]

1- Bạn lọc lấy DXF 10 trong data của nó là xong ngay.

2- Xin chia sẻ một chút kinh nghiệm "vọc" lisp của ssg. Không riêng gì leader, mà với bất cứ đối tượng nào, ssg có sẵn 1 "lá bùa" vẫn load thường trực:

 

(defun C:EG( )(setq e (car (entsel)))(textscr)(setq d (entget e)))

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

Tương tự lá bùa của bác SSG,

LISP dxf cung cấp các giá trị của mã DXF duới dạng hộp thoại.

(defun c:dxf (/ ent Sel DataList)
 (defun Dialog_Show (lst / dxfdcl fn dxf_id)
   (setq dxfdcl (vl-filename-mktemp "DXF_Val.tmp")
  fn (open dxfdcl "w"))
   (foreach item (list
	    "DXF_VALUE : dialog { label = \"DXF       Value\";"
	    "         : list_box { key = \"lstKey\";  height = 25;  width = 70; tabs = 4; }"
	    "         ok_only; }")
     (princ item fn) )
   (close fn)
   (setq dxf_id (load_dialog dxfdcl))
   (if (not (if dxfXY (new_dialog "DXF_VALUE" dxf_id "" dxfXY)(new_dialog "DXF_VALUE" dxf_id)))
     (progn (prompt "\nDynamic Dialogue Extraction Failed.")(exit)))
   (start_list "lstKey" 3) (mapcar 'add_list lst) (end_list)
   (action_tile "accept" "(setq dxfXY (done_dialog))")
   (start_dialog)
   (unload_dialog dxf_id)
   (vl-file-delete dxfdcl)
   (princ))
 ;main
 (if (setq Sel (entsel) ent (car sel))
   (Dialog_Show
     (mapcar
'(lambda (x / tempType)
   (if (and
	 (equal (type (cdr x)) 'ENAME)
	 (setq tempType (cdr (assoc 0 (entget (cdr x))))))
     (strcat (vl-princ-to-string (car x)) "\t\t" (vl-princ-to-string (cdr x)) "  [ " tempType " ]")
     (strcat (vl-princ-to-string (car x)) "\t\t" (vl-princ-to-string (cdr x))	 ) )  )
(setq DataList (entget Ent '("*")))  )  ))
 (princ))

[ketxu 2984]

Tuyệt vời,nhìn cái bảng thấy sinh động và trực quan hơn hẳn ^^

[Thaistreetz 539]

Tương tự lá bùa của bác SSG,

LISP dxf cung cấp các giá trị của mã DXF duới dạng hộp thoại.

Có 2 nhuợc điểm bác ạ.

- Ta không thể copy giá trị từ hộp thoại thông báo. (cái này em rất hay dùng trong quá trình viết code)

- Với các mã DXF có giá trị hiển thị thành 1 chuỗi dài vuợt quá phạm vi chiều ngang của hộp thoại sẽ không hiển thị đuợc hết. (Cái này thuờng gặp ở các đối tuợng chứa dữ liệu mở rộng xdata, mã -3)

Em dùng thế này cho đơn giản mà tiện dụng :undecided:

(defun c:tra (/ i E LST)

(setq E (entsel) LST (entget(car E) '("*")) i 0)

(repeat (length LST)

(print (nth i LST))

(setq i (1+ i))

)

(textscr) (princ)

);end

[ketxu 2984]

Em cũng viết 1 "lá bùa" cho mình. hehe, sai lầm chết người của em chính từ "lá bùa lởm" này :bigsmile:

 

Cảm ơn anh nhé :undecided:

Mình mới đọc bài này,vẫn chưa hiểu lá bùa này ...lởm ở chỗ nào :bigsmile:(

[Thaistreetz 539]

Mình mới đọc bài này,vẫn chưa hiểu lá bùa này ...lởm ở chỗ nào :undecided:(

bạn thử nó với 1 leader hay polyline hoặc 1 số đối tuợng fức khác sẽ hiểu

[ketxu 2984]

À,với pl thì nó có hơi bị...dài ^^ Có phải không ạ

[Thaistreetz 539]

À,với pl thì nó có hơi bị...dài ^^ Có phải không ạ

Không fải :(

[ketxu 2984]

Không fải :(

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 :...

 

(-1 . )
(0 . "LWPOLYLINE")
(330 . )
(5 . "4C9A2")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "KCVN-PLOT")
(100 . "AcDbPolyline")
(90 . 4)
(70 . 0)
(43 . 0.0)
(38 . 0.0)
(39 . 0.0)
(10 -331.23 -892.16)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 -626.941 -459.887)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 -338.443 -423.865)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 -223.044 -567.956)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(210 0.0 0.0 1.0)

[nguyentuyen6 130]

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

[Tue_NV 3912]

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 (   (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 (   (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

[nguyentuyen6 130]

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

[Thaistreetz 539]

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 đó

[ketxu 2984]

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

[nguyentuyen6 130]

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

[Tue_NV 3912]

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 (   (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 100))
     (setq k 50)) 

  (if (	     (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

[nguyentuyen6 130]

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!!!!

[18011985 62]

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)

[pfievxd 6]

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?

[codered8x 18]

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")

[pfievxd 6]

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

[theduyhuynh 0]

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" )

[hung22121983 0]

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))

)

[Thaistreetz 539]

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)