Jump to content
InfoFile
Tác giả: Doan Van Ha
Bài viết gốc: 234718
Tên lệnh: bandiem
fYR1g9 You have remarked very interesting details ! ps decent internet site.


Filename: 234718_bandiem.lsp
Tác giả: duy782006
Bài viết gốc: 234801
Tên lệnh: vhcn
Lisp vẽ hình chữ nhật

Muốn ra thì dương mà muốn vô thì âm.

Lệnh VHCN.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi rectang
;;;Cu phap su dung (duy:t_rectang toadoa toadob kieu tile Layer Color)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_rectang (diema diemb dorong tl stl La Co)


(setq toado (list diema (list (car diema) (cadr diemb)) diemb (list...
>>

Muốn ra thì dương mà muốn vô thì âm.

Lệnh VHCN.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi rectang
;;;Cu phap su dung (duy:t_rectang toadoa toadob kieu tile Layer Color)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_rectang (diema diemb dorong tl stl La Co)


(setq toado (list diema (list (car diema) (cadr diemb)) diemb (list (car diemb) (cadr diema)) ))

(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(cond ((= tl "") (setq tl "bylayer") ))
(cond ((= stl "") (setq stl 1) ))


(setq Lst
  (list
   (cons 0 "LWPOLYLINE")
   (cons 100 "AcDbEntity")
   (cons 8 la)
   (cons 6 tl)
   (cons 48 stl)
   (cons 62 co)
   (cons 100 "AcDbPolyline")
   (cons 43 dorong)
   (cons 90 4)
   (cons 70 1)))
(setq x 0)
(repeat 4
  (setq Lst (append Lst (list (cons 10 (nth x toado)) )))
  (setq x (1+ x)))
(entmakex Lst)
(princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Xac dinh gia tri so neu chua co thi gan cho gia tri mac dinh
;;;Cu phap su dung (duy:xd_gts gtn gtmd mdich)
;;;Gia tri tra ve la so gtn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:xd_gts (gtn gtmd mdich / gtn gtmd mdich)
(or gtn (setq gtn gtmd))
(setq gtn (cond ((getreal (strcat "\n" mdich " < " (rtos gtn 2 2) " >:")))(gtn)))
gtn)



(defun c:vhcn (/ diemm diemh diema diemb)
(setq diemm (getpoint "\nDiem thu nhat:"))
(setq diemh (getpoint "\nDiem thu hai:"))
(duy:t_rectang diemm diemh 0 "" "" "" "")
(setq khoang (duy:xd_gts khoang 110 "Khoang cach offset: "))
(setq diema (polar diemm pi khoang))
(setq diema (polar diema (/ (* pi 3) 2) khoang))
(setq diemb (polar diemh (* 2 pi) khoang))
(setq diemb (polar diemb (/ pi 2) khoang))
(duy:t_rectang diema diemb 0 "" "" "" "")
(princ))

<<

Filename: 234801_vhcn.lsp
Tác giả: Tue_NV
Bài viết gốc: 234808
Tên lệnh: vhcn
Lisp vẽ hình chữ nhật

Code của bạn đây :

 

 
(DEFUN C:vhcn(/ p1 p2 pside kcach el)
  (setvar "cmdecho" 0)
  (COMMAND "RECTANG" "_non" (SETQ P1 (GETPOINT "\nPICK DIEM 1 :")) "_non"(setq p2 (GETPOINT p1 "\npICK DIEM 2 :")))
  (if (< (setq kcach (getreal "\nKhoang cach offset :")) 0)
    (setq pside (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)))
    (setq pside (polar p1 (angle p2 p1) (/ (distance p1 p2) 2.0)))
  )(setq el (entlast))
 ...
>>

Code của bạn đây :

 

 
(DEFUN C:vhcn(/ p1 p2 pside kcach el)
  (setvar "cmdecho" 0)
  (COMMAND "RECTANG" "_non" (SETQ P1 (GETPOINT "\nPICK DIEM 1 :")) "_non"(setq p2 (GETPOINT p1 "\npICK DIEM 2 :")))
  (if (< (setq kcach (getreal "\nKhoang cach offset :")) 0)
    (setq pside (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)))
    (setq pside (polar p1 (angle p2 p1) (/ (distance p1 p2) 2.0)))
  )(setq el (entlast))
  (COMMAND "OFFSET" (abs kcach) el "_non" pside "e")
  (command "erase" el "")
)

<<

Filename: 234808_vhcn.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 234814
Tên lệnh: ha
[yêu cầu] Lisp vẽ hình chữ nhật

Thích ngắn thì đây nữa!

 

(defun C:HA( / p1 p3 kc p1x p3x)
 (setq p1 (getpoint "\nPick diem 1: "))
 (setq p3 (getcorner p1 "\nPick diem 2: "))
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nKhoang cach offset <" (rtos kc 2 2) ">:"))) (kc)))
 (setq p1x (list (+ (min (car p1) (car p3)) kc) (+ (min (cadr p1) (cadr p3)) kc))
       p3x (list (- (max (car p1) (car p3))...
>>

Thích ngắn thì đây nữa!

 

(defun C:HA( / p1 p3 kc p1x p3x)
 (setq p1 (getpoint "\nPick diem 1: "))
 (setq p3 (getcorner p1 "\nPick diem 2: "))
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nKhoang cach offset <" (rtos kc 2 2) ">:"))) (kc)))
 (setq p1x (list (+ (min (car p1) (car p3)) kc) (+ (min (cadr p1) (cadr p3)) kc))
       p3x (list (- (max (car p1) (car p3)) kc) (- (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" "non" p1x "non" p3x))

<<

Filename: 234814_ha.lsp
Tác giả: Song Nhi
Bài viết gốc: 234821
Tên lệnh: sn%2B sn-
How to use Visual LISP Editor
Em là người mới bắt đầu học LISP, món này rất cần thiết đây!
 
@ Bác Thaistreetz ơi, Bác là một trong các cao thủ trong ngành này, bác chia sẽ những kinh nghiệm của mình để hướng dẫn tụi em với, tựa đề bằng tiếng Anh thế mọi người cũng hiểu được mà, như Slogen của Bác đấy thôi, cũng toàn tiếng Anh cả đấy chứ!
 
Trong bài: 
>>
Em là người mới bắt đầu học LISP, món này rất cần thiết đây!
 
@ Bác Thaistreetz ơi, Bác là một trong các cao thủ trong ngành này, bác chia sẽ những kinh nghiệm của mình để hướng dẫn tụi em với, tựa đề bằng tiếng Anh thế mọi người cũng hiểu được mà, như Slogen của Bác đấy thôi, cũng toàn tiếng Anh cả đấy chứ!
 
Trong bài:  Lisp vẽ hình chữ nhật , line: http://www.cadviet.com/forum/topic/71167-yeu-cau-lisp-ve-hinh-chu-nhat/
Đã có các bác: Duy782006; Tue_NV và bác Doan Van Ha viết giúp bạn ấy rồi, em thấy vấn đề không phải khó lắm, cũng viết một lisp, nhưng không chạy được, vì còn sai nhiều chỗ, các Bác chắc đọc code sẽ phát hiện nhiều chỗ sai của em. Tuy nhiên, em mong muốn các Bác có thể hướng dẫn cách sử dụng các công cụ của Visual LISP Editor để phát hiện lỗi và sửa lỗi, từ đó những người mới học như tụi em sẽ rút ra những bài học kinh nghiệm!
 
Em xin trình bày lại yêu cầu của bạn ấy: Nhập vào 2 điểm và một khoảng offset, vẽ hình chữ nhật nhận 2 đỉnh ấy làm 2 đỉnh chéo, kết quả là HCN được offset từ HCN chuẩn ra hay vào trong một khoảng bằng khoảng nhập vào. Code của em đây:
(defun pxy(d x y) (polar (polar d 0 x) (* 0.5 pi) x))
(defun SN(id / )
(setq D1 (getpoint "\nVui long pick diem Bottom Left\n")
      D3 (getcorner D1 "\nVui long pick diem Top Right\n"))
(setq an  (getint "\nVui long nhap khoang offset: <110>\n")) (if (= an nil) (setq an 110))
(setq bn (- 0 an))
(setq D2 (list (car D1) (cadr D3))
      D4 (list (car D3) (cadr D1)))
(cond
((= id 1) (setq D11 (pxy D1 bn bn)
                D22 (pxy D2 bn an)
                D33 (pxy D3 an an)
                D44 (pxy D4 an bn))
((= id 2) (setq D11 (pxy D1 an an)
                D22 (pxy D2 an bn)
                D33 (pxy D3 bn bn)
                D44 (pxy D4 bn an)))))
(Command "_pline" D11 D22 D33 D44 "C")
(princ))
(defun C:SN+() (SN 1))
(defun C:SN-() (SN 2))
Chân thành cám ơn các Bác đã quan tâm!
<<

Filename: 234821_sn%2B_sn-.lsp
Tác giả: Tue_NV
Bài viết gốc: 234829
Tên lệnh: vhcn
Lisp vẽ hình chữ nhật

Thích ngắn hơn thì đây nữa :

 
(defun c:vhcn(/ p1 p2 dis)
  (setvar "cmdecho" 0)
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nKhoang cach offset <" (rtos kc 2 2) ">:"))) (kc)))
  (command "rectang" (setq p1 (getpoint "\n Diem thu 1 :")) (setq p2 (getcorner p1 "\n Diem thu 2 :")))
  (setq dis (/ (distance p1 p2) 2.0))
  (command "scale" "l" "" "_non" (polar p1 (angle p1 p2) dis) (abs (/ (+ dis (* kc (sqrt...
>>

Thích ngắn hơn thì đây nữa :

 
(defun c:vhcn(/ p1 p2 dis)
  (setvar "cmdecho" 0)
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nKhoang cach offset <" (rtos kc 2 2) ">:"))) (kc)))
  (command "rectang" (setq p1 (getpoint "\n Diem thu 1 :")) (setq p2 (getcorner p1 "\n Diem thu 2 :")))
  (setq dis (/ (distance p1 p2) 2.0))
  (command "scale" "l" "" "_non" (polar p1 (angle p1 p2) dis) (abs (/ (+ dis (* kc (sqrt 2))) dis)))
)

<<

Filename: 234829_vhcn.lsp
Tác giả: lyky
Bài viết gốc: 234512
Tên lệnh: dsl
Đếm đối tượng trong bản vẽ cad!
Bạn có thể phản xạ cho các trường hợp khác bằng một đoạn code đơn giản sau:
 
(defun C:DSL (/ loaio) (if (not loai) (setq loai 0))   ;;; Dem So Luong ;;;
(setq loaio loai loai (getint (strcat "\nLoai 1:Line;2:Text;3:Dimension;4:Block;5:Circle;6:Polyline;7:Arc:")))
(cond
  ((= loai 1) (prompt (strcat "\nTong so LINE la:"      (itoa (sslength (ssget '((0 . "LINE"))))) "\n")))
  ((= loai 2) (prompt (strcat "\nTong so...
>>
Bạn có thể phản xạ cho các trường hợp khác bằng một đoạn code đơn giản sau:
 
(defun C:DSL (/ loaio) (if (not loai) (setq loai 0))   ;;; Dem So Luong ;;;
(setq loaio loai loai (getint (strcat "\nLoai 1:Line;2:Text;3:Dimension;4:Block;5:Circle;6:Polyline;7:Arc:")))
(cond
  ((= loai 1) (prompt (strcat "\nTong so LINE la:"      (itoa (sslength (ssget '((0 . "LINE"))))) "\n")))
  ((= loai 2) (prompt (strcat "\nTong so TEXT la:"      (itoa (sslength (ssget '((0 . "TEXT"))))) "\n")))
  ((= loai 3) (prompt (strcat "\nTong so DIMENSION la:" (itoa (sslength (ssget '((0 . "DIMENSION"))))) "\n")))
  ((= loai 4) (prompt (strcat "\nTong so INSERT la:"    (itoa (sslength (ssget '((0 . "INSERT"))))) "\n")))
  ((= loai 5) (prompt (strcat "\nTong so CIRCLE la:"    (itoa (sslength (ssget '((0 . "CIRCLE"))))) "\n")))
  ((= loai 6) (prompt (strcat "\nTong so POLYLINE la:"  (itoa (sslength (ssget '((0 . "LWPOLYLINE"))))) "\n")))
  ((= loai 7) (prompt (strcat "\nTong so ARC la:"       (itoa (sslength (ssget '((0 . "ARC"))))) "\n")))))
;;; Neu muon mac dinh "ALL" bo xung them "X" sau ssget ;;;
 
Goodluck!
 
P/S: úi chà, mình nhầm!!!

sao mình lấy trong thư viện cad ra mẫu cây (trees - metric) , array ra 90 đối tượng, xong có xóa đi 1 vài đối tượng.
rồi dùng lệnh filter đếm block name: trees - metric, mà cad ko đếm ra được 1 đối tượng nào hết? các bác có biết nguyên nhân ko giúp mình với?

Bạn nên up file CAD lên trực tiếp cho dễ hiểu bạn à!
<<

Filename: 234512_dsl.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 185248
Tên lệnh: tko
Lisp di chuyển text của dim

Hề hề hề,
Bạn dùng thủ cái này xem đã đúng ý chưa nhé.

Hề hề hề, nếu chưa đúng thì chớ có giận. hãy post chỗ chưa đúng lên.

Filename: 185248_tko.lsp
Tác giả: Tue_NV
Bài viết gốc: 234995
Tên lệnh: ctd
[Yêu cầu] Lisp điều chỉnh vị trí text ghi kích thước trên đường dim

Chào bác Tue-NV và các anh em trên diễn đàn.

Lâu lắm em không có dịp vào diễn đàn vì đi công trường suốt, mới về phòng và tiếp tục công việc vẽ vời. Em gặp một tình huống tương tự như trường hợp này mà lisp này em thấy dùng chưa được như ý lắm (hoặc ít ra là trong trường hợp cụ thể...

>>

Chào bác Tue-NV và các anh em trên diễn đàn.

Lâu lắm em không có dịp vào diễn đàn vì đi công trường suốt, mới về phòng và tiếp tục công việc vẽ vời. Em gặp một tình huống tương tự như trường hợp này mà lisp này em thấy dùng chưa được như ý lắm (hoặc ít ra là trong trường hợp cụ thể của em). Xin nhờ các bác sửa giúp thêm để thực hiện được công việc như em miêu tả trong file đính kèm. Em đính kèm 2 file, một file là file miêu tả lisp yêu cầu, một file là file thực tế em đang phải làm, các bác xem và giúp em với ạ.

Thanks các bác nhiều!

File mô tả lisp

http://www.cadviet.com/upfiles/3/110072_lsh_1.dwg

File thực tế em đang làm

http://www.cadviet.com/upfiles/3/110072_01general_view_of_pier_type_2a.dwg

 

Bạn thử code này :

 

(defun c:ctd(/ ss ename i dxf11 dxf13 vt)
  (setq p1 (getpoint "\n Diem thu 1 :") p2 (getpoint p1 "\n Diem thu 2 :"))
  (setq ang (angle p1 p2))
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (progn
      (setq i -1); vt (getreal "\n Text cua dim cach mep trai 1 doan :"))
      (while (setq ename (ssname ss (setq i (1+ i))))
(command "dimtedit" ename "L")
(setq dxf11 (cdr(assoc 11 (entget ename)))
   dxf13 (cdr(assoc 13 (entget ename))) 
      pres (inters p1 p2 dxf11 (polar dxf11 (+ ang (/ pi 2.0)) 100.0) t)
)
(command "dimtedit" ename pres )
      )
    )
  )
)
 
Cách sử dụng:

Bạn quickan... thử code này : Bạn chọn DIMENSION -> Chọn điêm thứ 1 và điểm thứ 2 của đoạn thẳng 

 

 
(defun c:ctd(/ ss ename i dxf11 dxf13 ang pres)
  (setq p1 (getpoint "\n Diem thu 1 :") p2 (getpoint p1 "\n Diem thu 2 :"))
  (setq ang (angle p1 p2))
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (progn
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
(command "dimtedit" ename "L")
(setq dxf11 (cdr(assoc 11 (entget ename)))
   dxf13 (cdr(assoc 13 (entget ename))) 
      pres (inters p1 p2 dxf11 (polar dxf11 (+ ang (/ pi 2.0)) 100.0) t)
)
(command "dimtedit" ename pres )
      )
    )
  )
)

<<

Filename: 234995_ctd.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 235278
Tên lệnh: chamarc
[Yêu cầu] Lisp chamber đường line và arc (cung tròn)

25600_chamber_1.jpg
Mình đã từng post chủ đề 1 lần và bị xóa, hix không biết bài viết có vi phạm điều gì không, các mod góp ý thêm.
Chả là mình đang rất cần 1 lisp có thể chamber được line và arc, xin mọi người giúp...

>>

25600_chamber_1.jpg
Mình đã từng post chủ đề 1 lần và bị xóa, hix không biết bài viết có vi phạm điều gì không, các mod góp ý thêm.
Chả là mình đang rất cần 1 lisp có thể chamber được line và arc, xin mọi người giúp đỡ.
Similar topics from web:

Hề hề hề,
Này thì lisp.http://www.cadviet.com/upfiles/3/5194_chamferofarc.lsp

 
(defun c:chamarc ( /)
(vl-load-com)
(command "undo" "be")
(setq e1 (car (entsel "\n Chon doi tuong can chamfer thu nhat"))
          e2 (car (entsel "\n Chon doi tuong can chamfer thu hai"))
          ob1 (vlax-ename->vla-object e1)
          ob2 (vlax-ename->vla-object e2)
          p (car (acet-geom-intersectwith e1 e2 0))
          d (getdist "\n Nhap khoang cach chamfer: ")
)
;;;(if (= (cdr (assoc 0 (entget e1))) "LINE")
(if (equal p (vlax-curve-getstartpoint ob1) 0.0001)
    (progn
          (setq p1 (vlax-curve-getpointatdist ob1 d))
          (command "break" e1 "_non" p1 "_non" (vlax-curve-getstartpoint ob1))
    )
    (progn
           (setq p1 (vlax-curve-getpointatdist ob1 (- (vlax-curve-getdistatpoint ob1 (vlax-curve-getendpoint ob1)) d)))
           (command "break" e1 "_non" p1 "_non" (vlax-curve-getendpoint ob1))
    )
)
(if (equal p (vlax-curve-getstartpoint ob2) 0.0001)
    (progn
          (setq p2 (vlax-curve-getpointatdist ob2 d))
          (command "break" e2 "_non" p2 "_non" (vlax-curve-getstartpoint ob2))
    )
    (progn
          (setq p2 (vlax-curve-getpointatdist ob2 (- (vlax-curve-getdistatpoint ob2 (vlax-curve-getendpoint ob2)) d)))
          (command "break"  e2 "_non" p2 "_non" (vlax-curve-getendpoint ob2))
     )
)
(command "pline" "_non" p1 "_non" p2 "")
(command "undo" "e")
(princ)
)


Hề hề hề, lisp chỉ dùng với các đường có điểm giao nhau thôi nhé. còn nếu nó hở thì ..... cố mà nối cho kín lại. Khoảng cách chamfer phải nhỏ hơn độ dài nhỏ nhất của các đường cần chamfer.


<<

Filename: 235278_chamarc.lsp
Tác giả: gia_bach
Bài viết gốc: 235296
Tên lệnh: cla
Lisp chamber đường line và arc (cung tròn)

Dùng thử Lisp này xem đúng ý chưa ?

- Cho phép chọn Line Arc lẫn lộn hoặc cả 2 Arc hay 2 Line.

- khoảng cách chamfer lấy theo biến hệ thống ChamferA của Cad.

(defun c:cla (/ data1 data2 e1 e2 lst_pt oo pts tmp);CLA ->ChamferLineArc
  ;; By : Gia_bach 2013 ;;
  (defun SysVarReal(name msg / cd)
    (initget 4)
    (setq cd (getdist (strcat msg " <" (rtos (getvar name)) "> : ")) )
   ...
>>

Dùng thử Lisp này xem đúng ý chưa ?

- Cho phép chọn Line Arc lẫn lộn hoặc cả 2 Arc hay 2 Line.

- khoảng cách chamfer lấy theo biến hệ thống ChamferA của Cad.

(defun c:cla (/ data1 data2 e1 e2 lst_pt oo pts tmp);CLA ->ChamferLineArc
  ;; By : Gia_bach 2013 ;;
  (defun SysVarReal(name msg / cd)
    (initget 4)
    (setq cd (getdist (strcat msg " <" (rtos (getvar name)) "> : ")) )
    (if cd (setvar name cd) (setq cd (getvar name)) )  )
  (defun SelectLineArc(msg / ent esel pt)
    (while (not (and (setq esel (entsel msg)
			   ent (car esel))
		     (if ent (wcmatch (cdr (assoc 0 (entget ent))) "LINE,ARC") ) ) )
      (princ "\nSelect Again: ")    )
    (setq pt (vlax-curve-getClosestPointTo ent (cadr esel)))
    (if (< (distance pt (vlax-curve-getStartPoint ent))
	   (distance pt (vlax-curve-getEndPoint ent)))
      (list (vlax-ename->vla-object ent) (vlax-curve-getStartPoint ent))
      (list (vlax-ename->vla-object ent) (vlax-curve-getEndPoint ent))))
  (defun list->3pair (old / new)
    (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
		 old (cdddr old))) new )
  (defun mid (p1 p2)
    (list (* (+ (car p1) (car p2)) 0.5)
	  (* (+ (cadr p1) (cadr p2)) 0.5)
	  (* (+ (caddr p1) (caddr p2)) 0.5) ))
  (defun updateObj (obj inter dis / cen ang pt rad)
    (if (eq (vla-get-Objectname obj) "AcDbLine")
      (if (< (distance inter (vlax-curve-getStartPoint obj))
	     (distance inter (vlax-curve-getEndPoint obj)))
	(vla-put-StartPoint obj (vlax-3D-point (setq pt (polar inter (angle (vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj))dis))))
	(vla-put-EndPoint obj (vlax-3D-point (setq pt(polar inter (angle (vlax-curve-getEndPoint obj)(vlax-curve-getStartPoint obj))dis))) ))
      (progn
	(setq cen (vlax-safearray->list (variant-value (vla-get-Center obj)))
	      rad (vla-get-Radius obj))
	(if (< (distance inter (vlax-curve-getStartPoint obj))
	     (distance inter (vlax-curve-getEndPoint obj)))
	  (vla-put-StartAngle obj (vlax-make-variant (setq ang (+ (angle cen inter) (* 2(asin (/ dis 2 rad)))))) )
	  (vla-put-EndAngle obj (vlax-make-variant (setq ang (- (angle cen inter) (* 2(asin (/ dis 2 rad)))))) ) )
	(setq pt (polar cen ang rad)) ) )
    pt)
  (defun asin (f_ang)
    (if (= (atof (rtos (abs f_ang))) 1)
      0
      (atan (/ f_ang (sqrt (+ (* (- f_ang) f_ang) 1))))    ))
  ;Main 
  (if
    (and
      (setq data1 (SelectLineArc "\n Chon d/tuong 1:"))
      (setq data2 (SelectLineArc "\n Chon d/tuong 2:")))
    (progn
	(setq e1 (car data1) e2 (car data2))
	(if (setq pts (vlax-invoke e1 'IntersectWith e2 acExtendBoth))
	  (progn
	    (setq dis (SysVarReal "Chamfera" "\nKhoang cach Chamfer:")
		  lst_pt (append (list->3pair pts) lst_pt) tmp (mid (cadr data1) (cadr data2))
		  oo (car (vl-sort lst_pt '(lambda (x y) (< (distance tmp x) (distance tmp y))))))
	    (vla-addLine (vla-get-modelspace (vla-get-ActiveDocument(vlax-get-acad-object)))
	      (vlax-3D-point (updateObj e1 oo dis)) (vlax-3D-point (updateObj e2 oo dis))) )
	  (alert "Khong co giao diem") )  ) )
  (princ))

<<

Filename: 235296_cla.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 235333
Tên lệnh: ha
lisp vẽ mặt bằng kết cấu

Lisp vẽ tường theo lưới trục đây!

(vl-load-com)

 

;Doan Van Ha - CADViet.com - Ngay 17/05/2013
;Chuc nang: ve luoi tuong theo he truc.
(defun C:HA(/ lstd lstn lstg1 lstg x y)
 (command "undo" "be")
 (princ "\nChon cac Line duong truc...")
 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE"))))))
  (if (equal (car (cdr (assoc 10 (entget ent)))) (car (cdr...
>>

Lisp vẽ tường theo lưới trục đây!

(vl-load-com)

 

;Doan Van Ha - CADViet.com - Ngay 17/05/2013
;Chuc nang: ve luoi tuong theo he truc.
(defun C:HA(/ lstd lstn lstg1 lstg x y)
 (command "undo" "be")
 (princ "\nChon cac Line duong truc...")
 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE"))))))
  (if (equal (car (cdr (assoc 10 (entget ent)))) (car (cdr (assoc 11 (entget ent)))) 1E-8)
   (setq lstd (cons ent lstd))
   (setq lstn (cons ent lstn))))
 (setq lstd (vl-sort lstd '(lambda (e1 e2) (< (car (cdr (assoc 10 (entget e1)))) (car (cdr (assoc 10 (entget e2))))))))
 (setq lstn (vl-sort lstn '(lambda (e1 e2) (< (cadr (cdr (assoc 10 (entget e1)))) (cadr (cdr (assoc 10 (entget e2))))))))
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nBe day tuong <" (rtos kc 2 2) ">:"))) (kc)))
 (foreach entn lstn
  (setq lstg1 nil)
  (foreach entd lstd
   (if (setq giao (car (HA:Giao (vlax-ename->vla-object entn) (vlax-ename->vla-object entd) acExtendNone)))
    (setq lstg1 (cons giao lstg1))))
  (if lstg1 (setq lstg (cons lstg1 lstg))))
 (HA1 (caar lstg) (last (last lstg)) kc)
 (setq x 0)
 (repeat (1- (length lstg))
  (setq y 0)
  (repeat (1- (length (nth x lstg)))
   (HA (nth y (nth (1+ x) lstg)) (nth (1+ y) (nth x lstg)) kc)
   (setq y (1+ y)))
  (setq x (1+ x)))
 (command "undo" "e") 
 (princ))
;----- - acExtendNone; - acExtendThisEntity; - acExtendOtherEntity; - acExtendBoth.
(defun HA:Giao(obj1 obj2 mode / l r)
 (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length l) 3)
  (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))
 r)
(defun HA(p1 p3 kc / p1x p3x)
 (setq p1x (list (+ (min (car p1) (car p3)) kc) (+ (min (cadr p1) (cadr p3)) kc))
       p3x (list (- (max (car p1) (car p3)) kc) (- (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" "non" p1x "non" p3x))
(defun HA1(p1 p3 kc / p1x p3x)
 (setq p1x (list (- (min (car p1) (car p3)) kc) (- (min (cadr p1) (cadr p3)) kc))
       p3x (list (+ (max (car p1) (car p3)) kc) (+ (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" "non" p1x "non" p3x))

<<

Filename: 235333_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 235339
Tên lệnh: ha
[yêu cầu &thảo luận] lisp vẽ mặt bằng kết cấu

Lisp vẽ hệ tường theo lưới trục.

67029_untitled1_1.png

 

;Doan Van Ha - CADViet.com - Ngay 17/05/2013
;Chuc nang: ve luoi tuong theo he truc.
(defun C:HA(/ lstd lstn lstg1 lstg x y)
 (vl-load-com)
 (command "undo" "be")
 (princ "\nChon cac Line duong truc...")
 (foreach ent (vl-remove-if 'listp (mapcar 'cadr...
>>

Lisp vẽ hệ tường theo lưới trục.

67029_untitled1_1.png

 

;Doan Van Ha - CADViet.com - Ngay 17/05/2013
;Chuc nang: ve luoi tuong theo he truc.
(defun C:HA(/ lstd lstn lstg1 lstg x y)
 (vl-load-com)
 (command "undo" "be")
 (princ "\nChon cac Line duong truc...")
 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE"))))))
  (if (equal (car (cdr (assoc 10 (entget ent)))) (car (cdr (assoc 11 (entget ent)))) 1E-8)
   (setq lstd (cons ent lstd))
   (setq lstn (cons ent lstn))))
 (setq lstd (vl-sort lstd '(lambda (e1 e2) (< (car (cdr (assoc 10 (entget e1)))) (car (cdr (assoc 10 (entget e2))))))))
 (setq lstn (vl-sort lstn '(lambda (e1 e2) (< (cadr (cdr (assoc 10 (entget e1)))) (cadr (cdr (assoc 10 (entget e2))))))))
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nBe day tuong <" (rtos kc 2 2) ">:"))) (kc)))
 (foreach entn lstn
  (setq lstg1 nil)
  (foreach entd lstd
   (if (setq giao (car (HA:Giao (vlax-ename->vla-object entn) (vlax-ename->vla-object entd) acExtendNone)))
    (setq lstg1 (cons giao lstg1))))
  (if lstg1 (setq lstg (cons lstg1 lstg))))
 (HA1 (caar lstg) (last (last lstg)) kc)
 (setq x 0)
 (repeat (1- (length lstg))
  (setq y 0)
  (repeat (1- (length (nth x lstg)))
   (HA (nth y (nth (1+ x) lstg)) (nth (1+ y) (nth x lstg)) kc)
   (setq y (1+ y)))
  (setq x (1+ x)))
 (command "undo" "e") 
 (princ))
(defun HA:Giao(obj1 obj2 mode / l r)
 (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length l) 3)
  (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))
 r)
(defun HA(p1 p3 kc / p1x p3x)
 (setq p1x (list (+ (min (car p1) (car p3)) kc) (+ (min (cadr p1) (cadr p3)) kc))
       p3x (list (- (max (car p1) (car p3)) kc) (- (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" "non" p1x "non" p3x))
(defun HA1(p1 p3 kc / p1x p3x)
 (setq p1x (list (- (min (car p1) (car p3)) kc) (- (min (cadr p1) (cadr p3)) kc))
       p3x (list (+ (max (car p1) (car p3)) kc) (+ (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" "non" p1x "non" p3x))

<<

Filename: 235339_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 235420
Tên lệnh: ha1
[yêu cầu &thảo luận] lisp vẽ mặt bằng kết cấu
is vigorexin good "What is more important for you and your life - to have someone tell you that on Thursdays you shouldn't eat meat, or the fact that I as chancellor have ensured that we no longer have five million unemployed, but just three million?" she said.
tac dung thuoc vprx Austria"s plan to balance its budget...
>>
is vigorexin good "What is more important for you and your life - to have someone tell you that on Thursdays you shouldn't eat meat, or the fact that I as chancellor have ensured that we no longer have five million unemployed, but just three million?" she said.
tac dung thuoc vprx Austria"s plan to balance its budget by 2016 is threatenedby the prospect of huge costs for selling troubled state bankHypo Alpe Adria, which could need up to 5.4 billioneuros ($7.3 billion) in fresh capital by 2017.
penatropin for sale uk So she says "there is an element of cheating because it"s a relationship in which the fantasy is enacted, but it doesn"t have the deed of actual sex. The bigger impact is often on the marriage itself and you learning that your partner is not the person they thought they were".
taking zytenz Lourdes because it’s a great place for prayer, for helping the sick and for recognising that we all belong together and we’ve got to help and support one another. I also found Machu Picchu, which is high in the Peruvian mountains, a very spiritual place. Bethlehem was also very moving. I went with the then Archbishop of Canterbury, Rowan Williams, to encourage the Christians there, but also to be at the place where Jesus was born. It’s a very troubled part of the world but we must remember that the Holy Land is a land for three peoples: Muslims, Jews and Christians. We prayed that peace would come.
vaso 9 bad side effects Such gaps have raised questions in Bulgaria about UnitedCapital"s intentions for Doverie, which with almost 1.8 billionlevs ($1.2 billion) under management and more than 1.25 millioncontributors is an important pension provider in Europe"spoorest country.
vitaros user reviews During weeks spent tracking the fluid frontline of the battle, veteran war photographer Goran Tomasevic provided daily evidence of an escalating conflict that the UN estimates has killed 100,000 people. Tomasevic photographed with exceptional proximity as combatants mounted complex attacks, managed logistics, treated their wounded, buried their dead – and died before his eyes.
siagra 100 wirkung The Chinese premier pledged on Wednesday to push ahead withreforms, with financial system change at the centre of hisagenda and seen as the cornerstone of the newly-approvedShanghai free trade zone.
has anyone tried erectzan "We do not intend to disclose further developments with the respect to the process until we approve a specific transaction or otherwise conclude the review of strategic alternatives," a BlackBerry spokesman said.
neosize xl donde lo consigo After years of deadlock and debate, elections on Monday could decide the fate of the Lofoten Islands. A Conservative-led coalition which favors exploration is forecast to win, paving the way for an impact assessment that could lead to drilling in Norway"s Arctic within two decades.
manforce oral condom BEIJING/HONG KONG - China reiterated its opposition on Thursday to a European Union plan to limit airline carbon dioxide emissions and called for talks to resolve the issue a day after its major airlines refused to pay any carbon costs under the new law.

<<

Filename: 235420_ha1.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 235486
Tên lệnh: ha
lisp vẽ mặt bằng kết cấu

Khó! Phức tạp! Nhất là tìm cho ra thuật toán để giải 1 bài toán tưởng chừng như đơn giản!

Lisp này vẽ lưới tường theo hệ các line trục đã có. Yêu cầu: các ô phải là hình chữ nhật.

(bạn phongtran86 chắc phải 10 like mới xứng :lol:)

67029_untitled_7.png

 

;Doan Van Ha - CADViet.com - Ngay...
>>

Khó! Phức tạp! Nhất là tìm cho ra thuật toán để giải 1 bài toán tưởng chừng như đơn giản!

Lisp này vẽ lưới tường theo hệ các line trục đã có. Yêu cầu: các ô phải là hình chữ nhật.

(bạn phongtran86 chắc phải 10 like mới xứng :lol:)

67029_untitled_7.png

 

;Doan Van Ha - CADViet.com - Ngay 20/05/2013
;Chuc nang: ve luoi tuong theo he truc // truc X va // truc Y, luoi break bat ky nhung cac o phai la HCN.
(defun C:HA(/ lst giao x y ss lstg1 lstg ent ptx pty kcm)
 (vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0)
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nBe day tuong <" (rtos kc 2 2) ">:"))) (kc)))
 (princ "\nChon cac Line duong truc...")
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE")))))))
 (foreach ent1 lst
  (setq lstg1 nil)
  (foreach ent2 lst
   (if (setq giao (car (HA:Giao (vlax-ename->vla-object ent1) (vlax-ename->vla-object ent2) acExtendNone)))
    (setq lstg1 (cons giao lstg1))))
  (if lstg1 (setq lstg (append lstg1 lstg))))
 (setq lstg (vl-sort lstg '(lambda(p1 p2) (if (equal (car p1) (car p2) 1E-8) (< (cadr p1) (cadr p2)) (< (car p1) (car p2))))))
 (setq lstg (LM:UniqueFuzz lstg 1E-8))
 (HA:hcn (car lstg) (last lstg) (/ kc -2.))
 (setq kcm (* 0.9 (KcMin lstg)))
 (setq ss (ssadd) ptx (polar (car lstg) 0 kcm))
 (while (< (car ptx) (car (last lstg)))
  (setq pty (polar ptx (/ pi 2) kcm))
  (while (< (cadr pty) (cadr (last lstg)))
   (setq ent (entlast))
   (command "boundary" pty "")
   (if (setq ent (entnext ent)) (setq ss (ssadd ent ss)))
   (setq pty (polar pty (/ pi 2) kcm)))
  (setq ptx (polar ptx 0 kcm)))
 (load "overkillsup.lsp")
 (acet-overkill2 (list ss 1E-8 nil "N" "N" "N"))
 (setq ss (ssget "w" (polar (car lstg) (* 1.25 pi) 1) (polar (last lstg) (* 0.25 pi) 1) '((0 . "LWPOLYLINE"))))
 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget ent))))
  (setq lst (vl-sort lst '(lambda(p1 p2) (if (equal (car p1) (car p2) 1E-8) (< (cadr p1) (cadr p2)) (< (car p1) (car p2))))))
  (HA:hcn (car lst) (last lst) (/ kc 2.))
  (entdel ent))
 (setq ss (ssget "w" (polar (car lstg) (* 1.25 pi) 1) (polar (last lstg) (* 0.25 pi) 1) '((0 . "LWPOLYLINE"))))
 (acet-overkill2 (list ss 1E-8 nil "N" "N" "N"))
 (setvar "cmdecho" cmd) (command "undo" "e") (princ))
(defun LM:UniqueFuzz(l fz)
 (if l 
  (cons (car l) (LM:UniqueFuzz (vl-remove-if '(lambda(x) (equal x (car l) fz)) (cdr l)) fz))))
(defun HA:Giao(obj1 obj2 mode / l r)
 (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length l) 3)
  (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))
 r)
(defun HA:hcn(p1 p3 kc / p1x p3x)
 (setq p1x (list (+ (min (car p1) (car p3)) kc) (+ (min (cadr p1) (cadr p3)) kc))
       p3x (list (- (max (car p1) (car p3)) kc) (- (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" "non" p1x "non" p3x))
(defun LM:RemoveOnce(x l)
 (if l
  (if (equal x (car l))
   (cdr l)
   (cons (car l) (LM:RemoveOnce x (cdr l))))))
(defun KcMin(lst / lst1)
 (foreach pt lst
  (setq lst1 (append (mapcar '(lambda(x) (distance pt x)) (LM:RemoveOnce pt lst)) lst1)))
 (apply 'min lst1))

<<

Filename: 235486_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 235506
Tên lệnh: ha
lisp vẽ mặt bằng kết cấu

Khó! Phức tạp! Nhất là tìm cho ra thuật toán để giải 1 bài toán tưởng chừng như đơn giản!

Lisp này vẽ lưới tường theo hệ các line trục đã có. Yêu cầu: các ô phải là hình chữ...

>>

Khó! Phức tạp! Nhất là tìm cho ra thuật toán để giải 1 bài toán tưởng chừng như đơn giản!

Lisp này vẽ lưới tường theo hệ các line trục đã có. Yêu cầu: các ô phải là hình chữ nhật.

(bạn phongtran86 chắc phải 10 like mới xứng  :lol:)

67029_untitled_9.png

 

;Doan Van Ha - CADViet.com - Ngay 20/05/2013
;Chuc nang: ve luoi tuong theo he truc // truc X va // truc Y, luoi break bat ky nhung cac o phai la HCN.
(defun C:HA(/ lst giao x y ss lstg1 lstg ent ptx pty kcm)
 (vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho") hpb (getvar "hpbound")) (setvar "cmdecho" 0) (setvar "hpbound" 1)
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nBe day tuong <" (rtos kc 2 2) ">:"))) (kc)))
 (princ "\nChon cac Line duong truc...")
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE")))))))
 (foreach ent1 lst
  (setq lstg1 nil)
  (foreach ent2 lst
   (if (setq giao (car (HA:Giao (vlax-ename->vla-object ent1) (vlax-ename->vla-object ent2) acExtendNone)))
    (setq lstg1 (cons giao lstg1))))
  (if lstg1 (setq lstg (append lstg1 lstg))))
 (setq lstg (vl-sort lstg '(lambda(p1 p2) (if (equal (car p1) (car p2) 1E-8) (< (cadr p1) (cadr p2)) (< (car p1) (car p2))))))
 (setq lstg (LM:UniqueFuzz lstg 1E-8))
 (HA:hcn (car lstg) (last lstg) (/ kc -2.))
 (setq kcm (* 0.9 (KcMin lstg)))
 (setq ss (ssadd) ptx (polar (car lstg) 0 kcm))
 (while (< (car ptx) (car (last lstg)))
  (setq pty (polar ptx (/ pi 2) kcm))
  (while (< (cadr pty) (cadr (last lstg)))
   (setq ent (entlast))
   (command "boundary" pty "")
   (if (setq ent (entnext ent)) (setq ss (ssadd ent ss)))
   (setq pty (polar pty (/ pi 2) kcm)))
  (setq ptx (polar ptx 0 kcm)))
 (load "overkillsup.lsp")
 (acet-overkill2 (list ss 1E-8 nil "N" "N" "N"))
 (setq ss (ssget "w" (polar (car lstg) (* 1.25 pi) 1) (polar (last lstg) (* 0.25 pi) 1) '((0 . "LWPOLYLINE"))))
 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget ent))))
  (setq lst (vl-sort lst '(lambda(p1 p2) (if (equal (car p1) (car p2) 1E-8) (< (cadr p1) (cadr p2)) (< (car p1) (car p2))))))
  (HA:hcn (car lst) (last lst) (/ kc 2.))
  (entdel ent))
 (setq ss (ssget "w" (polar (car lstg) (* 1.25 pi) 1) (polar (last lstg) (* 0.25 pi) 1) '((0 . "LWPOLYLINE"))))
 (acet-overkill2 (list ss 1E-8 nil "N" "N" "N"))
 (setvar "cmdecho" cmd) (setvar "hpbound" hpb) (command "undo" "e") (princ))
(defun HA:Giao(obj1 obj2 mode / l r)
 (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length l) 3)
  (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))
 r)
(defun HA:hcn(p1 p3 kc / p1x p3x)
 (setq p1x (list (+ (min (car p1) (car p3)) kc) (+ (min (cadr p1) (cadr p3)) kc))
       p3x (list (- (max (car p1) (car p3)) kc) (- (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" "non" p1x "non" p3x))
(defun LM:RemoveOnce(x l)
 (if l
  (if (equal x (car l))
   (cdr l)
   (cons (car l) (LM:RemoveOnce x (cdr l))))))
(defun KcMin(lst / lst1)
 (foreach pt lst
  (setq lst1 (append (mapcar '(lambda(x) (distance pt x)) (LM:RemoveOnce pt lst)) lst1)))
 (apply 'min lst1))
(defun LM:UniqueFuzz(l fz)
 (if l 
  (cons (car l) (LM:UniqueFuzz (vl-remove-if '(lambda(x) (equal x (car l) fz)) (cdr l)) fz))))

<<

Filename: 235506_ha.lsp
Tác giả: lyky
Bài viết gốc: 235585
Tên lệnh: exf
LISP ghép nhiều file DWG cùng cỡ thành một file chung

Bạn dùng code này để tách loạt bảng vẽ nằm theo phương ngang, đặt sát nhau:

(defun pxy(d x y) (polar (polar d 0 x) (* 0.5 pi) y))
(defun C:exf( / A FF I NAM NM NN PT1 PT10 PT11 PT2 PT20 PT21 SS)
(princ "\nVui long to chon khung ban ve khoi dau\n")
(setq pt10 (getpoint "\nPick Bottom Left:\n")
      pt20 (getcorner pt10 "\nPick Top Right:\n"))
(setq pt11 (pxy pt10 -500 -500)
      pt21 (pxy pt20  500...
>>

Bạn dùng code này để tách loạt bảng vẽ nằm theo phương ngang, đặt sát nhau:

(defun pxy(d x y) (polar (polar d 0 x) (* 0.5 pi) y))
(defun C:exf( / A FF I NAM NM NN PT1 PT10 PT11 PT2 PT20 PT21 SS)
(princ "\nVui long to chon khung ban ve khoi dau\n")
(setq pt10 (getpoint "\nPick Bottom Left:\n")
      pt20 (getcorner pt10 "\nPick Top Right:\n"))
(setq pt11 (pxy pt10 -500 -500)
      pt21 (pxy pt20  500  500))
(setq a    (- (car  pt20) (car  pt10)))
(setq nn   (getint "\nNhap so ban ve can tach: <5>\n"))
(setq nm   (getvar "dwgname") nam  (substr nm 1 (- (strlen nm) 4)))
(setq i 0)
(while (< i nn)
(setq pt1 (pxy pt11 (* i a) 0) pt2 (pxy pt21 (* i a) 0))
(command "_zoom" "W" pt1 pt2) (setq ss   (ssget "_W" pt1 pt2))
(setq ff   (strcat (getvar "dwgprefix") nam (itoa (+ i 1))))

<<

Filename: 235585_exf.lsp
Tác giả: Tue_NV
Bài viết gốc: 56248
Tên lệnh: tl
Viết Lisp theo yêu cầu

Bạn nói rõ hơn ý của bạn nhé. Chưa hiểu ý. Hãy post file .dwg lên đây và nói rõ ý của bạn.
Mọi người sẽ giúp bạn

Filename: 56248_tl.lsp
Tác giả: lyky
Bài viết gốc: 234899
Tên lệnh: test
How to use Visual LISP Editor

Check và gỡ lỗi code với Visual LISP IDE

1/- Các bạn xem đoạn code mẫu sau

(defun c:test ( / ss i sl total entity elist )
(if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (setq i -1 sl (sslength ss) total 0)
      (while (<= (setq i (1+ i))...
>>

Check và gỡ lỗi code với Visual LISP IDE

1/- Các bạn xem đoạn code mẫu sau

(defun c:test ( / ss i sl total entity elist )
(if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (setq i -1 sl (sslength ss) total 0)
      (while (<= (setq i (1+ i)) sl)
        (setq entity (ssname ss i)
              elist  (entget entity)
              total  (+ total (distance (cdr (assoc 10 elist)) (cdr (assoc 11 elist))))))
      (princ (strcat "\nTotal Length: " (rtos total)))))
(princ))

Tất nhiên, với kiến thức và kinh nghiệm của các bạn, các bạn có thể đọc và gỡ lỗi một cách thủ công. Tuy nhiên, trong bài này chúng tôi trình bày cách dùng công cụ của Visual LISP IDE để xác định vị trí lỗi và gỡ lỗi đó.
Trước tiên, bạn khởi động AutoCAD và nhập lệnh VLIDE (hoặc VLISP) để mở chương trình Visual LISP IDE, mở một file mới, copy đoạn code mẫu trên vào.
Vẽ một vài line trong CAD để kiểm tra, Trở lại VLIDE load code bằng biểu tượng load hoặc tổ hợp phím: Ctrl+Alt+E
Chạy thử bằng cách nhập lệnh: TEST tại command line, chúng ta sẽ nhận được thông báo lỗi như sau:

; error: bad argument type: lentityp nil

Và trở lại VLIDE, kiểm tra: Debug » Break on Error tùy chọn này đã được check, nghĩa là VLIDE đã đặt một điểm break tại vị trí lỗi.
 
2/- Xác định vị trí lỗi
Để xác định vị trí lỗi, ta vào: Debug » Last Break Source (hoặc tổ hợp phím: Ctrl+F9)
 

22665_h1.png

 
Reset lại điểm break bằng cách: Debug » Reset to Top Level (hoặc tổ hợp phím: Ctrl+R). Vậy chúng ta đã xác định được vị trí lỗi, nhưng còn phải xác định vì sao lỗi tại đó nữa?!!
 
3/- Xác định nguyên nhân lỗi
Để giúp trả lời câu hỏi này, VLIDE có một vài công cụ khác mà chúng ta có thể sử dụng.
 
3.1/- Adding Break Points: Ta chèn thêm những điểm break để kiểm soát từng đoạn code nhỏ. Trong trường hợp này lỗi xảy ra trong vòng lặp (while, cách chèn: Đặt nháy tại vị trí chèn và Debug » Toggle Break Point (hoặc nhấn phím: F9)

22665_h2.gif

3.2/- Watching Variables: VLIDE cũng cho phép chúng ta theo dõi biến được sử dụng trong các code, hiển thị giá trị của nó và giá trị của những biến liên đới với nó. Double-click vào một biến nào đó và View » Watch Window (hoặc tổ hợp phím: Ctrl+Shift+W) để xem giá trị, theo dõi thêm một biến liên đới với nó bằng cách tô chọn biến đó và Debug » Add Watch (hoặc nhấn phím: Ctrl+W). Trong trường hợp này ta chọn 2 biến “i” và “entity”.
 
3.3/- Animating the Code: Trong CAD, chạy thử đoạn code một lần nữa, chúng ta nhập: TEST tại command line. Sau khi trở lại VLIDE chúng ta vào Debug » Animate và đánh dấu tùy chọn này check. Sau đó vào Debug » Continue (hoặc chọn biểu tượng mũi tên xanh trên thanh Debug, hoặc tổ hợp phím Ctrl+F8)

22665_h3.gif

Các giá trị của các biến trong cửa sổ Watch giúp chúng ta điều tra được nguyên nhân lỗi. Trong trường hợp này, giá trị của “entity → nil” khi “i → 3”, điều này cho thấy với i=3 đã thoát khỏi điều kiện kiểm tra của vòng lặp, do đó “entity → nil”.
Reset lại điểm break bằng cách: Debug » Reset to Top Level (hoặc tổ hợp phím: Ctrl+R) và xóa tất cả các điểm break bằng cách Debug » Clear all Break Points (hoặc tổ hợp phím Ctrl+Shift+F9). Sau đó vào Debug » Animate và hủy đánh dấu tùy chọn này uncheck.
 
4/- Sửa lỗi
Với thiết định ban đầu i=-1, vậy nó điều kiện vòng lặp sẽ được thực thi đến khi i=(sl-1) thì dừng và thoát ra, như vậy ta có thể sửa lại code như sau:

(defun c:test ( / ss i sl total entity elist )
(if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (setq i -1 sl (sslength ss) total 0)
      (while (< (setq i (1+ i)) sl)    ;;; “<=” da duoc thay bang “<” ;;;
        (setq entity (ssname ss i)
              elist  (entget entity)
              total  (+ total (distance (cdr (assoc 10 elist)) (cdr (assoc 11 elist))))))
      (princ (strcat "\nTotal Length: " (rtos total)))))
(princ))

Đó chỉ là một cách, tùy bạn có thể sửa bằng cách khác, vd: thiết định ban đầu cho i=0 chẳng hạn…
 
5/- Tham khảo thêm tài liệu trợ giúp của VLIDE
 

22665_vlidehelp.png

Nguồn bài viết: Lý Mẹc


<<

Filename: 234899_test.lsp
Tác giả: lyky
Bài viết gốc: 234903
Tên lệnh: sn%2B sn-
How to use Visual LISP Editor

Em là người mới bắt đầu học LISP, món này rất cần thiết đây!
 
Tuy nhiên, em mong muốn các Bác có thể hướng dẫn cách sử dụng các công cụ của Visual LISP Editor để phát hiện lỗi và sửa lỗi,...

>>

Em là người mới bắt đầu học LISP, món này rất cần thiết đây!
 
Tuy nhiên, em mong muốn các Bác có thể hướng dẫn cách sử dụng các công cụ của Visual LISP Editor để phát hiện lỗi và sửa lỗi, từ đó những người mới học như tụi em sẽ rút ra những bài học kinh nghiệm!

Code của bạn sau khi chạy debug báo vị trí lỗi như sau:
 
22665_h5.jpg
 
Do bạn viết vội nên thừa - thiếu dấu ngoặc mà thôi, tôi đã fix lại sau đây, LISP chạy được, nhưng chạy có đúng ý đồ của bạn hay không, đề nghị bạn test lại và tự điều chỉnh các phép tính toán nhé! Code đây:

 
(defun pxy(d x y) (polar (polar d 0 x) (* 0.5 pi) y))
(defun SN(id / )
(setq D1 (getpoint "\nVui long pick diem Bottom Left\n")
      D3 (getcorner D1 "\nVui long pick diem Top Right\n"))
(setq an  (getint "\nVui long nhap khoang offset: <110>\n")) (if (= an nil) (setq an 110))
(setq bn (- 0 an))
(setq D2 (list (car D1) (cadr D3))
      D4 (list (car D3) (cadr D1)))
(cond
((= id 1) (setq D11 (pxy D1 bn bn)
                D22 (pxy D2 bn an)
                D33 (pxy D3 an an)
                D44 (pxy D4 an bn)))   ;;; Thieu ) da sua
((= id 2) (setq D11 (pxy D1 an an)
                D22 (pxy D2 an bn)
                D33 (pxy D3 bn bn)
                D44 (pxy D4 bn an))))  ;;; Thua ) da sua
(Command "_pline" D11 D22 D33 D44 "C")
(princ))
(defun C:SN+() (SN 1))
(defun C:SN-() (SN 2))

@ Bác Doan Van Ha - cám ơn Bác đã quan tâm đến vấn đề, chúc Bác nhiều SK và thành công trong công việc nhé!


<<

Filename: 234903_sn%2B_sn-.lsp

Trang 130/330

130