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

[Doan Van Ha 3.201]

21 giờ trước, snowman.hms đã nói:

 

3dt-3d text.lsp

Mình đã nghi nghi có hàm Trans nhưng không làm nổi. Bạn thường giải những bài toán khó giúp mình. Cám ơn rất nhiều.
P/S: mình phải bổ sung hàm TRP vì chép thiếu.

[Doan Van Ha 3.201]

Tôi chưa dùng field nên không rành, nhưng hôm nay đụng thứ muốn dùng field. Vậy xin hỏi các anh chị tí:

Liệu có thể dùng field để liên kết 1 value của tag A trong block_att X sang 1 value của tag B trong block_att Y không? 

(Nghĩa là khi thay đổi value của tag A trong block_att X thì value của tag B trong block_att Y cũng thay đổi theo)

Cám ơn!

[dinhvantrang 151]

51 phút trước, Doan Van Ha đã nói:

Tôi chưa dùng field nên không rành, nhưng hôm nay đụng thứ muốn dùng field. Vậy xin hỏi các anh chị tí:

Liệu có thể dùng field để liên kết 1 value của tag A trong block_att X sang 1 value của tag B trong block_att Y không? 

(Nghĩa là khi thay đổi value của tag A trong block_att X thì value của tag B trong block_att Y cũng thay đổi theo)

Cám ơn!

 

Được nhé bác @Doan Van Ha

[Doan Van Ha 3.201]

Bạn giúp mình 1 ví dụ cụ thể như file cad đính kèm để học tập.

Cám ơn!

Link_Field.dwg

[Doan Van Ha 3.201]

Vui lòng gởi trực tiếp lên CV và lưu 2007 nhé!

[dinhvantrang 151]

11 phút trước, Doan Van Ha đã nói:

Vui lòng gởi trực tiếp lên CV và lưu 2007 nhé!

 

Gửi lại bác file 2007

https://www.dropbox.com/s/2nr694u99fead5w/Link_Field.dwg?dl=0

 

Không hiểu sao, bản vẽ có 73Kb mà không load lên được, toàn báo quá size.

 

 

[Doan Van Ha 3.201]

Thanks! Chú nói cách làm luôn cái, mày mò cũng ra, nhưng nay ít mò lắm rồi! He he he.

Hỏi thêm tí luôn: có thể tạo 1 song ánh giữa 2 tag đó không (nghĩa là khi thay bên này thì bên kia update, thay bên kia thì bên này update)?

[quocmanh04tt 635]

Mời bác tham khảo video: 

 

[duy782006 1.551]

Thấy bác Quocmanh chỉ mình cũng mò thử phát kết quả nếu trong 1 block có 3 giá trị field thì phải REGEN hoặc updatefield 3 lần thì cũng oải quá. Do mình hông biết cách hay thiệt nó phải dậy dậy các bác.

[Doan Van Ha 3.201]

Thay hết tất cả Att rồi regen 1 lần là update hết tất cả

[duy782006 1.551]

File của Duy nó đây. Bác xem Duy phải regen 3 lần.

tkt.dwg

[Doan Van Ha 3.201]

Làm sao lấy linetype đúng của 1 đường?

VD 1 Line có linetype là byblock, thực chất là đường continuous, làm sao lấy được continuous chứ không phải là lấy byblock?

Có vẻ như câu hỏi này dễ mà sao tôi quên mất tiêu nên nhờ giúp.

[duy782006 1.551]

Cái này đang là trường hợp bylayer bác sửa lại cho byblock.

(Defun duy:d_ltype (/ kqltype dchon)
(princ "\nChon doi tuong chua ltype")
(setq dchon (entsel))
(while
(null dchon)
(princ "\nChon doi tuong khong thanh cong. Chon doi tuong chua ltype!")
(setq dchon (entsel))
)
(setq kqltype (cdr (assoc 6 (entget (car dchon)))))
  (Cond
  ((= kqltype nill) 
  (setq kqltype (strcat "BYLAYER <" (cdr (assoc 6 (entget (TBLOBJNAME "LAYER" (cdr (assoc 8 (entget (car dchon)))))))) ">"))
  )
  )
kqltype)

 

[Doan Van Ha 3.201]

Tự nhiên quên luôn hàm TBLOBJNAME

Thank nhiều!

[lp_hai 225]

Chào các bác,

Hiện tại mình đang bí chỗ code openfile từ 1 đường dẫn đã có là 1 string: VD "d:\\xzy....\\Drawing.dwg"

Các bác chỉ giúp mình 1 code giải quyết nó với à, mình cũng đã thử với SDI=1 lệnh fileopen nhưng nó không ổn vì phải tắt file hiện hành....

Xin cảm ơn các bác

[Doan Van Ha 3.201]

Tham khảo vài cách:

(command "shell" "D:/xxx/run.exe")
(command "ai_editcustfile" "D:/xxx/run.exe")
(startapp "D:/xxx/run.exe")

(defun MyOpen (FileName_and_Path ReadOnly / )
 (vla-Open (vla-get-Documents (vlax-get-Acad-Object)) FileName_and_Path (if ReadOnly :vlax-true :vlax-false)))
 

[lp_hai 225]

38 phút trước, Doan Van Ha đã nói:

Tham khảo vài cách:

(command "shell" "D:/xxx/run.exe")
(command "ai_editcustfile" "D:/xxx/run.exe")
(startapp "D:/xxx/run.exe")

(defun MyOpen (FileName_and_Path ReadOnly / )
 (vla-Open (vla-get-Documents (vlax-get-Acad-Object)) FileName_and_Path (if ReadOnly :vlax-true :vlax-false)))
 

Thanks bác nhiều nhé!

[thanhduan2407 272]

Chào các bác!

Em đang mò mẫm cách thức để tạo Boundary mà nó vẫn không triệt để.

Cụ thể là em có các lưới ô vuông (dạng Polyline) riêng biệt và 1 đường Polyline khép kín khác Layer với lưới ô vuông.

Em muốn tạo Boundary phần giao giữa từng lưới ô vuông với đường Polyline (Boundary này phải nằm phía trong của Polyline như hình đi kèm).

Nhờ các bác gợi ý cho em thuật toán để làm được điều đó được không? Cảm ơn các bác nhiều.

P/s: Hatch chỉ là mô tả các Boundary riêng biệt chứ không cần tạo Hatch.

Link file:

http://www.mediafire.com/file/9t4w1t8rksbwuob/TAO+BOUNDARY.dwg

[gia_bach 1.551]

16 giờ trước, thanhduan2407 đã nói:

Chào các bác!

Em đang mò mẫm cách thức để tạo Boundary mà nó vẫn không triệt để.

Cụ thể là em có các lưới ô vuông (dạng Polyline) riêng biệt và 1 đường Polyline khép kín khác Layer với lưới ô vuông.

Em muốn tạo Boundary phần giao giữa từng lưới ô vuông với đường Polyline (Boundary này phải nằm phía trong của Polyline như hình đi kèm).

Nhờ các bác gợi ý cho em thuật toán để làm được điều đó được không? Cảm ơn các bác nhiều.

P/s: Hatch chỉ là mô tả các Boundary riêng biệt chứ không cần tạo Hatch.

Link file:

http://www.mediafire.com/file/9t4w1t8rksbwuob/TAO+BOUNDARY.dwg

Vấn đề của bạn có thể đưa về dạng cơ bản là tìm boundary của 2 polyline.

Cách 1:

 - nổ (explode) polyline màu trắng thành các đối tượng cơ bản (line, arc)

 - lần lượt tìm phần giao (bên trong) của các đối tượng cơ bản ở trên với polyline ô lưới

 - nối các phần giao ở trên thành các boundary (nếu tồn tại)

Cách 2: (sử dụng command)

 - convert các polyline thành region, lệnh REGION

 - sử dụng lệnh INTERSECT để tìm giao của 2 region.

 

Cách 2 có vẻ đơn giản nhưng tốc độ không bằng cách 1.

[thanhduan2407 272]

9 phút trước, gia_bach đã nói:

Vấn đề của bạn có thể đưa về dạng cơ bản là tìm boundary của 2 polyline.

Cách 1:

 - nổ (explode) polyline màu trắng thành các đối tượng cơ bản (line, arc)

 - lần lượt tìm phần giao (bên trong) của các đối tượng cơ bản ở trên với polyline ô lưới

 - nối các phần giao ở trên thành các boundary (nếu tồn tại)

Cách 2: (sử dụng command)

 - convert các polyline thành region, lệnh REGION

 - sử dụng lệnh INTERSECT để tìm giao của 2 region.

 

Cách 2 có vẻ đơn giản nhưng tốc độ không bằng cách 1.

Em có sưu tầm được lisp của anh Lee-Mac và tìm cách loại từ những Polyline ngoài nhưng sợ loại không triệt để.

Như anh nói thì cách 1 thì nhanh hơn, em sẽ thử.

;; Batch BPoly  -  Lee Mac
;; Generates polylines for every region formed by a selection of lines & polylines
;; Restricted to LWPolylines with linear segments only.
;; Region generation based on a method by Stefan M.
;;;;(MAKEBOUNDARY_MULTI (SSGET))
(defun MAKEBOUNDARY_MULTI ( sel / *error* big ent enx idx int lst pt1 pt2 rtn  spc tmp tot val var vtx )

    (defun *error* ( msg )
        (foreach obj rtn
            (if (and (vlax-write-enabled-p obj) (not (vlax-erased-p obj)))
                (vla-delete obj)
            )
        )
        (mapcar 'setvar var val)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (LM:startundo (LM:acdoc))
    (cond
        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
            (princ "\nCurrent layer locked.")
        )
        (   sel
            (setq spc
                (vlax-get-property (LM:acdoc)
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (repeat (setq idx (sslength sel))
                (if (= "LINE" (cdr (assoc 0 (setq enx (entget (ssname sel (setq idx (1- idx))))))))
                    (setq lst (cons (list (cdr (assoc 10 enx)) (cdr (assoc 11 enx))) lst))
                    (setq vtx (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))
                          vtx (mapcar 'list vtx (if (= 1 (logand 1 (cdr (assoc 70 enx)))) (cons (last vtx) vtx) (cdr vtx)))
                          lst (append vtx lst)
                    )
                )
            )
            (foreach pl1 lst
                (setq pt1 (car  pl1)
                      pt2 (cadr pl1)
                )
                (foreach pl2 lst
                    (if
                        (and
                            (not (equal pl1 pl2 1e-8))
                            (setq int (inters pt1 pt2 (car pl2) (cadr pl2)))
                            (not (vl-member-if '(lambda ( pnt ) (equal pnt int 1e-8)) pl1))
                        )
                        (setq pl1 (cons int pl1))
                    )
                )
                (setq rtn
                    (append
                        (mapcar
                            (function
                                (lambda ( a b )
                                    (vla-addline spc
                                        (vlax-3D-point a)
                                        (vlax-3D-point b)
                                    )
                                )
                            )
                            (setq pl1
                                (vl-sort pl1
                                    (function
                                        (lambda ( a b )
                                            (< (distance pt1 a) (distance pt1 b))
                                        )
                                    )
                                )
                            )
                            (cdr pl1)
                        )
                        rtn
                    )
                )
            )
            (setq var '(cmdecho peditaccept)
                  val  (mapcar 'getvar var)
                  tot  0.0
            )
            (mapcar 'setvar var '(0 1))
            (foreach reg (vlax-invoke spc 'addregion rtn)
                (setq ent (entlast))
                (command "_.pedit" "_m")
                (apply 'command (mapcar 'vlax-vla-object->ename (vlax-invoke reg 'explode)))
                (command "" "_j" "" "")
                (if
                    (and
                        (not (eq ent (setq ent (entlast))))
                        (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
                    )
                    (progn
                        (setq tmp (vlax-curve-getarea ent)
                              tot (+ tot tmp)
                        )
                        (if (< (car big) tmp)
                            (setq big (list tmp ent))
                        )
                    )
                )
                (vla-delete reg)
            )
            (if (equal (car big) (/ tot 2.0) 1e-3) ;; Gian Paolo Cattaneo
                (entdel (cadr big))
            )
            (foreach obj rtn (vla-delete obj))
            (mapcar 'setvar var val)
        )
    )
    (LM:endundo (LM:acdoc))
    (princ)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
(vl-load-com) (princ)

 

[Doan Van Ha 3.201]

Bài toán này khá khó. Khó nhất là khi hình A giao hình B có thể tạo ra n hình C, D, E,.... Trong VD có trường hợp tạo ra 2 hình (ô vuông ở giữa).

Các giải pháp đưa  ra ở trên chưa ổn. Rảnh, sẽ đốt ít nơron xem sao.

 

[thanhduan2407 272]

11 phút trước, Doan Van Ha đã nói:

Bài toán này khá khó. Khó nhất là khi hình A giao hình B có thể tạo ra n hình C, D, E,.... Trong VD có trường hợp tạo ra 2 hình (ô vuông ở giữa).

Các giải pháp đưa  ra ở trên chưa ổn. Rảnh, sẽ đốt ít nơron xem sao.

 

Dạ. Những trường hợp hình nằm trong nhau thì cháu loại được rồi ạ. Chỉ những ô vuông giao với Polyline thôi bác ạ!

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

 

[Doan Van Ha 3.201]

4 phút trước, thanhduan2407 đã nói:

Dạ. Những trường hợp hình nằm trong nhau thì cháu loại được rồi ạ. Chỉ những ô vuông giao với Polyline thôi bác ạ!

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

 

Không phải ý đó. Mà ý là: 1hình vuông hồng giao với pline trắng có thể tạo thành 2 hình hoặc nhiều hơn (màu vàng + xanh lá cây). Đây là vấn đề khó.

[Danh Cong 422]

Một bài toán khó nhằn:

Em thử trình bày ý tưởng của mình. Các bác tham khảo rồi cho nhận xét nhé  !!!

Phương pháp giải: Xét trong đoạn chạy của từng ô vuông:

+ B1: Xét 1 ô vuông, với điểm chạy là điểm góc trái, bên dưới của ô vuông. Hướng chạy là ngược chiều kim đồng hồ.

+ B2: Xuất phát từ "1", Tìm điểm giao của ô vuông với  "Hình Gốc".

+ B3: Khi phát hiện ra điểm giao: Lần đầu tại vị trí "3". Tại vị trí này phải kiểm tra vài thứ để xác định hướng chạy tiếp theo như sau: Coi hướng chạy của Polyline ở vùng này là ngược chiều kim đồng hồ: 

                     + TH1: Tại điểm giao: Nếu chạy theo Polyline , điểm tiếp theo nằm ngoài hình vuông hoặc "ngược" chiều với chiều chạy Polyline, : ---> Loại , Sau đó                                               hướng chạy để vẽ bodary lại theo Hình vuông.

                     + TH2: Tại điểm giao : Nếu chạy theo Polyline, điểm tiếp theo nằm trong hình vuông và "cùng"  chiều với chiều chạy Polyline: ---> Ok , Sau đó hướng chạy để vẽ bodary theo Polyline:

                     Giải quyết tại vị trí 3: Hướng chạy theo Polyline sẽ ra vị trí "10", là cùng chiều kim đồng hồ ( Tức là ngược hướng với hướng chạy của Polyline). Cho nên bị loại, ta tiếp tục chạy sang vị trí số 4.

                    + Giải quyết tại vị trí 5: Hướng chạy theo Polyline ra vị trí số 6. Cùng chiều với Polyline, OK. ---> Chạy theo Polyline theo ra số 6: , rồi sang số 7

Tuy nhiên: Đề phòng trong đoạn : 5-7 Có thêm 1 vùng Hatch nào nữa: Thì lại phải kiểm tra xem đoạn 5-7 Có giao với Polyline hay không. ( Tức là trong ô vuông, số vùng hach có thể nhiều hơn 1)

B4: Tiếp tục chạy: nếu điểm giao cuối cùng trùng với điểm đầu "số 3 "  thì kết thúc. 

 

[thanhduan2407 272]

1 giờ} trướ}c, thanhduan2407 đã nói:

Em có sưu tầm được lisp của anh Lee-Mac và tìm cách loại từ những Polyline ngoài nhưng sợ loại không triệt để.

Như anh nói thì cách 1 thì nhanh hơn, em sẽ thử.

;; Batch BPoly  -  Lee Mac
;; Generates polylines for every region formed by a selection of lines & polylines
;; Restricted to LWPolylines with linear segments only.
;; Region generation based on a method by Stefan M.
;;;;(MAKEBOUNDARY_MULTI (SSGET))
(defun MAKEBOUNDARY_MULTI ( sel / *error* big ent enx idx int lst pt1 pt2 rtn  spc tmp tot val var vtx )

    (defun *error* ( msg )
        (foreach obj rtn
            (if (and (vlax-write-enabled-p obj) (not (vlax-erased-p obj)))
                (vla-delete obj)
            )
        )
        (mapcar 'setvar var val)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (LM:startundo (LM:acdoc))
    (cond
        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
            (princ "\nCurrent layer locked.")
        )
        (   sel
            (setq spc
                (vlax-get-property (LM:acdoc)
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (repeat (setq idx (sslength sel))
                (if (= "LINE" (cdr (assoc 0 (setq enx (entget (ssname sel (setq idx (1- idx))))))))
                    (setq lst (cons (list (cdr (assoc 10 enx)) (cdr (assoc 11 enx))) lst))
                    (setq vtx (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))
                          vtx (mapcar 'list vtx (if (= 1 (logand 1 (cdr (assoc 70 enx)))) (cons (last vtx) vtx) (cdr vtx)))
                          lst (append vtx lst)
                    )
                )
            )
            (foreach pl1 lst
                (setq pt1 (car  pl1)
                      pt2 (cadr pl1)
                )
                (foreach pl2 lst
                    (if
                        (and
                            (not (equal pl1 pl2 1e-8))
                            (setq int (inters pt1 pt2 (car pl2) (cadr pl2)))
                            (not (vl-member-if '(lambda ( pnt ) (equal pnt int 1e-8)) pl1))
                        )
                        (setq pl1 (cons int pl1))
                    )
                )
                (setq rtn
                    (append
                        (mapcar
                            (function
                                (lambda ( a b )
                                    (vla-addline spc
                                        (vlax-3D-point a)
                                        (vlax-3D-point b)
                                    )
                                )
                            )
                            (setq pl1
                                (vl-sort pl1
                                    (function
                                        (lambda ( a b )
                                            (< (distance pt1 a) (distance pt1 b))
                                        )
                                    )
                                )
                            )
                            (cdr pl1)
                        )
                        rtn
                    )
                )
            )
            (setq var '(cmdecho peditaccept)
                  val  (mapcar 'getvar var)
                  tot  0.0
            )
            (mapcar 'setvar var '(0 1))
            (foreach reg (vlax-invoke spc 'addregion rtn)
                (setq ent (entlast))
                (command "_.pedit" "_m")
                (apply 'command (mapcar 'vlax-vla-object->ename (vlax-invoke reg 'explode)))
                (command "" "_j" "" "")
                (if
                    (and
                        (not (eq ent (setq ent (entlast))))
                        (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
                    )
                    (progn
                        (setq tmp (vlax-curve-getarea ent)
                              tot (+ tot tmp)
                        )
                        (if (< (car big) tmp)
                            (setq big (list tmp ent))
                        )
                    )
                )
                (vla-delete reg)
            )
            (if (equal (car big) (/ tot 2.0) 1e-3) ;; Gian Paolo Cattaneo
                (entdel (cadr big))
            )
            (foreach obj rtn (vla-delete obj))
            (mapcar 'setvar var val)
        )
    )
    (LM:endundo (LM:acdoc))
    (princ)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
(vl-load-com) (princ)

 

 

Với lisp sưu tầm của Lee-Mac thì sẽ tạo ra được các Polyline mới. Tuy nhiên nó tạo ra rất nhiều các vùng giao. Cháu sẽ Offset lưới ô vuông vào trong 1 khoảng đủ nhỏ. Sau đó sẽ chọn tất cả những Boundary nằm trong và giao với ô vuông Offset, loại những Boundary ở ngoài (mới) và đường Polyline ngoài.

Như vậy được không các bác nhỉ? Em sợ thuật toán chậm.