Chuyển đến nội dung
Diễn đàn CADViet
Jin Yong

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

Các bài được khuyến nghị

(defun tinhdientichdoituong( ename)

  (vla-get-area (vlax-ename->vla-object ename))

)

Code trên mình trích trên Cadviet, mình chỉ có thể kiểm tra ename có phải là POLYLINE, HATCH ... thôi, nhưng mình nghĩ chỉ biết như vậy chưa đủ. Thật tình đến giờ này mình chưa nắm đc mấu chốt của vl nên hầu như mình bí,

1. Không phải đối tượng nào trong Cad cũng có thể có tham số diện tích: ví dụ: LINE, Text,DIM,...

2. Không phải tham số diện tích nào của đối tượng Cad cũng có thể dùng hàm vla-get-are ... Ví dụ tham số iện tích của Circle

3. Hình như câu hỏi của bạn là câu hỏi tu từ. Hì hì.

để dễ dang trong cách tiếp cận, bạn hãy vào Visual lisp (qua lệnh VLIDE) sau đó gọi lệnh

(if (setq dt (entsel "\nChoi doi tuong can xem thong tin"))

(setq obj (vlax-ename->vla-object (car dt))))

 

 

sau đó bôi den obj và nhấn tổ hợp phím CTRL +W để (show Watch - xem đối tượng) đối tượng nhấp đôi vào chữ dt trong cửa sổ hiện lên và tìm hiểu, chúc thành công

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 Cái này dùng cũng được.

 

(if (vlax-property-available-p (setq obj (vlax-ename->vla-object ename)) 'area )
(vla-get-area obj) nil)
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cám ơn các bạn đã chỉ dẫn. Tại vì cái code đó mình để trong trong trình với nhiều thứ khác, nếu lỡ găp trường hợp kg tính được nó báo lỗi rồi ngưng luôn thì CT bị gãy (ví dụ gặp Hatch not associative), do đó mình muốn kiểm tra nếu kg tính dc thi thôi xử lý kiểu khác.

 

Đã kiểm tra code của bác Ha lúc nào cũng trả về nil còn của bác Tot77 thì lỗi khi gặp Hatch not associative

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Sửa 1 ít code của Doan Van Ha

(if
(vl-catch-all-error-p (setq area (vl-catch-all-apply 'vla-get-Area (list (vlax-ename->vla-object (car (entsel)))))))
nil
area)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Sửa 1 ít code của Doan Van Ha

(if

(vl-catch-all-error-p (setq area (vl-catch-all-apply 'vla-get-Area (list (vlax-ename->vla-object (car (entsel)))))))

nil

area)

Code này cũng lỗi khi gặp Hatch not associative bác ơi

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Code này cũng lỗi khi gặp Hatch not associative bác ơi

Với code trên, lỗi chỉ xảy ra khi user pick trượt đối tượng.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Với code trên, lỗi chỉ xảy ra khi user pick trượt đối tượng.

Xin lỗi các bạn, mình nhầm. Đúng như gia_bach nói. Cám ơn bác

Nhưng code trên chạy khá lâu các bác ạ. Mình chọn 1 đối tượng khá là lớn nhiều point thì sau hơn 1 phút mới có kq. Có code nào chạy nhanh hơn chỉ cần trả về T hay nil kg cần tính kg các bác nhỉ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

      Em có một bài toán nho nhỏ mong các bác giúp đỡ.

     Bài toán của em như sau: Em có một 2Dpolyline là 1 đường thẳng (chỉ có 2 đỉnh) và có nhiều text có giá trị là XY (XY là giá trị bất kỳ mà mình đã biết từ trước). Bây giờ e muốn chọn 1 text có giá trị XY kia  gần nhất với điểm đầu pline đã có. Có thể lấy khoảng cách từ điểm chèn text tới điểm đầu pline để so sánh khoảng cách cũng được.

     Em cũng thấy có nhiều lisp có đề cập tới thuật toán dạng này rồi nhưng trình còn non nên chưa tách được đoạn code đó.

    Cảm ơn các bác đã quan tâm.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Hỏi về code xác định điẻm nằm cách polyline một khoảng L và cách polyine 1 khoảng là a

Nghĩa là xác định điểm B nằm trên phương tiếp tuyến của Polyline tại điểm A và B cách A 1 khoảng là a

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tue_NV có 1 câu hỏi nhìn nó có vẻ đơn giản nhưng chưa biết cách thức xử lý nó

Làm thế nào để tách kí tự "\" ra khỏi chuỗi "\037" -> Kết quả là  "037"                                                                                              Mình sử dụng hàm substr để trích chuỗi để xét thì thấy :                                                                                               Command: (substr "\037" 1 1) -> "\037". Chỉ lấy 1 ký tự mà nó ra hết                                                                                                                 Mong các bác chỉ giáo giúp! Thanks

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Chẳng hạn như vầy chăng:

(if (= (ascii "\037") 31) "037")

 

Chuỗi "kết quả"  trong hàm if "037" là bác tự đánh vào. Nếu thay vì "037" mà là số khác thì đánh vào biết bao nhiêu cho xuể

Vấn đề ở đây là từ chuỗi gốc lấy ra bác ạ

 

Kết quả mong muốn là từ chuỗi gốc "\037" -> tách ra chuỗi "037"

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Dùng hàm ascii, đổi kết quả ra octal, thêm 0 vào trước. Code hàm base lấy từ help

(defun BASE ( bas int / ret yyy zot )
(defun zot ( i1 i2 / xxx )
(if (> (setq xxx (rem i2 i1)) 9)
(chr (+ 55 xxx))
(itoa xxx)
)     
)
(setq ret (zot bas int) yyy (/ int bas))
(while (>= yyy bas)
(setq ret (strcat (zot bas yyy) ret))
(setq yyy (/ yyy bas))
)
(strcat (zot bas yyy) ret)
)
(base 8 (ascii "\037") )
=> "37"
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Dùng hàm ascii, đổi kết quả ra octal, thêm 0 vào trước. Code hàm base lấy từ help

(defun BASE ( bas int / ret yyy zot )
(defun zot ( i1 i2 / xxx )
(if (> (setq xxx (rem i2 i1)) 9)
(chr (+ 55 xxx))
(itoa xxx)
)     
)
(setq ret (zot bas int) yyy (/ int bas))
(while (>= yyy bas)
(setq ret (strcat (zot bas yyy) ret))
(setq yyy (/ yyy bas))
)
(strcat (zot bas yyy) ret)
)
(base 8 (ascii "\037") )
=> "37"

 

Cảm ơn bác nhiều!

Xin lỗi vì có lẽ là Tue_NV chưa nói rõ là nó có rất nhiều Trường hợp.

"Và mình chỉ muốn tách ký tự "\" ra khỏi chuỗi "\037"  và "037" chỉ là 1 trong các trường hợp đó mà thôi

 

Ví dụ : (base 8 (ascii "\038") -> "03" (kết quả mong muốn là "038")

hoặc (base 8 (ascii "\0a8") -> "00" (kêt quả mong muốn "0a8")

......

......

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Trong help Lisp xem \nnn là "Character whose octal code is nnn"

Vì vậy sau \0 phải là số octal hợp lệ (0 => 7)

các số 38, 39, a8 ... không phải là số octal nên lisp không lưu

VD :

(strlen "\0a8") => 0,

riêng chuỗi "\038" vì 3 là số octal hợp lệ, 8 không phải nên lisp lưu thành "\03" và "8"

(strlen "\038") => 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Trong help Lisp xem \nnn là "Character whose octal code is nnn"

Vì vậy sau \0 phải là số octal hợp lệ (0 => 7)

các số 38, 39, a8 ... không phải là số octal nên lisp không lưu

VD :

(strlen "\0a8") => 0,

riêng chuỗi "\038" vì 3 là số octal hợp lệ, 8 không phải nên lisp lưu thành "\03" và "8"

(strlen "\038") => 2

 

Cảm ơn bác!

Như vậy thì Lisp trên cũng không đúng cho mọi Trường hợp rồi.

Tue_NV cũng mong muốn có phương án giải quyết đúng cho mọi trường hợp

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Sau \0 phải là số octal hợp lệ (1 -->7), nếu không sẽ coi như chuỗi :  (strcat "\0a8") = (strcat "\088") = (strcat "\0a9") = … = ""

Lúc đó hàm sau kết hợp với hàm ndtnv chắc cũng tạm ổn :) :

(defun replace-str (str / c1)
(if (= 0 (strlen str)) str (progn
(setq c1 (chr (car (vl-string->list str))) new-str (base 8 (ascii c1))) 
(vl-string-subst new-str c1 str) )))

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Sau \0 phải là số octal hợp lệ (1 -->7), nếu không sẽ coi như chuỗi :  (strcat "\0a8") = (strcat "\088") = (strcat "\0a9") = … = ""

Lúc đó hàm sau kết hợp với hàm ndtnv chắc cũng tạm ổn :) :

(defun replace-str (str / c1)
(if (= 0 (strlen str)) str (progn
(setq c1 (chr (car (vl-string->list str))) new-str (base 8 (ascii c1))) 
(vl-string-subst new-str c1 str) )))

 

Cảm ơn bác. Mặc dù chưa thật trọn vẹn nhưng chắc là không còn cách nào khác

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Mọi người cho e hỏi làm sao để viết được tiếng việt có dấu tại các dòng nhắc với như ví dụ dưới đây với.

vd:  ví dụ này em lấy từ code của Nhoclangbat.

(prompt "Ch\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+00FAn \U+1EA9n:")

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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ẻ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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 ạ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×