[Thư Viện] Tập hợp một số hàm entmake object

[Doan Van Ha 3.201]

bỏ hết if đi xem sao.

[Chiron 94]

bỏ hết if đi xem sao.

Đã thử rồi bác, không có tác dụng chi hết.

(defun c:mly ()

(MakeLayer "1" 2 "Continuous" 0.3 1)

)

Đổi thử màu layer 1 thành màu 5 rồi chạy lại. Màu của layer 1 vẫn là màu số 5 chứ không phải màu số 2 như mình muốn.

[Tue_NV 3.912]

Lisp theo yêu cầu của Chiron đây :

 

(defun MakeLayer (name color linetype lineWeight plot / tblobj ent)
(if (tblsearch "Layer" name)
  (progn
     (setq tblobj (TBLOBJNAME "Layer" name) ent (entget tblobj))
     (if color (setq ent (SUBST (cons 62 color) (assoc 62 ent) ent)))
     (if linetype (setq ent (SUBST (cons 6 linetype) (assoc 6 ent) ent)))
     (if plot (setq ent (SUBST (cons 290 plot) (assoc 290 ent) ent)))
     (if lineWeight (setq ent (SUBST (cons 370 (fix (* 100 lineWeight))) (assoc 370 ent) ent)))
     (entmod ent)
  )
(entmakex (list '(0 . "LAYER")
 
(cons 100 "AcDbSymbolTableRecord")
 
(cons 100 "AcDbLayerTableRecord")
 
(cons 2 name)
 
(cons 70 0)
 
(cons 62 (if color color 7))
 
(cons 6 (if linetype linetype "Continuous"))
 
(cons 290 (if plot 1 0))
 
(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3)))
)
 
)
)

(defun MakeLayer (name color linetype lineWeight plot)

(if (tblsearch "Layer" name)

  (progn

     (setq tblobj (TBLOBJNAME "Layer" name) ent (entget tblobj))

     (if color (setq ent (SUBST (cons 62 color) (assoc 62 ent) ent)))

     (if linetype (setq ent (SUBST (cons 6 linetype) (assoc 6 ent) ent)))

     (if plot (setq ent (SUBST (cons 290 plot) (assoc 290 ent) ent)))

     (if lineWeight (setq ent (SUBST (cons 370 (fix (* 100 lineWeight))) (assoc 370 ent) ent)))

     (entmod ent)

  )

(entmakex (list '(0 . "LAYER")

 

(cons 100 "AcDbSymbolTableRecord")

 

(cons 100 "AcDbLayerTableRecord")

 

(cons 2 name)

 

(cons 70 0)

 

(cons 62 (if color color 7))

 

(cons 6 (if linetype linetype "Continuous"))

 

(cons 290 (if plot 1 0))

 

(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3)))

)

 

)

)

[Chiron 94]

Cám ơn bác Tue_NV. Bác cho hỏi thêm:

- Dùng visual lisp và entmake để tạo layer (hoặc đối tượng bất kỳ), cái nào hay và nhanh hơn?

- Hàm makelayer trên vẫn còn thiếu phần description, bác giúp Chiron bổ sung và hướng dẫn cách lấy groupcode của description của layer?

[Tue_NV 3.912]

Cám ơn bác Tue_NV. Bác cho hỏi thêm:

- Dùng visual lisp và entmake để tạo layer (hoặc đối tượng bất kỳ), cái nào hay và nhanh hơn?

- Hàm makelayer trên vẫn còn thiếu phần description, bác giúp Chiron bổ sung và hướng dẫn cách lấy groupcode của description của layer?

 

1./  Dùng Visual lisp có ưu điểm là không cần phải nhớ mã dxf. Việc tra mã dxf phục vụ cho entmake sẽ coding lâu hơn so với cách dùng Visual Lisp. Còn về tốc độ thì tốc độ chắc ngang nhau

2./ Mình không biết cách lấy description của Layer bằng entmake, thấy nó khó lấy quá.

Nhưng với Visual lisp, bạn lấy description của Layer "0" theo mã sau : (nếu thay description bằng chuỗi khác thì dùng vla-put-Description

 

(vla-get-Description (vlax-ename->vla-object (tblobjname "Layer" "0")))

[Doan Van Ha 3.201]

Bổ sung thêm: tốc độ thì... khó nói lắm. Có lần tôi đã test 2 thằng, thấy vla nhanh hơn, nhưng quên mất ví dụ đó rồi.

Lại có lúc test khác, thấy entmake nhanh hơn, như ví dụ dưới đây. Nói chung, khi muốn đua tốc độ thì nên test thử rồi chọn là hay nhất.

(defun C:HA1()

 (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))

 (setq mspace (vla-get-modelspace thisdrawing))

 (setq pt1 (vlax-3d-point (getpoint "\nCenter point: ")))

 (setq rad (getreal "\nRadius: "))

 (setq time (getvar "millisecs"))

 (repeat 100000

  (vla-AddCircle mspace pt1 rad))

 (- (getvar "millisecs") time))

(defun C:HA2()

 (setq pt1 (getpoint "\nCenter point: "))

 (setq rad (getreal "\nRadius: "))

 (setq time (getvar "millisecs"))

 (repeat 100000

  (Circle pt1 rad))

 (- (getvar "millisecs") time))

(defun Circle (cen rad) (entmake (list (cons 0 "CIRCLE") (cons 10 cen) (cons 40 rad))))

 

[Chiron 94]

- Chiron thấy trên internet dùng code

(list

  (list -3

    (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))
  )
)

để thêm description vào layer nhưng không biết làm sao người ta biết được cái code 1000 này. Loay hoay cả buổi mà không ra.

- Về tốc độ trong trường hợp này có vẻ không chênh nhau nhiều. Ghét cái lisp tạo layer dùng lệnh command, 1 list khoảng trên dưới 50 layer mà thấy màn hình chớp nháy liên hồi. Dùng entmake & visual lisp chạy chỉ khoảng 1s, không hề chớp nháy gì cả.

[ThuyLinh313 156]

 Chiron dùng code mình sửa này.

 

 

(defun MakeLayer (name color linetype lineWeight plot description)
(entmakex (list '(0 . "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 name)
(cons 70 0)
(cons 62 (if color color 7))
(cons 6 (if linetype linetype "Continuous"))
(cons 290 (if plot 1 0))
(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))
(cons -3 (list (list "AcAecLayerStandard" '(1000 . "") (cons 1000 description))))))) 
 

(MAKELAYER "Thuylinh313" 1 nil nil nil "LispersGroup^^")

- 3 là mã DXF chứa Xdata. Thông tin description của layer được đưa vào xdata

Mọi thông tin dxf của layer bạn có thể lấy được bằng đoạn mã (entget (tblobjname "Layer" "tên layer") '("*"))

[Chiron 94]

Hàm MakeLayer của ThuyLinh313 cũng đâu có đổi thông số của Layer nếu trong bản vẽ đã tồn tại những layer cùng tên? Chiron đang tham khảo thêm hàm của Lee Mac:

 

(defun MakeLayer ( name colour linetype lineweight willplot bitflag description )
;; © Lee Mac 2010
(or (tblsearch "LAYER" name)
(entmake
(append
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 name)
(cons 70 bitflag)
(cons 290 (if willplot 1 0))
(cons 6
(if (and linetype (tblsearch "LTYPE" linetype))
linetype "CONTINUOUS"
)
)
(cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))
(cons 370
(fix
(* 100
(if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)
)
)
)
)
(if description
(list
(list -3
(list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))
)
)
)
)
)
)
)

ps: Sao mình chèn code vào cứ bị cách dòng vậy ta?

(defun MakeLayer ( name colour linetype lineweight willplot bitflag description )

  ;; © Lee Mac 2010

  (or (tblsearch "LAYER" name)

    (entmake

      (append

        (list

          (cons 0 "LAYER")

          (cons 100 "AcDbSymbolTableRecord")

          (cons 100 "AcDbLayerTableRecord")

          (cons 2  name)

          (cons 70 bitflag)

          (cons 290 (if willplot 1 0))

          (cons 6

            (if (and linetype (tblsearch "LTYPE" linetype))

              linetype "CONTINUOUS"

            )

          )

          (cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))

          (cons 370

            (if (minusp lineweight) -3

              (fix

                (* 100

                  (if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)

                )

              )

            )

          )

        )

        (if description

          (list

            (list -3

              (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))

            )

          )

        )

      )

    )

  )

)

 

(defun MakeLayer ( name colour linetype lineweight willplot bitflag description )

  ;; © Lee Mac 2010

  (or (tblsearch "LAYER" name)

    (entmake

      (append

        (list

          (cons 0 "LAYER")

          (cons 100 "AcDbSymbolTableRecord")

          (cons 100 "AcDbLayerTableRecord")

          (cons 2  name)

          (cons 70 bitflag)

          (cons 290 (if willplot 1 0))

          (cons 6

            (if (and linetype (tblsearch "LTYPE" linetype))

              linetype "CONTINUOUS"

            )

          )

          (cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))

          (cons 370

            (if (minusp lineweight) -3

              (fix

                (* 100

                  (if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)

                )

              )

            )

          )

        )

        (if description

          (list

            (list -3

              (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))

            )

          )

        )

      )

    )

  )

)

[ThuyLinh313 156]

Mình chỉ sửa lại hàm Makelayer của thaistreetz để bạn biết cách can thiệp vào description thôi mà. Vì bạn đang kêu không biết sử dụng đoạn mã bạn sưu tầm được như thế nào.

Code trên rất rõ ràng, chỉ dùng để tạo đối tượng. Của Lee mac thì cũng vậy thôi. Muốn sửa layer có sẵn thì bạn phải Entmod chứ.

[Chiron 94]

Ah. Cám ơn ThuyLinh313 nhiều. Nhờ cái đoạn (entget (tblobjname "Layer" "tên layer") '("*")), giờ đã hiểu được phần nào rồi.

[soluuhuong2903 22]

các bác ơi ! vẫn chưa có entmake hoàn thiện cho hatch hả. e đang cần gấp.hic

[vanngeonhuxua 10]

Được bạn à! Nhưng sẽ rắc rối hơn vì phải bổ sung DXF 40 và 41. Và càng rắc rối hơn nữa nếu Lwpolyline có thêm Arc.

Bạn ơi có thể chỉ mình cách tạo đường Lwpolyline có cả Arc nữa không bạn?

Thank trước.

[vanngeonhuxua 10]

Có bác nào biết chỉ em với?

[Tr.CongSon 42]

Bạn ơi có thể chỉ mình cách tạo đường Lwpolyline có cả Arc nữa không bạn?

Thank trước.

 

Bạn tham khảo ở đây nhé!

 

http://www.cadviet.com/forum/topic/14210-hoi-ve-lisp-thuat-toan-y-tuong-coding/page-128

[vanngeonhuxua 10]

Thank! thì ra  dxf 42

[vodoifx 2]

Help Developer đôi khi cũng viết sai.!?

Cập nhật sửa lỗi hàm MakeInsert

(defun MakeInsert (Blkname inspoint scale ang list_att layer color xdata / lst obj i en x )(setq i -1 en (cdr (last (tblsearch "block" Blkname))) obj (entget en))(if (= (cdr(assoc 0 obj)) "ATTDEF")(setq lst (list (list  (cdr(assoc 10 obj))(cdr(assoc 11 obj))(cdr(assoc 50 obj))(cdr(assoc 8 obj))(cdr(assoc 70 obj))(cdr(assoc 62 obj))  (cdr(assoc 40 obj))(assoc 7 obj)(assoc 71 obj)(assoc 72 obj)(assoc 2 obj)))))(while (setq en (entnext en))(if (= (cdr(assoc 0 (setq obj(entget en)))) "ATTDEF")  (setq lst (cons (list  (cdr(assoc 10 obj))(cdr(assoc 11 obj))(cdr(assoc 50 obj))(cdr(assoc 8 obj))(cdr(assoc 70 obj))(cdr(assoc 62 obj))  (cdr(assoc 40 obj))(assoc 7 obj)(assoc 71 obj)(assoc 72 obj)(assoc 2 obj))lst))))(entmakex(list  '(0 . "INSERT")'(100 . "AcDbEntity")  (cons 8 (if Layer Layer (getvar "Clayer")))  (cons 62 (if Color Color 256))  '(100 . "AcDbBlockReference")'(66 . 1)  (cons 2 Blkname)  (cons 10 (trans inspoint 1 0))  (cons 41 scale)(cons 42 scale)(cons 43 scale)  (cons 50 Ang)  (cons -3 (if xdata (list xdata) nil))))(if lst(foreach LL (reverse lst) (entmake(list  '(0 . "ATTRIB")'(100 . "AcDbEntity")(cons 8 (cadddr LL))(cons 60 (nth 4 LL))(if (nth 5 LL) (cons 62 (nth 5 LL)) '(62 . 256))'(100 . "AcDbText")  (cons 10(mapcar'+(trans inspoint 1 0)(mapcar'(lambda(x)(* scale x))(polar'(0 0 0)(+(angle'(0 0 0)(car LL))ang)(distance'(0 0 0)(car LL))))))  (cons 40 (* scale (nth 6 LL)))  (cons 1 (nth (setq i (1+ i))list_att))  (cons 50 (+ ang (caddr LL)))  '(41 . 1.0)(nth 7 LL)(nth 8 LL)(nth 9 LL)  (if (= 0(cdr (nth 8 LL))(cdr(nth 9 LL)))(cons 11(list 0 0 0))  (cons 11(mapcar'+(trans inspoint 1 0)(mapcar'(lambda(x)(* scale x))(polar'(0 0 0)(+(angle'(0 0 0)(cadr LL))ang)(distance'(0 0 0)(cadr LL)))))))  '(100 . "AcDbAttribute")'(280 . 0)(last LL)'(70 . 0)'(280 . 1)))))(cdr (assoc 330 (entget (entmakex (list '(0 . "SEQEND") (cons 8 (if Layer Layer (getvar "Clayer")))))))))

 

Em đang dùng hàm  MakeInsert của anh. Nhưng có 1 điểm em chưa sửa được là Att của block khi insert không được theo chế độ Justification của ATT gốc 

Ví dụ: Khi ATT gốc của em để  là Middle center thì khi insert nó chỉ là chế độ Center thôi.