Đến nội dung


Hình ảnh
* * * - - 17 Bình chọn

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)


  • Please log in to reply
2850 replies to this topic

#2501 luhaivinh

luhaivinh

    Edu level: li10

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

Đã gửi 14 May 2015 - 06:59 PM

hehe. Qúa hay...thế mà mò lâu nay.

Thanks bác Hà nhiều nhé! :D  :D  :D


  • 0

#2502 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 18 May 2015 - 07:33 AM

Chào các anh chị,

Em mới học Lisp,mong mọi người giúp đỡ nhiều ạ

Em có đoạn Code sau

(defun c:CM (/ *error* cla ent-last iferror k lay olderr os pause r ve vec);;;; tao cloud mark;
(setvar "modemacro" "CREATE CLOUD_MARK")
;;; (setvar "CMDECHO" 0)
(command "undo" "BE")
(defun iferror (msg)
(if (= cla nil)
(setq cla "3"))
(if cla (setvar "CLAYER" cla))
(if os (setvar "OSMODE" os))
(setvar "CMDECHO" 1)
(setq *error* olderr)
(princ)
)
(setq lay (tblsearch "layer" "Cloud mark"))
(if (= lay nil)
(command "_layer" "_n" "Cloud mark" "_c" "6" "Cloud mark" ""))
(setq olderr *error*)
(setq *error* iferror)
(graphscr)
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq cla (getvar "CLAYER"))
(setq r (* (getvar "DIMSCALE") 5))
(setq k T)
(while k
(terpri)
(if (= ve nil) (setq ve "Hinh chu nhat"))
(setq vec (strcat "\nVe hinh chu nhat hay duong line? <" ve ">: "))
(setq vec (getstring vec))
(if (= vec "")
(command "_.RECTANGLE")
(command "_.pline"))
(while (= 1 (getvar "cmdactive")) (command pause))
(setq ent-last (entlast))
(setvar "clayer" "Cloud mark")
(command "_.REVCLOUD" "_A" r r "_Object" ent-last "")
)
(setvar "CLAYER" cla)
(setq *error* olderr)
(setvar "OSMODE" os)
(command "undo" "End")
;;; (setvar "CMDECHO" 1)
(princ)
)
 

Code đây em sưu tầm về dung,không hiểu sao mấy hôm trước em dùng bình thường nhưng tự nhiên hôm nay em dùng lại bị lỗi ak

Em chạy từng dòng trong code thì oki nhưng chạy cả  lệnh thì lại bị lỗi ạ

Mong mọi người giải đáp giúp em

Chúc mọi người đầu tuần vui vẻ


  • 0

#2503 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 20 May 2015 - 07:35 AM

Chào các anh chị,

Em mới học Lisp,mong mọi người giúp đỡ nhiều ạ

Em có đoạn Code sau

(defun c:CM (/ *error* cla ent-last iferror k lay olderr os pause r ve vec);;;; tao cloud mark;
(setvar "modemacro" "CREATE CLOUD_MARK")
;;; (setvar "CMDECHO" 0)
(command "undo" "BE")
(defun iferror (msg)
(if (= cla nil)
(setq cla "3"))
(if cla (setvar "CLAYER" cla))
(if os (setvar "OSMODE" os))
(setvar "CMDECHO" 1)
(setq *error* olderr)
(princ)
)
(setq lay (tblsearch "layer" "Cloud mark"))
(if (= lay nil)
(command "_layer" "_n" "Cloud mark" "_c" "6" "Cloud mark" ""))
(setq olderr *error*)
(setq *error* iferror)
(graphscr)
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq cla (getvar "CLAYER"))
(setq r (* (getvar "DIMSCALE") 5))
(setq k T)
(while k
(terpri)
(if (= ve nil) (setq ve "Hinh chu nhat"))
(setq vec (strcat "\nVe hinh chu nhat hay duong line? <" ve ">: "))
(setq vec (getstring vec))
(if (= vec "")
(command "_.RECTANGLE")
(command "_.pline"))
(while (= 1 (getvar "cmdactive")) (command pause))
(setq ent-last (entlast))

(setvar "clayer" "Cloud mark")
(command "_.REVCLOUD" "_A" r r "_Object" ent-last "")
)
(setvar "CLAYER" cla)
(setq *error* olderr)
(setvar "OSMODE" os)
(command "undo" "End")
;;; (setvar "CMDECHO" 1)
(princ)
)
 

Code đây em sưu tầm về dung,không hiểu sao mấy hôm trước em dùng bình thường nhưng tự nhiên hôm nay em dùng lại bị lỗi ak

Em chạy từng dòng trong code thì oki nhưng chạy cả  lệnh thì lại bị lỗi ạ

Mong mọi người giải đáp giúp em

Chúc mọi người đầu tuần vui vẻ

Mọi người giải thích giúp em với

Chỗ đoạn màu đỏ ,không hiểu sao nó không cho pick điểm mà nó sang thực hiện đoạn xanh luôn ạ

Nhưng em chạy từng dòng code lại không bị lỗi trên,khi chạy cả code thì lại bị như vậy


  • 0

#2504 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 23 May 2015 - 03:23 PM

Chào các anh chị,

Em có 1 bài toán  như sau,mong anh chị giúp em code vài dòng hoặc giúp em thuật toán ạ,

Em có 1 danh sach các điểm  là

  • lstpoint (p1 p2...pn ) với n>=3 ,đây là danh sách các toạ độ điểm đã được sắp xếp theo hướng tăng dần của toạ độ x
  • Điều em cần là làm sao so sánh được các khoảng cách của các toạ độ lien tiếp nhau có bằng nhau hay không để đo kích thước ạ.

Nếu khác nhau thì gán toạ độ đó vào list : lst1 (loai ra khỏi tập lstpoint)

Nếu  bằng nhau thì gán tọa độ đó vào list : lst2 (loai ra khỏi tập lstpoint)

  • Mục đích của em  là để đo kích thước các lỗ bolt liên tiếp nhau,nếu nó bằng nhau thì edit đường đo kích thước các bolt liên tiếp là ( (n-1)@ khoangcachbolt) giống như biểu diễn bước thép trong xây dựng vậy ạ ,nếu nó không bằng thì đo kích thước từng cặp sai khác đó ạ

Em giải thích vậy mong mọi người giúp,vì công ty em không cho upload file nên đành phải diễn dãi thành lời suông vậy ạ


  • 0

#2505 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 23 May 2015 - 03:32 PM

Chào các anh chị,

Em có 1 bài toán  như sau,mong anh chị giúp em code vài dòng hoặc giúp em thuật toán ạ,

Em có 1 danh sach các điểm  là

  • lstpoint (p1 p2...pn ) với n>=3 ,đây là danh sách các toạ độ điểm đã được sắp xếp theo hướng tăng dần của toạ độ x
  • Điều em cần là làm sao so sánh được các khoảng cách của các toạ độ lien tiếp nhau có bằng nhau hay không để đo kích thước ạ.

Nếu khác nhau thì gán toạ độ đó vào list : lst1 (loai ra khỏi tập lstpoint)

Nếu  bằng nhau thì gán tọa độ đó vào list : lst2 (loai ra khỏi tập lstpoint)

  • Mục đích của em  là để đo kích thước các lỗ bolt liên tiếp nhau,nếu nó bằng nhau thì edit đường đo kích thước các bolt liên tiếp là ( (n-1)@ khoangcachbolt) giống như biểu diễn bước thép trong xây dựng vậy ạ ,nếu nó không bằng thì đo kích thước từng cặp sai khác đó ạ

Em giải thích vậy mong mọi người giúp,vì công ty em không cho upload file nên đành phải diễn dãi thành lời suông vậy ạ

Chào bạn!

Chỗ dòng màu xanh là mình không hiểu 

"Nếu khác nhau thì gán toạ độ đó vào list : lst1 (loai ra khỏi tập lstpoint)"

Toạ độ đó là toạ độ nào bạn? Khi bạn so sánh kích thước liên tiệp nhau tương ứng với 3 điểm p1, p2, p3

Vậy khác nhau thì gán cả 3 toạ độ p1, p2, p3 vào lst1 sao bạn?


  • 0

#2506 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 23 May 2015 - 03:52 PM

Chào bạn!

Chỗ dòng màu xanh là mình không hiểu 

"Nếu khác nhau thì gán toạ độ đó vào list : lst1 (loai ra khỏi tập lstpoint)"

Toạ độ đó là toạ độ nào bạn? Khi bạn so sánh kích thước liên tiệp nhau tương ứng với 3 điểm p1, p2, p3

Vậy khác nhau thì gán cả 3 toạ độ p1, p2, p3 vào lst1 sao bạn?

Dạ chắc do em trình bày chưa kỹ,ý em muốn gán vào 1 cái list để cần dùng giải quyết đoạn sau ạ (loại ra hay không cũng được )

Do em cũng mới tập tành học lisp nên muốn hỏi cách code để làm các bài toán tương tự sau này

Em trình bày cụ thể như sau ,a Tue_NV xem có cách gì giải quyết được không ạ

Đề: Em có 1 hàng là các điểm (cụ thể là center của bulong) ,em đã sắp xếp theo thứ tự tăng dần theo x hoặc theo y rồi.

Yêu cầu:

  • Vì chưa biết khoảng cách các bolt liên tiếp có bang nhau hay không,nên phải đo kích thước lần lượt từ đầu đến cuối,nếu khoảng cách khác nhau thì đo 1 kích thước qua 2 điểm đó,
  • nếu  bang nhau thì xét tiếp khoảng cách tiếp theo....Cứ tiếp tục như vậy ạ.Bằng nhau thì đo từ điểm đầu đến điểm cuối của các bolt bang nhau này
  • .Nếu khoảng cách tiếp theo khac nhau thì cứ đo kích thước 2 điểm....

  • 0

#2507 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 23 May 2015 - 03:59 PM

 

Toạ độ đó là toạ độ nào bạn? Khi bạn so sánh kích thước liên tiệp nhau tương ứng với 3 điểm p1, p2, p3

Vậy khác nhau thì gán cả 3 toạ độ p1, p2, p3 vào lst1 sao bạn?

Dạ ,ví dụ em có (1 2 3 4 5 ) điểm

đầu tiên lấy 1 2 3 để so sánh khoảng cách (1->2) và (2->3)

  • Nếu khác nhau thì đo kích thước 1 2 hoặc đưa vào list lst1
  • Nều bang nhau thì lưu vao lst2 rồi lấy tiếp 2 3 so sánh với 3 4
  • nêu bang nhau thì đưa vào lst2 nếu khác nhau thì đo kích thước 2 3 4 rồi edit lại( 2@k/cach)
  • Tiếp tục cho đến hết danh sách ạ

  • 0

#2508 snowman.hms

snowman.hms

    biết vẽ ellipse

  • Members
  • PipPip
  • 55 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 23 May 2015 - 05:09 PM

;; Arguments:
;; l   : list points
;; fuz : fuzz factor
;; Return: list of two elements

(defun _group (l fuz / f a l1 l2)

  (defun f (l / x y d rtn)
    (repeat (1- (length l))
      (setq x	(car l)
	    y	(cadr l)
	    l	(cdr l)
	    d	(distance x y)
	    rtn	(cons (list d (list x y)) rtn)
      )
    )
    rtn
  )
  
  (setq l (f l))
  (setq l (vl-sort l (function (lambda (a b) (>= (car a) (car b))))))
  (while l
    (setq a (list (car l))
	  l (cdr l)
    )
    (foreach x l
      (if (equal (caar a) (car x) fuz)
	(setq a	(cons (cons (car x) (append (cdr x) (cdar a))) (cdr a))
	      l	(vl-remove x l)
	)
      )
    )
    (if	(< 1 (length (cdar a)))
      (setq l1 (cons a l1))
      (setq l2 (cons a l2))
    )
  )
  (list (apply 'append l1) (apply 'append l2))
)

Trường hợp của bạn:
(setq lst  (_group lstpoint 1e-3)
      lst1 (car lst)  - cùng khoảng cách
      lst2 (cadr lst)  - khác khoảng cách
)

  • 1

#2509 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 23 May 2015 - 05:42 PM

;; Arguments:
;; l   : list points
;; fuz : fuzz factor
;; Return: list of two elements

(defun _group (l fuz / f a l1 l2)

  (defun f (l / x y d rtn)
    (repeat (1- (length l))
      (setq x	(car l)
	    y	(cadr l)
	    l	(cdr l)
	    d	(distance x y)
	    rtn	(cons (list d (list x y)) rtn)
      )
    )
    rtn
  )
  
  (setq l (f l))
  (setq l (vl-sort l (function (lambda (a b) (>= (car a) (car b))))))
  (while l
    (setq a (list (car l))
	  l (cdr l)
    )
    (foreach x l
      (if (equal (caar a) (car x) fuz)
	(setq a	(cons (cons (car x) (append (cdr x) (cdar a))) (cdr a))
	      l	(vl-remove x l)
	)
      )
    )
    (if	(< 1 (length (cdar a)))
      (setq l1 (cons a l1))
      (setq l2 (cons a l2))
    )
  )
  (list (apply 'append l1) (apply 'append l2))
)

Trường hợp của bạn:
(setq lst  (_group lstpoint 1e-3)
      lst1 (car lst)  - cùng khoảng cách
      lst2 (cadr lst)  - khác khoảng cách
)

Lisp chạy ra bị lỗi : bad argument type: 2D/3D point: nil bạn snowman ạ

Để mình kiểm tra sửa lại xem thử được ko

Cảm ơn bạn nhiều!


  • 0

#2510 snowman.hms

snowman.hms

    biết vẽ ellipse

  • Members
  • PipPip
  • 55 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 23 May 2015 - 06:11 PM

Lisp chạy ra bị lỗi : bad argument type: 2D/3D point: nil bạn snowman ạ

Để mình kiểm tra sửa lại xem thử được ko

Cảm ơn bạn nhiều!

 

bạn gửi lên lstpoint của bạn xem. mình đã test trên máy ok mà!


  • 0

#2511 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 23 May 2015 - 08:28 PM

bạn gửi lên lstpoint của bạn xem. mình đã test trên máy ok mà!

 Đoạn code mình test đây bạn,nó bị lỗi lst2 ak.Bạn xem lại giúp mình với

Kiểu viết của bạn hơi cao so với trình độ mình nên đang cố đọc cho thấm thử mình sửa được ko.hic

 

(setq lstpt (acet-ss-to-list (ssget '((0 . "CIRCLE") (8 . "Bolt"))))
lstpt (vl-sort lstpt '(lambda (e1 e2)
(< (cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2))))))
lstpt (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) lstpt)
)
(setq lst (_group lstpt 1e-3)
lst1 (car lst)
lst2 (cadr lst) ;;cai lst 2 nay nil
)

 

File em update có tất cả các trường hợp,

Mọi người giúp em với ạ

http://www.cadviet.c...392_do_bolt.dwg


  • 0

#2512 snowman.hms

snowman.hms

    biết vẽ ellipse

  • Members
  • PipPip
  • 55 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 23 May 2015 - 09:09 PM

Lstpoint cua ban ko phai list point!
Code cua ban sai!
Dxf 0 la etype, dxf 10 la insertionpoint nhe :)
  • 0

#2513 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 23 May 2015 - 09:46 PM

Lstpoint cua ban ko phai list point!
Code cua ban sai!
Dxf 0 la etype, dxf 10 la insertionpoint nhe :)

 

Listpoint là đoạn này mà bạn

(mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) lstpt)

mã dxf 10 là center của cái circle mà^^


  • 0

#2514 snowman.hms

snowman.hms

    biết vẽ ellipse

  • Members
  • PipPip
  • 55 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 23 May 2015 - 10:30 PM

Xin lỗi bạn vì vừa rồi  mình ko có máy để test!

Mình đã test trên file của bạn hoàn toàn ok!

mình giải thíc thêm:

- lst1 là list bao gồm các "cặp" có cùng "khoảng cách"

 

- lst2 là list bao gồm các "cặp" có  "khoảng cách" là duy nhất

 

ví dụ

lstpt:

(
    (2784.0 527.0 0.0)
    (2878.5 527.0 0.0)
    (2987.5 527.0 0.0)
    (3082.0 527.0 0.0)
    (3270.5 527.0 0.0)
    (3365.0 527.0 0.0)
    (3492.5 527.0 0.0)
    (3587.0 527.0 0.0)
)
 

--->lst:

 (

    (
        (
            94.5
            (
                (3492.5 527.0 0.0)
                (3587.0 527.0 0.0)
            )
            (
                (3270.5 527.0 0.0)
                (3365.0 527.0 0.0)
            )
            (
                (2987.5 527.0 0.0)
                (3082.0 527.0 0.0)
            )
            (
                (2784.0 527.0 0.0)
                (2878.5 527.0 0.0)
            )
        )
    );---->llst1
    (
        (
            109.0
            (
                (2878.5 527.0 0.0)
                (2987.5 527.0 0.0)
            )
        )
        (
            127.5
            (
                (3365.0 527.0 0.0)
                (3492.5 527.0 0.0)
            )
        )
        (
            188.5
            (
                (3082.0 527.0 0.0)
                (3270.5 527.0 0.0)
            )
        )
    );---->llst2
);---->lst

  • 1

#2515 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 24 May 2015 - 07:51 AM

 Cảm ơn snowman.hms nhiều,nhưng còn trường hợp 1  trong file mình gởi ở trên  có kcach (70,2@80,70,2@80) thì có cách nào lấy được ko ạ

Em đang sửa của anh cho phù hợp với bài toán cụ thể của em,

Cách dùng hàm cons để tạo danh sách hay thật,lâu nay toàn dùng append không à,


  • 0

#2516 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 24 May 2015 - 08:58 AM

Tặng NS TCS cái này. Thêm mắm muối là tùy bạn, tôi chỉ làm đến phần cơ bản thôi. Đã test 5 trường hợp trên bản vẽ của bạn.

(defun C:HA(/ lst)
 (princ "\nChon cac bulon...")
 (setq lst (acet-ss-to-list (ssget '((0 . "CIRCLE") (8 . "Bolt"))))
       lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))
       lst (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) lst))
 (setq lst (mapcar 'distance lst (cdr lst)))
 (#List:Seplst lst))
(defun #List:Seplst (lst / i it rt tLst)
 (setq i -1)
 (while (setq it (nth (setq i (1+ i)) lst))
  (if (eq (last tLst) it)
   (setq tLst (append tLst (list it)))
   (setq rt (append rt (list tLst)) tLst (list it))))
 (cdr (append rt (list tLst))))

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


#2517 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 24 May 2015 - 10:54 AM

Cảm ơn a Hạ,

Sẵn tiện cho em hỏi lisp em post ở bài viết #2052 và #2053 bị lỗi gì mà khi chạy cả lisp nó bị lỗi còn chạy từng đoạn code thì không bị ạ

http://www.cadviet.c...oding/?p=348969

Em cảm ơn


  • 0

#2518 snowman.hms

snowman.hms

    biết vẽ ellipse

  • Members
  • PipPip
  • 55 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 24 May 2015 - 10:58 AM

...sửa ... cho phù hợp với bài toán cụ thể của em,

 

Trả về theo thứ tự trái-> phải và theo định dạng (..(duplicate distance (startpoint endpoint))..) 

(defun C:test ( / l p s spc )
  (setq
    spc	(vlax-get (vla-get-activedocument (vlax-get-acad-object))
		  (if (eq (getvar 'CVPORT) 1)
		    'Paperspace
		    'Modelspace
		  )
	)
  )
  (if
    (and (princ "\nChon cac bulon...")
	 (setq l (acet-ss-to-list (ssget '((0 . "CIRCLE") (8 . "Bolt")))))
	 (setq l (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) l))
	 (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))
    )
     (progn
       (setq l (f l))
       (setq p (getpoint "\nSpecify point for Dimensions..."))
       (foreach	x l
	 (if (< 1 (car x))
	   (setq s (strcat (itoa (car x)) "@" (rtos (cadr x) 2 2)))
	   (setq s (rtos (cadr x) 2 2))
	 )
	 (_dimaligned spc (car (last x)) (cadr (last x)) p s)
       )
     )
  )
  (princ)
)
(defun f (l / a b d tm i l1)
  (setq	l (mapcar '(lambda (a b) (list (distance a b) (list a b))) l (cdr l)))
  (while l
    (setq a  (car l)
	  d  (car a)
	  tm (list (caadr a))
	  l  (cdr l)
	  i  1
    )
    (while (= (car a) (caar l))
      (setq b  (car l)
	    i  (1+ i)
	    tm (cons (cadadr b) tm)
	    l  (cdr l)
      )
    )
    (if	(< 1 i)
      (setq l1 (cons (list i d (list (last tm) (car tm))) l1))
      (setq l1 (cons (vl-list* 1 a) l1))
    )
  )
  (reverse l1)
)
(defun _dimaligned (spc p1 p2 pt str)
  (vlax-put (vlax-invoke spc 'adddimaligned p1 p2 pt) 'textoverride str)
)

Bài viết đã được chỉnh sửa nội dung bởi snowman.hms: 24 May 2015 - 11:47 AM

  • 0

#2519 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 24 May 2015 - 11:25 AM

Cảm ơn a Hạ,

Sẵn tiện cho em hỏi lisp em post ở bài viết #2052 và #2053 bị lỗi gì mà khi chạy cả lisp nó bị lỗi còn chạy từng đoạn code thì không bị ạ

http://www.cadviet.c...oding/?p=348969

Em cảm ơn

Thay:

(command "_.RECTANGLE")

Bằng:

(command "_.RECTANGLE" (setq p1 (getpoint "\nP1: ")) (getcorner p1 "\nP2: "))


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


#2520 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 24 May 2015 - 04:58 PM

;; free lisp from cadviet.com
;;; this lisp was downloaded from
;;; http://www.cadviet.c...coding/page-126
(defun C:test (/ l p s spc)
 (setq
  spc (vlax-get (vla-get-activedocument (vlax-get-acad-object))
         (if (eq (getvar 'CVPORT) 1)
          'Paperspace
          'Modelspace
         )
    )
 );;;Đoạn này có tác dung gì ạ???
 (if
  (and
   (princ "\nChon cac bulon...")
   (setq l (acet-ss-to-list (ssget '((0 . "CIRCLE") (8 . "Bolt")))))
   (setq l (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) l))
   (setq l (vl-sort l '(lambda (a b ) (< (car a) (car b ))))
      p1 (car l)
      p2 (car (reverse l)))
  );;Dòng này em hiểu ^
   (progn
    (setq l (f l))
    (setq p (if (< (setq goc (angle p1 p2)) (/ pi 2))
          (polar p2 (+ goc (/ pi 2))     (* 20 (getvar "dimscale")))
          (polar p1  (- goc (* 3 (/ pi 2))) (* 20 (getvar "dimscale")))));;Dòng này em thêm để tự set điểm đặt dimension
    (foreach x l
     (if (< 1 (car x))
      (progn
        (setq s (strcat (itoa (car x)) "@" (rtos (cadr x) 2 0)))
       (_dimaligned spc (car (last x)) (cadr (last x)) p s)
      )
       (progn
       (setq s (rtos (cadr x) 2 0))
       (_dimaligned spc (car (last x)) (cadr (last x)) p "<>");;Dấu "<>" em tự thêm vào để trở về kích thước that nếu số luợng =1,nhưng còn cách nào khác để dim kích thước thật chỗ này nếu ko dung command ko a??

      )
     )
    )
   )
 )
 (princ)
)

(defun f (l / a b d tm i l1 x)
 (setq l (mapcar '(lambda (a b ) (list (distance a b ) (list a b )))
         l
         (cdr l)
     )
 );;Tạo list gồm ( dis (tọa độ))

 (while l
  (setq a  (car l);;lấy phần tử đầu của l
     d  (car a);;lấy phần tử đầu của a tức là dis 

    tm (list (caadr a));;;Cái này lấy phần tử thứ 2 của thằng a,nhưng em chưa hiểu cái caadr là gộp của car với gì ,em chưa hiểu nguyên tắc ghép-->anh giải thích giúp em ...

     l  (cdr l);;lấy phần tử từ thứ 2 trở đi của l
     i  1
  )
  (while (= (car a) (caar l))
   (setq b  (car l)
      i  (1+ i)
      tm (cons (cadadr b ) tm)
      l  (cdr l)
   )
  );;đoạn while ni để tìm số phần tử going nhau đúng ko ạ,nhưng em chưa hiểu cách thức thực hiện...
  (if (< 1 i)
   (setq l1 (cons (list i d (list (last tm) (car tm))) l1))
   (setq l1 (cons (vl-list* 1 a) l1));;;cái vl-list này có tác dung gì ạ???

  )
 )
 (reverse l1)
)
(defun _dimaligned (spc p1 p2 pt str)
 (vlax-put (vlax-invoke spc 'adddimaligned p1 p2 pt) 'textoverride str);;;vl-invoke có tác dung gì hả a??
 (vlax-put-property (vlax-ename->vla-object (entlast)) 'TextInside -1);;cái này em tự thêm vào để trả về dimension luôn giữa 2 đường going kích thước
)

 

 Cảm ơn snowman.hms & a Hạ nhiều

Em ngồi từ sáng đến chừ nghiên cứu gộp  2 đoạn lisp của 2 anh mà dễ tẩu hỏa nhập ma quá^^

Đang gộp của a Hà để thêm tọa độ tương ứng nữa mà a đã giúp em luôn rồi^^

Em tự tìm hiều code của anh ,nhưng có một số chỗ không hiểu ,và cái thuật toán a làm như thế nào ạ

Mong các anh chị giải thích giúp em với,

Em cảm ơn nhiều!


  • 0