Đế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

#41 ketxu

ketxu

    Copier - Paster - Editor

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

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

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.


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.


Ồ, bạn bắt đầu lập trình, hay mần chi mà "kiểm lỗi" :) Và bỏ mid, bỏ en ở đâu ???

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.

Em cố ý đó bác ạ :) Có 1 số lý do mà không phải lúc nào cũng dùng lambda, và khi đó thì cần làm như thế này :)
  • 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


#42 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 29 June 2011 - 02:56 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.

Sao lại đổi tên mid? Bạn chỉ sửa:
(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 mid dau giua)
thành
(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 dau giua)
Tôi đã thử, được mà.
P/S: ồ, té ra là cố ý của ketxu. Hì, hì, hì!
  • 1

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


#43 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 - 03:04 PM

Cảm ơn bác,cố vậy để làm gì bác nhỉ?
  • 0

#44 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 June 2011 - 03:21 PM

Để các hàm dxf,mid chỉ có tác dụng khi chạy lisp này :)
P/s : hàm dxf không còn cần trong lisp 2, nên có thể xóa đi ^^
  • 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


#45 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 30 June 2011 - 05:02 PM

Nhờ bạn ketxu xem giùm mình nếu đoạn thẳng như thế này thì đánh không đúng.Mong bạn xem và giúp sửa giùm mình.Thanks.
http://www.cadviet.c...drawing1_69.dwg
  • 0

#46 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 01 July 2011 - 01:58 AM

Nhờ bạn ketxu xem giùm mình nếu đoạn thẳng như thế này thì đánh không đúng.Mong bạn xem và giúp sửa giùm mình.Thanks.
http://www.cadviet.c...drawing1_69.dwg

Hề hề hề,
Lisp chạy rất chuẩn theo ý của người viết. Chỉ có hình vẽ của bạn sai với cái yêu cầu đặt ra ban đầu mà thôi.
Bạn hãy kiểm tra lại nhé......
Còn nếu bạn muốn sử dụng nó trong trường hợp hình vẽ của bạn thì phải thay cái đoạn code này đi bạn nhé:
(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))))
)

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.

#47 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 01 July 2011 - 06:15 AM

Hề hề hề,
Lisp chạy rất chuẩn theo ý của người viết. Chỉ có hình vẽ của bạn sai với cái yêu cầu đặt ra ban đầu mà thôi.
Bạn hãy kiểm tra lại nhé......
Còn nếu bạn muốn sử dụng nó trong trường hợp hình vẽ của bạn thì phải thay cái đoạn code này đi bạn nhé:
(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))))
)

Hề hề hề,...

Thay như thế nào vậy bác?Bác giúp e luôn với.E về lisp còn amater lắm.Thanks.
  • 0

#48 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 01 July 2011 - 09:48 AM

Thay như thế nào vậy bác?Bác giúp e luôn với.E về lisp còn amater lắm.Thanks.

Hề hề hề,
Bạn thử thay thế này coi sao:
(cond
((equal (cadr (vlax-curve-getfirstderiv (vlax-ename->vla-object en)(/ (vlax-curve-getendparam (vlax-ename->vla-object en)) 2))) 0 0.0001)
(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))
((equal (car (vlax-curve-getfirstderiv (vlax-ename->vla-object en)(/ (vlax-curve-getendparam (vlax-ename->vla-object en)) 2))) 0 0.0001)
(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))
(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))
)
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.

#49 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 01 July 2011 - 02:43 PM

Hề hề hề,
Bạn thử thay thế này coi sao:
(cond
((equal (cadr (vlax-curve-getfirstderiv (vlax-ename->vla-object en)(/ (vlax-curve-getendparam (vlax-ename->vla-object en)) 2))) 0 0.0001)
(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))
((equal (car (vlax-curve-getfirstderiv (vlax-ename->vla-object en)(/ (vlax-curve-getendparam (vlax-ename->vla-object en)) 2))) 0 0.0001)
(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))
(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))
)
Hề hề hề,

Còn 1 lỗi nhỏ nữa bác ạ.Mong bác sửa giùm e luôn nhe.Cảm ơn bác nhiều.
http://www.cadviet.c...drawing1_71.dwg
  • 0

#50 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 02 July 2011 - 09:14 AM

Nhờ bạn ketxu xem giùm mình nếu đoạn thẳng như thế này thì đánh không đúng.Mong bạn xem và giúp sửa giùm mình.Thanks.
http://www.cadviet.c...drawing1_69.dwg

Chính xác là bản vẽ của bạn chả đúng với điều ban đầu bạn nói, hoặc bạn chẳng đọc những dòng ketxu ghi trước khi post lisp.
Lúc đầu thì bạn post toàn Line thẳng, dần dà ra ntn đây. Sao bạn không nói ngay từ đầu ? Sau này lúc nào buồn buồn bạn lại đổi cái form mà lúc đầu bạn gọi là Pline thành các kiểu khác rồi lại lôi cổ ket ra bảo nó làm sai thì ... :blink:
Diễn đàn cứ vận động lisper ghi rõ ý đồ của lisp, mà ghi xong chẳng mấy ai đọc, tốt nhất là cứ post rồi im lặng thôi, bác nào dùng được thì dùng :wub:

Về vấn đề của bạn :
- Lisp đánh số sai do lỗi làm tròn của CAD, kiểm tra lstLen sẽ thấy 2 phần tử 5700.0. Vậy, với sai số nhỏ, ta biến chúng thành số nguyên, tức những Pline xấp xỉ nhau (ví dụ 1.1 với 1.3 với 1.9) coi như bằng nhau để đánh số cho đơn giản
Đoạn code viết lại :
(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 mid dau giua)
(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
)
(defun midp ( p1 p2)(mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
(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 (nth (1- (/(length (setq lstPnt (acet-geom-vertex-list en))) 2)) lstPnt) giua (nth (/(length (setq lstPnt (acet-geom-vertex-list en))) 2) lstPnt)) ;6 (3,4) 4 (2,3)
(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 (fix (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
dau (nth (1- (/(length (setq lstPnt (acet-geom-vertex-list ent))) 2)) lstPnt) giua (nth (/(length lstPnt) 2) lstPnt))
(if (not (vl-position len lstLen))
(progn
(command "insert" #blkname (midp dau giua) 1 1 goc (strcat (rtos i 2 0) after))
(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
)
(command "insert" #blkname (midp dau giua) 1 1 goc (strcat (rtos (+ j (1+ (vl-position len lstLen))) 2 0) after))
)
)
(acet-sysvar-restore)
(command "undo" "en")
)

  • 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