Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] viết lisp đánh số các đọan thẳng?


  • Please log in to reply
49 replies to this topic

#21 quan08

quan08

    biết vẽ pline

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

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

Có vẻ như bác mod ưu ái bạn, cho ra hẳn 1 topic riêng :)
Bạn thử dùng cái này xem sao.
- Lần đầu dùng : lisp hỏi tên Block, nếu có rồi, dùng block đó. Nếu chưa có, tạo mới 1 block thuộc tính theo chiều cao text của style hiện tại
- Lần sau : lấy block lần trước
- Theo bản vẽ yêu cầu : chỉ có tác dụng với Line.
- Nhập dãy bắt đầu (tách số đầu để tăng)
- Đánh số quay góc chèn block theo yêu cầu.Bạn cứ chọn tất cả Line cần làm, lisp sẽ :
Làm từ các đối tượng nằm ngang trước : đánh từ dưới lên trên, Block đứng
Đối tượng đứng : đánh từ trái sang phải, block nằm ra
Đối tượng Chéo : đánh theo thứ tự chọn, block đứng giữa Line
- Code không gọn do coding vội :|

(defun c:1(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 )
(defun dxf (dxfCode En) (cdr (assoc dxfCode (entget en))))
(command "undo" "be")
(grtext -1 "Free from CADVIET @ketxu")
(acet-sysvar-set (list "attreq" 1 "attdia" 0 "cmdecho" 0 "osmode" 0))
(or #blkname (setq #blkname (getstring "\nNh\U+1EADp t\U+00EAn Block :")))
(setq d (tblsearch "style" (getvar "textstyle")) h1 (cdr (assoc 40 d)) h2 (cdr (assoc 42 d)))
(if (> h1 0) (setq h h1) (setq h h2))
;Neu khong co Block ten #blkName : tao moi
(if (not (tblsearch "block" #blkName))
(progn
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) h "0" )
(setq e1 (entlast))
(command "circle" '(0 0 0) h)
(setq e2 (entlast))
(command "block" #blkName (list 0 (- h) 0) e1 e2 "" )
)
)
;Lay list
(setq lstEname (acet-ss-to-list (ssget '((0 . "LINE")))) lstLen '())
(foreach en lstEname
(cond
((equal (cadr (dxf 10 en))(cadr (dxf 11 en)) 0.1)
(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))
((equal (car (dxf 10 en))(car (dxf 11 en)) 0.1)
(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))
(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))
)
)
;Sap xep :
(setq lstEname
(append
(vl-sort lstNgang '(lambda (y1 y2) (< (cadr (dxf 10 y1)) (cadr (dxf 10 y2)))))
(vl-sort lstDoc '(lambda (y1 y2) (< (car (dxf 10 y1)) (car (dxf 10 y2)))))
lstkhac
)
str (getstring "\nD\U+00E3y b\U+1EAFt \U+0111\U+1EA7u :") j (1- (atoi str )) i (1+ j) after (vl-string-left-trim (rtos i 2 0) str)
)
(foreach ent lstEname
(if (vl-position ent lstDoc)(setq goc -90)(setq goc 0))
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (not (vl-position len lstLen))
(progn
(command "insert" #blkname (mid ent) 1 1 goc (strcat (rtos i 2 0) after))
(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
)
(command "insert" #blkname (mid ent) 1 1 goc (strcat (rtos (+ j (1+ (vl-position len lstLen))) 2 0) after))
)
)
(acet-sysvar-restore)
(command "undo" "en")
)
(defun mid (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
pt (mapcar '+ p1 p2)
pt (mapcar '* pt '(0.5 0.5 0.5))
)
pt
)

Lisp của bạn nếu quên không nhập tên block sẽ không sử dụng tiếp được nữa,phải thoát cad ra mới sử dụng lại được.Bạn xem khắc phục lại giùm mình,mà quên muốn cho vòng tròn này đường kính là 600 thì chỉnh chỗ nào?Thanks.Mình hết quyên bình chọn nên không bình chọn cho bạn được.
  • -1

#22 ketxu

ketxu

    Copier - Paster - Editor

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

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

Mình chưa hiểu ý bạn "quên" là sao ^^
Còn chỗ chỉnh bán kính vòng tròn thì nằm ở dòng (command "circle" '(0 0 0) h), thay h bằng bán kính bạn cần. Ví dụ trong trường hợp này là 300. Lưu ý là như vậy có khả năng không phù hợp với chiều cao text của bạn. ^^ (trừ trường hợp h luôn bằng 250 như file post)

P/s : đã hiểu "quên" của bạn nghĩa là sao, trường hợp này mình không lường :D, code mình đã sửa trong bài trước, bạn down lại nhé, đề phòng bạn hấp tấp mà "quên" mất ^^

P/s 2 : giờ mới nghĩ ra lấy mid line lại dùng giao mổ bò để giết gà, nhưng thôi, cũng không quan trọ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


#23 quan08

quan08

    biết vẽ pline

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

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

h luôn bằng 250 còn vòng tròn đường kính là 600 bạn ah,cho mình hỏi cái này không đánh số được cho polyline sao bạn?Nhờ bạn thêm chức năng đánh số cho polyline giùm mình luôn nhe.
  • -1

#24 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

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

Hề hề hề,
Bạn thật là ?????????
Mình đã sửa theo ý bạn song mình sẽ không chịu trách nhiệm sửa nữa nếu như trên bản vẽ của bạn có sẵn một block tên test mà không đúng với cái block thuộc tính bạn yêu cầu. Khi đó nếu bạn muốn sửa thì hãy tự sửa nhé vì mình vẫn để các dòng code cũ lại chỉ vô hiệu hóa chúng mà thôi.
Hy vọng bạn sẽ không còn thắc mắc nữa....


(defun C:mkatb (/ oldos col pt e1 e2 ten plst plst1 dlst j j1 i i1 n n1 m ssl ssl1 p p1 d d1 d2 k k1 ss1 ss2 ss3 goc)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq col (getvar "cecolor"))
(setvar "angdir" 0)
(setq pt (getpoint "\n Chon diem chuan"))
(setvar "osmode" 0)
(setvar "cecolor" "4")
(if (not (tblsearch "block" "test"))
(progn
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" pt "250" "0" )
(setq e1 (entlast))
(setvar "cecolor" col)
(command "circle" pt 300)
(setq e2 (entlast))
;;;;;;;;(if (tblsearch "block" "test")
;;;;;;;; (progn
;;;;;;;; (setq ten (getstring t "\n Nhap ten block moi: "))
;;;;;;;; (command "rename" "b" "test" ten)
;;;;;;;; )
;;;;;;;;)
(command "block" "test" pt e1 e2 "" )
)
)
(setq plst (list)
dlst (list)
j (getint "\n Nhap gia tri so bat dau danh so: ")
m (getstring t "\n Nhap cac ky tu di kem: ")
)
(prompt "\n Chon tap doi tuong doan thang theo phuong x")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq j1 j)
(if ssl
(progn
(foreach x ssl
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst (append plst (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst (append plst (list (list p d)))
)
)
)
;;;;;;;;(setq ans (getstring t "\n Ban muon danh so theo phuong nao? <X or Y>: "))
;;;;;;;;(if (= (strcase ans) "Y")
;;;;;;; (progn
;;;;;;; (setq plst (vl-sort plst '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
;;;;;;; (setq goc "90")
;;;;;;; )
;;;;;;; (progn
(setq plst (vl-sort plst '(lambda (y1 y2) (< (cadr (car y1)) (cadr (car y2))))))
(setq goc "")
;;;;;;; )
;;;;;;;)

(setq n (length plst)
i 0

p1 (car (nth i plst))
)
(command "insert" "test" p1 "" "" goc (strcat (rtos j 2 0) m) )
(setq
d1 (cadr (nth i plst))
dlst (cons d1 dlst))
(while (< i (1- n))
(setq d2 (cadr (nth (1+ i) plst)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth (1+ i) plst)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth (1+ i) plst)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i (1+ i))
)
)
(setq j (1- j))
)

(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))

(prompt "\n Chon tap doi tuong doan thang theo phuong y")
(setq ssl1 (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq plst1 (list))
(if ssl1
(progn
(foreach x ssl1
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst1 (append plst1 (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst1 (append plst1 (list (list p d)))
)
)
)
(setq plst1 (vl-sort plst1 '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
(setq goc "90")
(setq n1 (length plst1)
i1 0)
(while (< i1 n1)
(setq d2 (cadr (nth i1 plst1)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth i1 plst1)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth i1 plst1)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i1 (1+ i1))
)
)
)

(setq ss2 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))
(setq ss3 (ACET-SS-REMOVE ss1 ss2))


;;;;;(if (= (strcase ans) "Y")
(command "move" ss3 "" p1 (list (- (car p1) 300) (cadr p1) (caddr p1)))
(command "move" ss1 "" p1 (list (car p1) (+ (cadr p1) 300) (caddr p1)))
;;;;;;)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)

)

Thấy bác Bình viết lách đêm khuya mà thấy tội cho bác Bình quá. Bác thiệt là con người nhiệt tình và đam mê lisp. Thiết nghĩ BQT Admin nên có phương án bồi dưỡng cho anh em viết Lisp khi có ai yêu cầu. Ai yêu cầu thì phải có phần thưởng cho những ai viết thành công yêu cầu của người đó. Chớ không chỉ vì tính đam mê Lisp mà làm ảnh hưởng sức khỏe anh em trong khi đó người yêu cầu ngủ ngon mà ko hay biết. Chúng ta nên có phương án lập 1 Topic mới cho đề án này. Bác Bình và mọi người giữ gìn sức khỏe nha.
P\s: Ketxu là người thích cái phần quà này lắm vì hay viết lisp mừ. :rolleyes:

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 29 June 2011 - 12:57 AM
bổ sung lisp theo góp ý của bác Ketxu

  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#25 ketxu

ketxu

    Copier - Paster - Editor

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

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

h luôn bằng 250 còn vòng tròn đường kính là 600 bạn ah,cho mình hỏi cái này không đánh số được cho polyline sao bạn?Nhờ bạn thêm chức năng đánh số cho polyline giùm mình luôn nhe.

Được, nhưng mà không vui bạn ạ :)
Chắc phải chờ bạn 1 thời gian để bạn nghĩ ra còn yêu cầu nào với lisp này nữa không. Hơn nữa, bạn cũng có tính là nếu Pline có nhiều phân đoạn thì lisp sẽ làm như thế nào không ? Chiều dài lấy theo cái nào? Ghi chữ vào đâu ??
  • 1

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


#26 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

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

h luôn bằng 250 còn vòng tròn đường kính là 600 bạn ah,cho mình hỏi cái này không đánh số được cho polyline sao bạn?Nhờ bạn thêm chức năng đánh số cho polyline giùm mình luôn nhe.

Anh chàng Quan08 này đề nghị bỏ xiền mời ket bia cho anh em viết lisp đi. Yêu cầu hơi nhiều và luồn lách, lươn lẹo lắm đó. :D
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#27 quan08

quan08

    biết vẽ pline

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

Đã gửi 28 June 2011 - 09:15 PM

Được, nhưng mà không vui bạn ạ :)
Chắc phải chờ bạn 1 thời gian để bạn nghĩ ra còn yêu cầu nào với lisp này nữa không. Hơn nữa, bạn cũng có tính là nếu Pline có nhiều phân đoạn thì lisp sẽ làm như thế nào không ? Chiều dài lấy theo cái nào? Ghi chữ vào đâu ??

Nên e mới thấy bài của bác Bình là đáp ứng những cái e cần.E chỉ cần có nhiêu đó thôi đó thôi bác ketxu thôi.
PS:Bác Bình xem giùm chỗ lisp bị ngược giùm e chưa bác?
  • 0

#28 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 28 June 2011 - 09:25 PM

Nên e mới thấy bài của bác Bình là đáp ứng những cái e cần.E chỉ cần có nhiêu đó thôi đó thôi bác ketxu thôi.
PS:Bác Bình xem giùm chỗ lisp bị ngược giùm e chưa bác?

Ok bạn :) Chắc bác Bình sẽ giúp bạn sớm thôi
  • 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


#29 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 28 June 2011 - 09:35 PM

Nó đây bác ạ:
http://www.cadviet.c...drawing1_67.dwg

Hề hề hề,
Lỗi không phải do lisp mà lỗi do cái bản vẽ của bạn quy định ngược với thông thường, nghĩa là góc quay dương được tính theo chiều kim đồng hồ bạn ạ. Nó chả phải ngược vài cái như bạn nói mà sẽ ngược toàn bộ đối với các line theo phương y.
Bạn hãy xem cái bạn đã đặt cho bản vẽ của bạn:
http://www.cadviet.c...pfiles/3/v1.jpg
Hình đã gửi
Bạn muốn nó hết ngược thì hãy đổi lại việc thiết lập này nhé. Nếu không bạn sẽ phải thay đổi đoạn code (setq goc "90") thành (setq goc "-90") và ngược lại tùy từng bản vẽ của bạn.
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.

#30 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 28 June 2011 - 09:50 PM

@Bác Bình : với các lisp có xài đến góc, hướng, tốt nhất là nên đặt angdir và angbase về 0 trước bác ạ :) Chắc chắn sau lần này bạn chủ topic sẽ ưng cái bụng thôi ^^



--------------------------------------
Post lại bài trên vừa nãy ket nhỡ tay xóa

h luôn bằng 250 còn vòng tròn đường kính là 600 bạn ah,cho mình hỏi cái này không đánh số được cho polyline sao bạn?Nhờ bạn thêm chức năng đánh số cho polyline giùm mình luôn nhe.

Mình lại tự trả lời câu mình hỏi thôi.
Lần này lisp sẽ :
- Hỏi tên Block dùng để đánh STT, nếu có rồi thì dùng, chưa có thì tạo mới, lần thứ 2 dùng sẽ không hỏi lại (như cũ)
- CHọn *Line (Line,Pline,LWPolyline, SPline..)
=> Lisp sẽ đánh số lần lượt :
1.*Line ngang trước (định nghĩa Ngang nếu Toạ độ Y điểm đầu = Toạ độ Y "trọng tâm"), đánh từ dưới lên.
2.*Line đứng (định nghĩa đứng nếu Toạ độ X điểm đầu = Toạ độ X "trọng tâm"), đánh từ trái sang
3.Các *Line còn lại, đánh từ trái sang
Điểm đánh là "trọng tâm", lấy theo boundingbox

(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 mid dau giua)
(defun dxf (dxfCode En) (cdr (assoc dxfCode (entget en))))
(defun mid (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
pt (mapcar '+ p1 p2)
pt (mapcar '* pt '(0.5 0.5 0.5))
)
pt
)
(command "undo" "be")
(grtext -1 "Free from CADVIET @ketxu")
(acet-sysvar-set (list "attreq" 1 "attdia" 0 "cmdecho" 0 "osmode" 0 "angbase" 0 "angdir" 0))
(if (or (not #blkname)(= #blkname "" )) (setq #blkname (getstring "\nNh\U+1EADp t\U+00EAn Block :")))
(setq d (tblsearch "style" (getvar "textstyle")) h1 (cdr (assoc 40 d)) h2 (cdr (assoc 42 d)))
(if (> h1 0) (setq h h1) (setq h h2))
;Neu khong co Block ten #blkName : tao moi
(if (not (tblsearch "block" #blkName))
(progn
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) h "0" )
(setq e1 (entlast))
(command "circle" '(0 0 0) h)
(setq e2 (entlast))
(command "block" #blkName (list 0 (- h) 0) e1 e2 "" )
)
)
;Lay list
(setq lstEname (acet-ss-to-list (ssget '((0 . "*LINE")))) lstLen '())
(foreach en lstEname
(setq dau (vlax-curve-getStartPoint (vlax-ename->vla-object en)) giua (mid en))
(cond
((equal (cadr dau)(cadr giua) 0.1)
(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))
((equal (car dau)(car giua) 0.1)
(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))
(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))
)
)
;Sap xep :
(setq lstEname
(append
(vl-sort lstNgang '(lambda (y1 y2) (< (cadr (mid y1)) (cadr (mid y2)))))
(vl-sort lstDoc '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
(vl-sort lstkhac '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
)
str (getstring "\nD\U+00E3y b\U+1EAFt \U+0111\U+1EA7u :") j (1- (atoi str )) i (1+ j) after (vl-string-left-trim (rtos i 2 0) str)
)
(foreach ent lstEname
(if (vl-position ent lstDoc)(setq goc 90)(setq goc 0))
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (not (vl-position len lstLen))
(progn
(command "insert" #blkname (mid ent) 1 1 goc (strcat (rtos i 2 0) after))
(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
)
(command "insert" #blkname (mid ent) 1 1 goc (strcat (rtos (+ j (1+ (vl-position len lstLen))) 2 0) after))
)
)
(acet-sysvar-restore)
(command "undo" "en")
)
Chú ý để giữ tính tiện dụng mình không đổi h = 250, đường kính = 600. Nếu bạn cần đổi, hãy thay 3 dòng sau :

(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) h "0" )
..
(command "circle" '(0 0 0) h)
..
(command "block" #blkName (list 0 (- h) 0) e1 e2 "" )

thành :

(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) 250 "0" )
..
(command "circle" '(0 0 0) 300)
..
(command "block" #blkName (list 0 (- 300) 0) e1 e2 "" )


  • 2

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


#31 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

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

@Bác Bình : với các lisp có xài đến góc, hướng, tốt nhất là nên đặt angdir và angbase về 0 trước bác ạ :) Chắc chắn sau lần này bạn chủ topic sẽ ưng cái bụng thôi ^^



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

Hề hề hề,
Cám ơn Ketxu,
Thực tình mình nhớ là có biến hệ thống quản lý cái ni nhưng chả nhớ tên nó là chi nên lười tìm và post hình ảnh để bạn ấy tự giải quyết.
hề hề hề,
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#32 quan08

quan08

    biết vẽ pline

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

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

Cảm ơn bác Bình và bác ketxu đã nhiệt tình giúp e.Nếu có dịp gặp nhau e sẵn sàng mời bia vì đã làm phiền 2 bác quá nhiều.
  • 0

#33 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

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

Cảm ơn bác Bình và bác ketxu đã nhiệt tình giúp e.Nếu có dịp gặp nhau e sẵn sàng mời bia vì đã làm phiền 2 bác quá nhiều.

Hề hề hề. Phải thế chứ, nhưng mà 2 bác ấy một ở HN, 1 bác ở Bình Dương, chắc uống bia muốn "cạng" cheer cheer thì phải "Hôn môi xa rồi". Kekekeke.
p/s: Bác Bình trở lại, lợi hại gấp trăm lần. Hiiii
P/s: Ketxu đâu có uống bia được nhở. :blush:
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#34 790312

790312

    biết lệnh fillet

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

Đã gửi 29 June 2011 - 09:36 AM

@Bác Bình : với các lisp có xài đến góc, hướng, tốt nhất là nên đặt angdir và angbase về 0 trước bác ạ :) Chắc chắn sau lần này bạn chủ topic sẽ ưng cái bụng thôi ^^



--------------------------------------
Post lại bài trên vừa nãy ket nhỡ tay xóa


Mình lại tự trả lời câu mình hỏi thôi.
Lần này lisp sẽ :
- Hỏi tên Block dùng để đánh STT, nếu có rồi thì dùng, chưa có thì tạo mới, lần thứ 2 dùng sẽ không hỏi lại (như cũ)
- CHọn *Line (Line,Pline,LWPolyline, SPline..)
=> Lisp sẽ đánh số lần lượt :
1.*Line ngang trước (định nghĩa Ngang nếu Toạ độ Y điểm đầu = Toạ độ Y "trọng tâm"), đánh từ dưới lên.
2.*Line đứng (định nghĩa đứng nếu Toạ độ X điểm đầu = Toạ độ X "trọng tâm"), đánh từ trái sang
3.Các *Line còn lại, đánh từ trái sang
Điểm đánh là "trọng tâm", lấy theo boundingbox

(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 mid dau giua)
(defun dxf (dxfCode En) (cdr (assoc dxfCode (entget en))))
(defun mid (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
pt (mapcar '+ p1 p2)
pt (mapcar '* pt '(0.5 0.5 0.5))
)
pt
)
(command "undo" "be")
(grtext -1 "Free from CADVIET @ketxu")
(acet-sysvar-set (list "attreq" 1 "attdia" 0 "cmdecho" 0 "osmode" 0 "angbase" 0 "angdir" 0))
(if (or (not #blkname)(= #blkname "" )) (setq #blkname (getstring "\nNh\U+1EADp t\U+00EAn Block :")))
(setq d (tblsearch "style" (getvar "textstyle")) h1 (cdr (assoc 40 d)) h2 (cdr (assoc 42 d)))
(if (> h1 0) (setq h h1) (setq h h2))
;Neu khong co Block ten #blkName : tao moi
(if (not (tblsearch "block" #blkName))
(progn
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) h "0" )
(setq e1 (entlast))
(command "circle" '(0 0 0) h)
(setq e2 (entlast))
(command "block" #blkName (list 0 (- h) 0) e1 e2 "" )
)
)
;Lay list
(setq lstEname (acet-ss-to-list (ssget '((0 . "*LINE")))) lstLen '())
(foreach en lstEname
(setq dau (vlax-curve-getStartPoint (vlax-ename->vla-object en)) giua (mid en))
(cond
((equal (cadr dau)(cadr giua) 0.1)
(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))
((equal (car dau)(car giua) 0.1)
(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))
(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))
)
)
;Sap xep :
(setq lstEname
(append
(vl-sort lstNgang '(lambda (y1 y2) (< (cadr (mid y1)) (cadr (mid y2)))))
(vl-sort lstDoc '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
(vl-sort lstkhac '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
)
str (getstring "\nD\U+00E3y b\U+1EAFt \U+0111\U+1EA7u :") j (1- (atoi str )) i (1+ j) after (vl-string-left-trim (rtos i 2 0) str)
)
(foreach ent lstEname
(if (vl-position ent lstDoc)(setq goc 90)(setq goc 0))
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (not (vl-position len lstLen))
(progn
(command "insert" #blkname (mid ent) 1 1 goc (strcat (rtos i 2 0) after))
(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
)
(command "insert" #blkname (mid ent) 1 1 goc (strcat (rtos (+ j (1+ (vl-position len lstLen))) 2 0) after))
)
)
(acet-sysvar-restore)
(command "undo" "en")
)
Chú ý để giữ tính tiện dụng mình không đổi h = 250, đường kính = 600. Nếu bạn cần đổi, hãy thay 3 dòng sau :

thành :

Lisp của bác rất hay,nhưng lisp này lấy TEXT STYLE mặc định của cad là STANDARD,giờ mình muốn nó lấy TEXT STYLE do mình định nghĩa là FONTCHU thì phải làm sao?Thanks.
  • 0

#35 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 June 2011 - 10:16 AM

Lisp sử dụng Style hiện tại, bạn để style hiện hành là gì thì nó lấy cái đó!
  • 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


#36 790312

790312

    biết lệnh fillet

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

Đã gửi 29 June 2011 - 11:33 AM

Lisp sử dụng Style hiện tại, bạn để style hiện hành là gì thì nó lấy cái đó!

Lisp của bạn chạy tốt nhưng khi mình dùng Vlide để kiểm lỗi:
; warning: local variable used as function: MID
Vậy lỗi này là lỗi gì vậy bạn?Thanks.
  • 0

#37 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 29 June 2011 - 11:50 AM

Lisp của bạn chạy tốt nhưng khi mình dùng Vlide để kiểm lỗi:
; warning: local variable used as function: MID
Vậy lỗi này là lỗi gì vậy bạn?Thanks.

Có lẽ bác Ketxu đã nhầm khi lấy tên hàm làm biến cục bộ ấy mà. Bạn bỏ "mid" trong các biến cục bộ đi là được.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#38 790312

790312

    biết lệnh fillet

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

Đã gửi 29 June 2011 - 02:13 PM

Có lẽ bác Ketxu đã nhầm khi lấy tên hàm làm biến cục bộ ấy mà. Bạn bỏ "mid" trong các biến cục bộ đi là được.

Bác nào sửa giùm e với.E đã thử đổi tên MID thành tên khác thì vẫn báo lỗi tên mới giống tên cũ.Nếu bỏ EN đi thì nó báo tới EN.Thanks.
  • 0

#39 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 29 June 2011 - 02:41 PM

Lisp của bác rất hay,nhưng lisp này lấy TEXT STYLE mặc định của cad là STANDARD,giờ mình muốn nó lấy TEXT STYLE do mình định nghĩa là FONTCHU thì phải làm sao?Thanks.

Hề hề hề,
Chơi kiểu bác ketxu cũng hay. Nếu không muốn bạn có thể thêm "s" "Fontchu" vào trước "j" trong hàm tạo attdef.
Hề hề hề.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#40 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 29 June 2011 - 02:47 PM

Bác nào sửa giùm e với.E đã thử đổi tên MID thành tên khác thì vẫn báo lỗi tên mới giống tên cũ.Nếu bỏ EN đi thì nó báo tới EN.Thanks.

Hề hề hề,
Bạn cứ làm đúng như bác ĐoanvanHa đã dạy, chớ bạn đổi cả tên biến lẫn tên hàm thì có ich chi đâu.... Chỉ xóa cái biến mid trong số các biến cục bộ mà thôi, còn thì cứ để U NHƯ KỴ.
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.