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

[Thaistreetz 539]

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:

Quote

==================================================

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

[Detailing 281]

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

[hochoaivandot 111]

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?

[phamngoctukts 714]

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

[hochoaivandot 111]

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

[ketxu 2.984]

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

[Detailing 281]

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 đó.

 

Have fun!

 

 

 

 

 

[ketxu 2.984]

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

[Detailing 281]

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!

 

 

 

[Thaistreetz 539]

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

[thiep 365]

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

[Detailing 281]

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

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

[Thaistreetz 539]

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

[luckylucke_2009 0]

[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!

[Doan Van Ha 3.190]

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

[luckylucke_2009 0]

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

[Doan Van Ha 3.190]

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

;================================= ;by HA (bæ 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))

[luckylucke_2009 0]

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

[Doan Van Ha 3.190]

Phải bổ sung DXF 70 nữa. Đồng thời DXF 11 không cần.

[luckylucke_2009 0]

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 =?

[Doan Van Ha 3.190]

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

[luckylucke_2009 0]

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!!??

[Doan Van Ha 3.190]

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

[luckylucke_2009 0]

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!

[Chiron 94]

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.