Đến nội dung


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

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


  • Please log in to reply
40 replies to this topic

#21 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 04 February 2013 - 02:36 PM

Trích dẫn help:
70
Attribute flags:
1 = Attribute is invisible (does not appear)
2 = This is a constant attribute
4 = Verification is required on input of this attribute
8 = Attribute is preset (no prompt during insertion)
Tôi test OK.

;;;;;;;;MAIN;;;;;;;;;
(defun C:1att (/ p0 G00 G90 LL)
(setq G00 0.0
G90 (* pi 0.5))
(setq p0 (getpoint "\nChon dien chen Attribute: "))
(setq LL '("111" "222" "333"))

(Make_att LL "standard" "0" p0 3.0 G00 1 1)

(princ)
)
(Princ "\nStart command with <1att>")
;;;;; Ham con tao att
(defun Make_att (LIST_ATT STYLE LAYER POINT HEIGHT ANG COLOR FLAG); Ang: Radial
(entmake (list (cons 0 "ATTDEF")
(cons 100 "AcDbEntity")
(cons 7 (if STYLE STYLE (getvar "TextSTYLE")))
(cons 8 (if LAYER LAYER (getvar "CLAYER")))
(cons 100 "AcDbText")
(cons 100 "AcDbAttributeDefinition")
(cons 10 POINT)
; (cons 11 POINT)
(cons 70 FLAG)

(cons 40 HEIGHT)
(if ANG (cons 50 ANG))
(cons 62 (if COLOR COLOR 256))
(cons 1 (nth 0 LIST_ATT)) ; Default value (string)
(cons 2 (nth 1 LIST_ATT)) ; Tag (string and can not contain spaces)
(cons 3 (nth 2 LIST_ATT)) ; Prompt (string)
);end list
);entmake
);end defun

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


#22 luckylucke_2009

luckylucke_2009

    biết zoom

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

Đã gửi 04 February 2013 - 02:57 PM

Trích dẫn help:
70
Attribute flags:
1 = Attribute is invisible (does not appear)
2 = This is a constant attribute
4 = Verification is required on input of this attribute
8 = Attribute is preset (no prompt during insertion)
Tôi test OK.


;;;;;;;;MAIN;;;;;;;;;
(defun C:1att (/ p0 G00 G90 LL)
(setq G00 0.0
G90 (* pi 0.5))
(setq p0 (getpoint "\nChon dien chen Attribute: "))
(setq LL '("111" "222" "333"))

(Make_att LL "standard" "0" p0 3.0 G00 1 1)

(princ)
)
(Princ "\nStart command with <1att>")
;;;;; Ham con tao att
(defun Make_att (LIST_ATT STYLE LAYER POINT HEIGHT ANG COLOR FLAG); Ang: Radial
(entmake (list (cons 0 "ATTDEF")
(cons 100 "AcDbEntity")
(cons 7 (if STYLE STYLE (getvar "TextSTYLE")))
(cons 8 (if LAYER LAYER (getvar "CLAYER")))
(cons 100 "AcDbText")
(cons 100 "AcDbAttributeDefinition")
(cons 10 POINT)
; (cons 11 POINT)
(cons 70 FLAG)

(cons 40 HEIGHT)
(if ANG (cons 50 ANG))
(cons 62 (if COLOR COLOR 256))
(cons 1 (nth 0 LIST_ATT)) ; Default value (string)
(cons 2 (nth 1 LIST_ATT)) ; Tag (string and can not contain spaces)
(cons 3 (nth 2 LIST_ATT)) ; Prompt (string)
);end list
);entmake
);end defun

Không biết sao nữa! Tôi test thử vẫn không hiện ra được attribute cần tạo!!??
  • 0

#23 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 04 February 2013 - 03:22 PM

Bạn thử dùng hàm đơn giản hơn, xem được không, sau đó thêm dần rồi kiểm tra. Tôi test với hàm này cũng OK.

(defun AttDef (tag prmpt def pt hgt flag)
(entmakex (list (cons 0 "ATTDEF")
(cons 10 pt)
(cons 40 hgt)
(cons 1 def)
(cons 2 tag)
(cons 3 prmpt)
(cons 70 flag))))

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


#24 luckylucke_2009

luckylucke_2009

    biết zoom

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

Đã gửi 05 February 2013 - 02:57 PM

Cám ơn bác HA rất nhiều!
Vẫn code cũ ở #22, bỏ đi mấy phần (cons 100 ...) là chạy bình thường!
  • 0

#25 Chiron

Chiron

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 17 June 2013 - 12:39 PM

Chiron đang thử dùng hàm entmake của bác Thaistreetz để tạo layer:

 

(defun MakeLayer (name color linetype lineWeight plot)

(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)))));end

 

Hàm này chỉ để tạo mới mà không hiệu chỉnh được layer có sẵn như lệnh -layer của autoCAD. Các bác giúp Chiron viết lại hàm này để có thể ghi đè theo thông số trong lisp. Nếu trong bản vẽ đã có layer trùng tên trong lisp thì cập nhật theo thông số trong lisp, nếu chưa có thì tạo mới.


  • 0

#26 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 17 June 2013 - 01:36 PM

bỏ hết if đi xem sao.
  • 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.


#27 Chiron

Chiron

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 17 June 2013 - 02:17 PM

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.


  • 0

#28 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 June 2013 - 03:01 PM

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)))
)
 
)
)

  • 1

#29 Chiron

Chiron

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 18 June 2013 - 10:36 AM

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?


  • 0

#30 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 June 2013 - 11:09 AM

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")))


  • 1

#31 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 18 June 2013 - 11:37 AM

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))))
 


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


#32 Chiron

Chiron

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 19 June 2013 - 08:41 AM

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


  • 0

#33 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 19 June 2013 - 10:14 AM

 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") '("*"))


  • 1

#34 Chiron

Chiron

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 19 June 2013 - 10:42 AM

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))
            )
          )
        )
      )
    )
  )
)

  • 0

#35 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 19 June 2013 - 11:14 AM

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


  • 0

#36 Chiron

Chiron

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 19 June 2013 - 11:49 AM

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.


  • 0

#37 soluuhuong2903

soluuhuong2903

    biết vẽ rectang

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

Đã gửi 13 February 2014 - 08:36 AM

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


  • 0

#38 vanngeonhuxua

vanngeonhuxua

    biết vẽ pline

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

Đã gửi 07 March 2015 - 11:12 PM

Đượ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.


  • 0

#39 vanngeonhuxua

vanngeonhuxua

    biết vẽ pline

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

Đã gửi 16 August 2015 - 10:08 PM

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


  • 0

#40 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 17 August 2015 - 08:13 AM

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.c...coding/page-128


  • 1