Đế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

#1 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 17 August 2011 - 02:21 AM

Chưa đủ, vì đụng đến thằng nào thì mình mới viết cho thằng đấy. các bác bổ sung thêm các đối tượng khác cho em nó được tròn trịa.
Tiện đây mình đố bác nào viết được cái hàm make MLine. mình trả 20 (+) luôn, hề hề :lol:

==================================================
Entmake Object defun by Thaistreetz - Cadviet.com
==================================================

====== List support object ========
- Text
- Line
- Point
- LWPolyline
- Spline
- MakeCircle
- MakeRectang :P
- Layer
- Wipeout
- Group
- MlineStyle (view more DelMLineStyle defun)
- MakeMline _false :(
- MakeRegion (one Boundary and Two Boundary)
- Insert (support ATT Block)
- Xline
- Ray
- Light
...
===================================


;|=================================================
Entmake object defun by Thaistreetz - Cadviet.com
==================================================

====== List support object ========
- Text
- Line
- Point
- LWPolyline
- Spline
- MakeCircle
- MakeRectang
- Layer
- Wipeout
- Group
- MlineStyle (view more DelMLineStyle defun)
- MakeMline _false :(
- MakeRegion (one Boundary and Two Boundary)
- Insert (support ATT Block)
- Xline
- Ray
- Light
...
===================================|;
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst); Ang: Radial
(setq Lst (list '(0 . "TEXT")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 Height)
(cons 1 string)
(if Ang (cons 50 Ang))
(cons 7 (if Style Style (getvar "Textstyle")))
(cons -3 (if xdata (list xdata) nil)))
justify (strcase justify))
(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))
((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
(entmakex Lst));end
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata)
(entmakex (list '(0 . "LINE")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
(cons 10 PT1) (cons 11 PT2)
(cons -3 (if xdata (list xdata) nil)))));end
;=================================
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP)))))
(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
(entmakex Lst));end
;=================================
(defun MakeCircle (point R Linetype LTScale Layer Color xdata)
(entmakex (list '(0 . "CIRCLE")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 R)
(cons -3 (if xdata (list xdata) nil)))));end
;=================================
(defun MakeRectang (PT1 PT2 Linetype LTScale Layer Color xdata)
(entmakex (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbPolyline")
(cons 90 4)
(cons 70 1)
(cons 10 PT1)
(cons 10 (list (car PT1) (cadr PT2)))
(cons 10 PT2)
(cons 10 (list (car PT2) (cadr PT1)))
(cons -3 (if xdata (list xdata) nil)))));end
;================================
(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
;=================================
(defun MakeSPline (listpoint Linetype LTScale Layer Color xdata / Lst)
(setq lst (list '(0 . "SPLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbSpline")
(cons 71 3)
(cons 74 (length listpoint))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 11 PP)))))
(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
(entmakex Lst));end
;================================
(defun MakeWipeout (listpoint Layer Color xdata / dxf10 max_dist cen dxf14)
(if (not (member "acwipeout.arx" (arx))) (arxload "acwipeout.arx"))
(setq dxf10 (list(apply'min(mapcar'car listpoint))(apply'min(mapcar'cadr listpoint))(if(caddar listpoint)(caddar listpoint)0))
max_dist(float(apply'max(mapcar'-(apply'mapcar(cons'max listpoint))dxf10)))
cen (mapcar'+ dxf10(list(/ max_dist 2)(/ max_dist 2) 0.0))
dxf14 (mapcar'(lambda(p)(mapcar'/(mapcar'- p cen)(list max_dist(- max_dist)1.0)))listpoint)
dxf14 (reverse(cons(car dxf14)(reverse dxf14))))
(entmakex (append (list
'(0 . "WIPEOUT")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
'(100 . "AcDbWipeout")'(90 . 0)
(cons 10 (trans dxf10 (list 0 0 1) 0))
(cons 11 (trans (list max_dist 0.0 0.0) (list 0 0 1) 0))
(cons 12 (trans (list 0.0 max_dist 0.0) (list 0 0 1) 0))
'(13 1.0 1.0 0.0)'(70 . 7)'(280 . 1)'(71 . 2)
(cons 91 (length dxf14)))
(mapcar'(lambda(p)(cons 14 p))dxf14)
(list (cons -3 (if xdata (list xdata) nil))))));end
;================================
(defun MakeGroup (lstEname Description / dict ind)
(setq dict (dictsearch (namedobjdict) "ACAD_GROUP") ind "GRP1")
(while (member (cons 3 ind) dict) (setq ind (strcat "GRP" (itoa (1+ (atoi (substr ind 4)))))))
(dictadd (cdr (assoc -1 dict)) ind (entmakex (append
(list '(0 . "GROUP")'(100 . "AcDbGroup")(cons 300 Description)'(70 . 0)'(71 . 1))(mapcar'(lambda(x)(cons 340 x))lstEname))))
);end
;================================
(defun MakeMlineStyle (Name Description ColorFill LineLst / Dic Lst Obj) ; (LineLst: offset color linetype)
(setq Lst (list (cons 0 "MLINESTYLE")
(cons 100 "AcDbMlineStyle")
(cons 2 Name)
(if (and ColorFill (< 0 ColorFill 256)) (cons 70 1) (cons 70 0))
(cons 3 Description)
(if (and ColorFill (< 0 ColorFill 256)) (cons 62 ColorFill) (cons 62 256))
(cons 51 (* pi 0.5))
(cons 52 (* pi 0.5))
(cons 71 (length LineLst))))
(foreach LL LineLst
(setq Lst (append Lst (list (cons 49 (car LL))
(cons 62 (if (and (cadr LL) (< 0 (cadr LL) 256)) (cadr LL) 256))
(cons 6 (if (caddr LL) (caddr LL) "BYLAYER"))))))
(if (and (setq Dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))
(not (dictsearch (setq Dic (cdr (assoc -1 Dic))) (cdr (assoc 2 LST))))
(setq Obj (entmakex Lst)))
(dictadd Dic (cdr (assoc 2 Lst)) Obj))
);end

(defun DelMLineStyle ( Name / Dic ) ; Remove Mline Style
(if (setq Dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))(dictremove (cdr (assoc -1 Dic)) Name))
);end
;================================
;|(defun MakeMline (listpoint closed MLstyle Scale LTScale Justify Layer / LST) ;Justify: T M B
(setq Lst (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
'(100 . "AcDbMline")
(cons 2 MLstyle)
(cons 40 (if Scale Scale 1))
(cons 70 (cond ((= Justify "T") 0) ((= Justify "M") 1) ((= Justify "B") 2)))
(cons 71 (if closed 3 1))
(cons 72 (length listpoint))
(cons 48 (if LTScale LTScale 1))
)))|;
(defun MakeRegion (en)
(if (vlax-curve-isClosed en)
(vlax-invoke(vlax-get-property(vla-get-ActiveDocument(vlax-get-acad-object))(if(= 1(getvar'CVPORT))'Paperspace'Modelspace))'AddRegion(list(vlax-ename->vla-object en))))nil)
(defun MakeRegion2 (en1 en2 / space)
(setq space (vlax-get-property (vla-get-ActiveDocument (vlax-get-acad-object)) (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)))
(if (and (vlax-curve-isClosed en1) (vlax-curve-isClosed en1))
(vla-Boolean
(vlax-invoke 'AddRegion (list (vlax-ename->vla-object en1)))
acSubtraction
(vlax-invoke 'AddRegion (list (vlax-ename->vla-object en2))))
nil)
)
;;;=============== Make insert block
(defun MakeInsert (Blkname inspoint scale ang list_att layer color xdata / lst obj i)
(setq lst '() 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")
(if list_att '(66 . 1) '(66 . 0))
(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)))))
(dxf 330 (entmakex (list '(0 . "SEQEND") (cons 8 (if Layer Layer (getvar "Clayer")))))))
;;;================ make point
(defun MakePoint (point layer color)
(entmakex (list '(0 . "POINT")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
'(100 . "AcDbPoint")(cons 10 point))))
;;;================ make ray
(defun MakeRay (Point vector layer color)
(entmakex (list '(0 . "RAY")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
'(100 . "AcDbRay")
(cons 10 Point)
(cons 11 vector))))
(defun MakeXline (Point vector layer color)
(entmakex (list '(0 . "XLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
'(100 . "AcDbXline")
(cons 10 Point)
(cons 11 vector))))
;;;================ make point light
(defun MakeLight (Point)
(if PointLightName
(setq PointLightName (strcat "PtLight" (itoa (1+ (atoi (substr PointLightName 8))))))
(setq PointLightName "PtLight1"))
(entmakex (list '(0 . "LIGHT")'(100 . "AcDbEntity")'(8 . "*ADSK_SYSTEM_LIGHTS")'(100 . "AcDbLight")'(90 . 1)(cons 1 PointLightName)(cons 10 Point)))
);end

Edit: Chú ý:
- với code trên, bác nào không có nhu cầu dùng xdata thì nên sửa lại bỏ nó đi cho gọn.
- Các tham số về layer, Color, Linetype, LTScale, Angle... Nếu đặt là nil thì hàm sẽ lấy các giá trị hiện hành của bản vẽ.
  • 7

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 17 August 2011 - 09:57 AM

Chưa đủ, vì đụng đến thằng nào thì mình mới viết cho thằng đấy. các bác bổ sung thêm các đối tượng khác cho em nó được tròn trịa.
Tiện đây mình đố bác nào viết được cái hàm make MLine. mình trả 20 (+) luôn, hề hề :lol:

Đây bạn, mình sưu tầm


;;-------------------=={ Add MLine Style }==------------------;;
;; ;;
;; Adds an MLine Style to the ACAD_MLINESTYLE dictionary ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; data - a DXF list of MLineStyle data ;;
;;------------------------------------------------------------;;
;; Returns: MLineStyle Dictionary Entity, else nil ;;
;;------------------------------------------------------------;;

(defun LM:AddMLineStyle ( data / dic obj )
;; © Lee Mac 2010
(if (and (setq dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))
(not (dictsearch (setq dic (cdr (assoc -1 dic))) (cdr (assoc 2 data))))
(setq obj (entmakex data)))

(dictadd dic (cdr (assoc 2 data)) obj)
)
)

;;-----------------=={ Delete MLine Style }==-----------------;;
;; ;;
;; Removes an MLine Style from the ACAD_MLINESTYLE ;;
;; dictionary ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; name - the name of an MLine Style to remove ;;
;;------------------------------------------------------------;;
;; Returns: Entity name of removed style, else nil ;;
;;------------------------------------------------------------;;

(defun LM:DeleteMLineStyle ( name / dic )
;; © Lee Mac 2010
(if (setq dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))
(dictremove (cdr (assoc -1 dic)) name)
)
)

;;------------------------------------------------------------;;

;; Test Function

(defun Example ( / lst )

(setq lst
(list
(cons 0 "MLINESTYLE")
(cons 100 "AcDbMlineStyle")
(cons 2 "Example") ; Name
(cons 70 (+ 272)) ; caps/fill/joints
(cons 3 "") ; Desc
(cons 51 (/ pi 2.)); Start ang
(cons 52 (/ pi 2.)); End ang
(cons 71 2) ; Number of lines
(cons 49 -0.5) ; Element Offset
(cons 62 256) ; Element Colour
(cons 6 "BYLAYER") ; Element Linetype
(cons 49 0.5)
(cons 62 256)
(cons 6 "BYLAYER")
)
)

(LM:AddMLineStyle lst)
)


;;----------------------=={ Add MLine }==---------------------;;
;; ;;
;; Adds a VLA MLine Object to the supplied Block container ;;
;; object, going through the supplied vertex list. ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; space - VLA Block Object ;;
;; ptLst - List of 3D Points for MLine Vertices ;;
;;------------------------------------------------------------;;
;; Returns: VLA MLine Object, else nil ;;
;;------------------------------------------------------------;;

(defun LM:AddMLine ( space ptLst )
;; © Lee Mac 2010
(vla-AddMline space (LM:PointVariant ptLst))
)

;;------------------=={ Safearray Variant }==-----------------;;
;; ;;
;; Creates a populated Safearray Variant of a specified ;;
;; data type ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; datatype - variant type enum (eg vlax-vbDouble) ;;
;; data - list of static type data ;;
;;------------------------------------------------------------;;
;; Returns: VLA Variant Object of type specified ;;
;;------------------------------------------------------------;;

(defun LM:SafearrayVariant ( datatype data )
;; © Lee Mac 2010
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray datatype
(cons 0 (1- (length data)))
)
data
)
)
)

;;--------------------=={ Point Variant }==-------------------;;
;; ;;
;; Creates a populated Safearray Variant of Double type. ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; lst - list of 2D/3D Points to populate the Variant. ;;
;;------------------------------------------------------------;;
;; Returns: VLA Safearray Variant ;;
;;------------------------------------------------------------;;

(defun LM:PointVariant ( lst )
;; © Lee Mac 2010
(LM:SafearrayVariant vlax-VBDouble (apply 'append lst))
)

;;---------------------=={ Get Points }==---------------------;;
;; ;;
;; Returns a list of selected points. ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: - None - ;;
;;------------------------------------------------------------;;
;; Returns: List of 3D Points ;;
;;------------------------------------------------------------;;

(defun LM:GetPoints ( / lst pt )
;; © Lee Mac 2010

(if (car (setq lst (list (getpoint "\nPick First Point: "))))

(while (setq pt (getpoint "\nPick Next Point: " (car lst)))
(mapcar
(function
(lambda ( from to ) (grdraw from to 3 1))
)
(cdr (reverse (setq lst (cons pt lst))))

(reverse (cdr lst))
)
)
)
(redraw) (reverse lst)
)

;;------------------------------------------------------------;;

;; Test Function

(defun c:test ( / lst )

(if (setq lst (LM:GetPoints))

(LM:AddMLine
(vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
lst
)
)
)


  • 2

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#3 hochoaivandot

hochoaivandot

    biết dimradius

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

Đã gửi 17 August 2011 - 03:45 PM

Hatch có entmake được không các bác nhỉ?
Thay vì dùng command BOUNDARY có thể thay bằng entmake không?
  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#4 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 17 August 2011 - 04:23 PM

Hatch có entmake được không các bác nhỉ?
Thay vì dùng command BOUNDARY có thể thay bằng entmake không?

code entmake hatch đây bạn

(entmake
(list
(cons 0 "HATCH")
(cons 100 "AcDbEntity")
(cons 8 "0")
(cons 100 "AcDbHatch")
(cons 62 13)
(cons 10 cenpt)
(cons 210 (list 0.0 0.0 1.0))
(cons 2 "SOLID")
(cons 70 1)
(cons 71 0)
(cons 91 1)
(cons 92 1)
(cons 93 1)
; the "3" designates this is an elliptical shape
(cons 72 3)
; center point of ellipse
(cons 10 cenpt)
; point of top quad
(cons 11 otherpt)
; ratio of width to height
(cons 40 0.1)
; start angle
(cons 50 0.0)
; end angle (full ellipse)
(cons 51 (* pi 2.0))
; counterclockwise flag
(cons 73 1)
(cons 97 0)
(cons 75 0)
(cons 76 1)
(cons 98 1)
(cons 10 (list 0.0 0.0 0.0))
)
)
Đối tượng BOUNDARY chính là pline mà.
  • 2
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#5 hochoaivandot

hochoaivandot

    biết dimradius

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

Đã gửi 17 August 2011 - 05:14 PM

code entmake hatch đây bạn


(entmake
(list
(cons 0 "HATCH")
(cons 100 "AcDbEntity")
(cons 8 "0")
(cons 100 "AcDbHatch")
(cons 62 13)
(cons 10 cenpt)
(cons 210 (list 0.0 0.0 1.0))
(cons 2 "SOLID")
(cons 70 1)
(cons 71 0)
(cons 91 1)
(cons 92 1)
(cons 93 1)
; the "3" designates this is an elliptical shape
(cons 72 3)
; center point of ellipse
(cons 10 cenpt)
; point of top quad
(cons 11 otherpt)
; ratio of width to height
(cons 40 0.1)
; start angle
(cons 50 0.0)
; end angle (full ellipse)
(cons 51 (* pi 2.0))
; counterclockwise flag
(cons 73 1)
(cons 97 0)
(cons 75 0)
(cons 76 1)
(cons 98 1)
(cons 10 (list 0.0 0.0 0.0))
)
)
Đối tượng BOUNDARY chính là pline mà.


Cảm ơn anh phamngoctukts!

Đối tượng BOUNDARY chính là pline mà.

Cái này ý của em là khi thực hiện lệnh BOUNDARY --->Pick điểm pt--->Có được đường PLINE
Có thể xây dựng 1 hàm (dèfun xxx(pt) ....--->entmake (....)) Và kết quả vẫn có PLINE
Yêu cầu này chắc đưa vào topic này không hợp lắm (Nếu các mod thấy đúg vậy hãy xóa bài giúp nhé!)
  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 17 August 2011 - 07:47 PM

Nhân tiện topic, mọi người hãy đóng góp mỗi người 1 tí vào cho có cái thư viện entmake khủng nhỉ ^^
Ket bổ sung thêm 2 em nữa mà ít người dùng : Donut và Rtext
;============================
;Entmake Donut
;pt : center point
;rad : radius
;lay : layer
; clr : color
(defun ST:Entmake-Donut (pt rad lay clr)
(entmakex
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 2)
'(70 . 1)
(cons 8 lay)
(if clr (cons 62 clr)'(62 . 256))
(cons 43 rad)
(cons 10 (polar pt pi (/ rad 2.0)))
'(42 . 1.0)
(cons 10 (polar pt 0 (/ rad 2.0)))
'(42 . 1.0)
);;list
);;entmakex
)













;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Make Rtext
;Layer : layer RText
; insPt : insert Point
; tHeight : Rtext Height
; tStyle : Style
; tAng : rotate in Radian
; Text : content
; isDiesel (T/nil) : Diesel or not ? If not, it must be a file path
;(ST:Entmake-RText "$(getvar,dwgprefix)" (getvar "clayer") '(0 0) 2 (getvar "textstyle") 0 Nil)
(defun ST:Entmake-RText (Text Layer insPt tHeight tStyle tAng isDiesel)
(if (not (vl-position "rtext.arx" (arx))) (arxload "RText.arx" nil))
(entmakex
(list '(0 . "RTEXT")
'(100 . "AcDbEntity")
'(100 . "RText")
(cons 8 Layer)
(cons 10 insPt)
(cons 40 tHeight)
(cons 7 tStyle)
(cons 50 tAng)
(cons 1 Text)
(cons 70 (cond (isDiesel 1)(T 0))) ;1 IS FOR DIESEL EXPRESSIONS
)
)
)

  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 22 August 2011 - 04:03 PM

hehehe, tôi về coi lại Help thì nó nói như vầy:

Notes on Using entmake

You cannot create viewport objects with entmake.

A group 66 code is honored only for insert objects (meaning attributes follow). For polyline entities, the group 66 code is forced to a value of 1 (meaning vertices follow), and for all other entities it takes a default of 0. The only entity that can follow a polyline entity is a vertex entity.

The group code 2 (block name) of a dimension entity is optional for the entmake function. If the block name is omitted from the entity definition list, AutoCAD creates a new one. Otherwise, AutoCAD creates the dimension using the name provided.


các thứ còn lại ko nói => có thể tạo dc chỉ là ta ko biết cách thôi. Ta ko lên mặt trăng dc nhưng chưa chắc là ko có cách đi lên đó. Hình đã gửi

Have fun!





  • 0

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#8 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 22 August 2011 - 07:41 PM

- Dùng command, entmake, hay VL đều được , miễn sao ta cảm thấy thoả mãn và hợp túi tiền :) Đó là lý do cùng 1 lúc vẫn tồn tại xe đạp - xe máy - ô tô - máy bay - xe bò - giày thể thao...
@bác Thiệp : theo em thì cái gì đã làm được bằng Entmake rồi thì không nên viết sang Vla nữa :), cái gì khó quá thì mới invoke như ý bác. Xét về mặt tốc độ thì entmake nhanh hơn Vla ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#9 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 23 August 2011 - 07:52 AM

Tạo Block Dynamic -> Entmake không làm được chứ không phải là dễ dàng tạo được. Với command thì đơn giản : tạo 1 block Dynamic theo ý thích rồi (Command "insert"....)

Tue_NV thử tạo 1 Dynamic Block là 1 line (có strecth parameters ở 2 đầu) sau đó dùng command insert vào rồi làm sao thay đổi được chiều dài (parameter) của Block đó?
Nếu dc thì Tue_NV chỉ giúp nha.
Thanks!



  • 0

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#10 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 23 August 2011 - 11:12 AM

Tue_NV thử tạo 1 Dynamic Block là 1 line (có strecth parameters ở 2 đầu) sau đó dùng command insert vào rồi làm sao thay đổi được chiều dài (parameter) của Block đó?
Nếu dc thì Tue_NV chỉ giúp nha.
Thanks!

Có 1 bất tiện nữa của Command so với entmake mà ít khi chúng ta để ý đến, nhưng hậu quả thì tương đối khủng khiếp. Nếu chúng ta sử dụng command quá nhiều lần trong 1 lênh lisp, khi kết quả của lệnh đó không làm bạn hài lòng thì bạn có thể dùng lệnh undo. => Chúc mừng, bạn có thời gian rảnh rỗi thưởng thức 1 ấm trà trong khi chờ undo xong. Nhưng nếu bạn đen đủi thì có thể cad của bạn sẽ treo cứng luôn đấy.

Theo như kiến thức nông cạn của mình thì Chúng ta chỉ thực hiện đuợc mỗi việc insert cái block đó bằng command. còn thay đổi nó thì vô fuơng. mà nếu chỉ mỗi việc insert nó vào bản vẽ thôi thì entmake cũng chẳng có gì là fức tạp so với command cả. Mình đã thấy có nguời viết đuợc hàm thay đổi các thông số động của Dynamic Block, bằng VLA thì phải.

Bác Tue_NV chắc chưa bg viết cái gì đó mà phải tạo ra con số hàng nghìn hay hàng chục nghìn đối tượng nên bác chấp nhận được command và trung thành với nó. hoặc có thể bác là người dễ tính, sống đơn giản (hơi chủ quan tý) <_<
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#11 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 23 August 2011 - 12:33 PM

@bác Thiệp : theo em thì cái gì đã làm được bằng Entmake rồi thì không nên viết sang Vla nữa :), cái gì khó quá thì mới invoke như ý bác. Xét về mặt tốc độ thì entmake nhanh hơn Vla ^^

Ơ cái bài viết mình đâu nhỉ? Chắc là lâu quá, ít ghé thăm Cadviet nên bài viết mình là rác mất rồi!
@ketxu: Có thể entmake nhanh hơn Vl, nhưng cũng chỉ nhanh hơn 1 chút thôi, vì Vl hơi phức tạp hơn, Nhưng thói quen tạo đối tượng bằng Vl vì khỏi phải nhớ các con số DXF. Sau khi tạo OBJ xong chúng ta tạo thuộc tính của nó sau. Chính nhờ help trong VL cũng rõ hơn, nên mình đọc và tạo được các OBJ phức tạp mà entmake chịu bó tay.
  • 0

#12 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 23 August 2011 - 01:20 PM

Theo như kiến thức nông cạn của mình thì Chúng ta chỉ thực hiện đuợc mỗi việc insert cái block đó bằng command. còn thay đổi nó thì vô fuơng. mà nếu chỉ mỗi việc insert nó vào bản vẽ thôi thì entmake cũng chẳng có gì là fức tạp so với command cả. Mình đã thấy có nguời viết đuợc hàm thay đổi các thông số động của Dynamic Block, bằng VLA thì phải.

Đây là 2 function get và put dynamic Block Properties ko nhớ tìm dc ở đâu mọi ng test thử xem có xài dc ko nhe Hình đã gửi


;put-block-property
;;function to retrieve a dynamic block property
(defun put-block-property (obj index property value / n)
(setq n (vlax-safearray-get-element
(vlax-variant-value (vla-getdynamicblockproperties obj))
index
)
)
(vlax-put-property n property value)
)

;get-block-property
(defun get-block-property (obj index property value / n)
(setq n (vlax-safearray-get-element
(vlax-variant-value (vla-getdynamicblockproperties obj))
index
)
)
(vlax-get-property n property value)
)

  • 1

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#13 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 01 August 2012 - 11:33 PM

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

  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#14 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 12 November 2012 - 03:05 PM

[Hỏi]: Hàm MakeLWPolyline... ở #1.
Xin cho hỏi: Có thể thêm được thuộc tính width của polyline được không vậy các Bác?
Cám ơn rất nhiều!
  • 0

#15 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 12 November 2012 - 03:48 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.
  • 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.


#16 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 13 November 2012 - 07:14 AM

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

Có phải DXF 40 là Starting Width, 41 là Ending Width không? nhưng cho tôi hỏi là: khi thêm vào 2 cái này vẫn chưa có kết quả như mong muốn. Width của polyline (chưa có arc) vẫn mặc định là 0.
Cám ơn bác Ha đã quan tâm!
  • 0

#17 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 13 November 2012 - 07:58 AM

Lisp tạo Lwpolyline có xét cả width:

;================================= ;by HA (b&#230; sung width)
(defun MakeLWPolyline (lstpoint lstwidthd lstwidthc closed Linetype LTScale Layer Color xdata / Lst x)
(setq Lst
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
(cons 100 "AcDbPolyline")
(cons 90 (length lstpoint))
(cons 70 (if closed 0))))
(setq x 0)
(repeat (length lstpoint)
(setq Lst (append Lst (list (cons 10 (nth x lstpoint)) (cons 40 (nth x lstwidthd)) (cons 41 (nth x lstwidthc)))))
(setq x (1+ x)))
(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
(entmakex Lst))
(defun C:TEST()
(setq lstpoint (list '(40.3092 15.7668) '(44.9761 18.2347) '(49.094 15.8582)))
(setq lstwidthd '(0.11 0.33 0.44))
(setq lstwidthc '(0.22 0.44 0.44))
(setq closed 0)
(setq Linetype "Bylayer")
(setq Ltscale 1)
(setq Layer "0")
(setq Color 256)
(setq xdata nil)
(MakeLWPolyline lstpoint lstwidthd lstwidthc closed Linetype LTScale Layer Color xdata))
;EX:
;((-1 . <Entity name: 7ef96048>) (0 . "LWPOLYLINE") (330 . <Entity name: 7ef94cf8>) (5 . "B9") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
; (100 . "AcDbPolyline") (90 . 3) (70 . 0) (38 . 0.0) (39 . 0.0)
; (10 40.3092 15.7668) (40 . 0.11) (41 . 0.22) (42 . 0.0)
; (10 44.9761 18.2347) (40 . 0.33) (41 . 0.44) (42 . 0.0)
; (10 49.094 15.8582) (40 . 0.44) (41 . 0.44) (42 . 0.0)
; (210 0.0 0.0 1.0))

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


#18 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 - 09:54 AM

Năm mới chúc các Bác nhiều sức khỏe và Diễn đàn ngày một phát triển hơn!
Nhờ các Bác xem giúp đoạn code sau, mục đích của đoạn code là tạo 1 attribute nhưng vẫn chưa chạy được?

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

(princ)
)
(Princ "\nStart command with <1att>")
;;;;; Ham con tao att
(defun Make_att (LIST_ATT STYLE LAYER POINT HEIGHT ANG COLOR); 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 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

  • 0

#19 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 04 February 2013 - 11:09 AM

Phải bổ sung DXF 70 nữa. Đồng thời DXF 11 không cần.
  • 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.


#20 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:29 PM

Cám ơn bác HA đã quan tâm đến câu hỏi. Tuy nhiên, khi thêm "(cons 70 1)", kết quả vẫn không thay đổi. Vậy cons 70 gán =?
  • 0