Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
18011985

[Yêu cầu lisp] Lsp lấy dữ liệu lệnh Massprop

Các bài được khuyến nghị

18011985    61

Các bạn biết cách lấy dữ liệu của massprop không? Chỉ cho mình với trong trường hợp massprop tạo bởi hai đối tượng.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
18011985    61

mình bị vướng phần space không hiểu ký hiệu của nó là gì để lọc nếu là tab thì là "\t" còn spaces chưa bí hì hì.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.678

Các bạn biết cách lấy dữ liệu của massprop không? Chỉ cho mình với trong trường hợp massprop tạo bởi hai đối tượng.

Hôm qua bạn hỏi, tôi đang mày mò tìm câu trả lời thì topic bị xoá, có lẽ do thiếu 2 từ [yêu cầu], vi phạm nội quy Cadviet. Đáng lẽ riêng trường hợp bạn thì Cadviet cần thông cảm mới đúng, nhưng chuyện lỡ rồi thì thôi. Hôm nay bạn hỏi lại với câu hỏi rộng hơn. Tuy nhiên, do mót được trên Cadviet cái này (của tác giả nào thì tôi quên lưu tên, sorry tác giả) nên tôi gởi lại cho bạn: đó là lsp tính trọng tâm của 1 REGION hoặc SOLID.

Từ cách tính trọng tâm của 1 hình bạn có thể tính được trọng tâm của n hình theo nguyên tắc cân bằng cánh tay đòn của tích số diện tích và điểm trọng tâm. Hy vọng bạn làm được.

Thân thương!

(defun C:TT ()
 (vl-load-com)
 (if (and (setq sel (entsel "\nChon Region hoac 3D Solid: "))
      (wcmatch (cdr (assoc 0 (entget (setq ent (car sel)))))
           "REGION,3DSOLID"))
   (progn
     (entmake
   (list
     (cons 0 "point")
     (cons    10
       (vlax-safearray->list
         (vlax-variant-value
           (vlax-get-property
             (vlax-ename->vla-object ent)
             'Centroid))))))
     (sssetfirst (ssadd (entlast)) (ssadd (entlast))))
   (alert "Hay chon doi tuong REGION hoac SOLID!"))
 (princ))

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
quan08    0

Hôm qua bạn hỏi, tôi đang mày mò tìm câu trả lời thì topic bị xoá, có lẽ do thiếu 2 từ [yêu cầu], vi phạm nội quy Cadviet. Đáng lẽ riêng trường hợp bạn thì Cadviet cần thông cảm mới đúng, nhưng chuyện lỡ rồi thì thôi. Hôm nay bạn hỏi lại với câu hỏi rộng hơn. Tuy nhiên, do mót được trên Cadviet cái này (của tác giả nào thì tôi quên lưu tên, sorry tác giả) nên tôi gởi lại cho bạn: đó là lsp tính trọng tâm của 1 REGION hoặc SOLID.

Từ cách tính trọng tâm của 1 hình bạn có thể tính được trọng tâm của n hình theo nguyên tắc cân bằng cánh tay đòn của tích số diện tích và điểm trọng tâm. Hy vọng bạn làm được.

Thân thương!

(defun C:TT ()
 (vl-load-com)
 (if (and (setq sel (entsel "\nChon Region hoac 3D Solid: "))
      (wcmatch (cdr (assoc 0 (entget (setq ent (car sel)))))
           "REGION,3DSOLID"))
   (progn
     (entmake
   (list
     (cons 0 "point")
     (cons    10
       (vlax-safearray->list
         (vlax-variant-value
           (vlax-get-property
             (vlax-ename->vla-object ent)
             'Centroid))))))
     (sssetfirst (ssadd (entlast)) (ssadd (entlast))))
   (alert "Hay chon doi tuong REGION hoac SOLID!"))
 (princ))

Bạn có thể viết giúp đoạn lisp tính trọng tâm của n hình như bạn nói được không?Mình không rành về lisp.Cảm ơn bạn trước.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.678

Bạn có thể viết giúp đoạn lisp tính trọng tâm của n hình như bạn nói được không?Mình không rành về lisp.Cảm ơn bạn trước.

Lisp dưới đây tính trọng tâm của n hình 2D kín (REGION,POLYLINE,LWPOLYLINE,SPLINE,CIRCLE,ELLIPSE). Riêng hình kín tạo bởi LINE thì chưa làm được. Lsp này dựa trên lsp của Bác Tue_NV (tính trọng tâm của 1 hình kín).

;----- Doan Van Ha
(defun C:TTT( / sl dtich1 ttam1 dtich2 ttam2 tiso)
(if (not cal) (arxload "geomcal"))
(princ "\nChon cac doi tuong kin can tim trong tam: ")
(setq sl (acet-ss-to-list (ssget '((-4 . "<or") (0 . "REGION") (0 . "POLYLINE") (0 . "LWPOLYLINE") (0 . "SPLINE") (0 . "CIRCLE") (0 . "ELLIPSE") (-4 . "or>")))))
(setq dtich1 0 ttam1 (list 0 0))
(foreach n sl
 (cond
  ((= (cdr (assoc 0 (entget n))) "REGION")
   (setq ttam2 (centre n))
   (command "area" "o" n)
   (setq dtich2 (getvar "area"))
   (command "u")
   (setq tiso (/ dtich1 (+ dtich1 dtich2)))
   (setq dtich1 (+ dtich1 dtich2) ttam1 (cal "plt(ttam2,ttam1,tiso)")))
  (T
   (command "region" n "")
   (setq ttam2 (centre (entlast)))
   (command "area" "o" (entlast))
   (setq dtich2 (getvar "area"))
   (command "u")  (command "u")
   (setq tiso (/ dtich1 (+ dtich1 dtich2)))
   (setq dtich1 (+ dtich1 dtich2) ttam1 (cal "plt(ttam2,ttam1,tiso)")))))
(command "point" ttam1))
;----- Tue_NV
(defun centre(dt / cen)
(vl-load-com)
(if (or (= (cdr (assoc 0 (entget dt))) "REGION") 
           (and (wcmatch (cdr (assoc 0 (entget dt))) "*POLYLINE")
 (= (cdr (assoc 70 (entget dt))) 1)))
      (if (and (wcmatch (cdr (assoc 0 (entget dt))) "*POLYLINE")
 (= (cdr (assoc 70 (entget dt))) 1))
           (progn
            (setq cen (vlax-get (car (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
     	                                      'addregion (list (vlax-ename->vla-object dt)))) 'Centroid))
            (entdel (entlast)))
           (setq cen (vlax-get (vlax-ename->vla-object dt) 'Centroid))))    
cen)

  • Vote tăng 3

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.652

Đúng là bác ĐVH, đã đau đáu là cứ làm mãi ^^

Em cũng xin góp vui 1 code

;======= Insert Point in Centroid of each Closed Entity and All
;======= Ketxu 15-8 ============================================
(defun c:cen(/ cSet cLst oldSnp cCen cAre cmLst gCen)
(vl-load-com)
(grtext -1 "Free lisp from CADVIET @Ketxu")
(command "undo" "be")

;============== Local Functions ================================
(defun ST:Isclosed (en)(equal (vlax-curve-getEndPoint en)(vlax-curve-getStartPoint en) 1e-8))
(defun ST:SS-Filter (ss typeObj / ssRT) ; Filter ss type from another ss
(setq ssRT (ssadd))
(foreach en (ST:Ss->ListEnt ss)(if (wcmatch (cdadr (entget en)) typeObj)(setq ssRT (ssadd en ssRt)))) ssRT)

(defun ST:Ss->ListEnt (ss / n e l) ;Get list Ename of a ss
 (setq n (sslength ss)) (while (setq e (ssname ss (setq n (1- n))))(setq l (cons e l)))  
)

(defun ST:Entmake-Line (p1 p2 Color) ;Draw a Line from p1 to p2, with Color
(entmake (list (cons 0 "Line")(cons 10 (trans p1 1 0))(cons 11 (trans p2 1 0))(cons 62 Color)))
)
(defun ST:Entmake-Point (p Color)    ;Put a point in P with color
(entmake (list (cons 0 "Point")(cons 10 (trans p 1 0))(cons 62 Color)))
)
(defun ST:Entmake-Circle (p D Color)
(entmake (list (cons 0 "Circle")(cons 10 (trans p 1 0))(cons 40 D)(cons 62 Color)))
)
(defun ST:Entmake-SimpleText(txt p h tAng jt color / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq    sty   (getvar "textstyle") ) 
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h)(cons 1 txt) (cons 10 (trans p 1 0))(cons 62 color)(cons 73 2)(cons 11 (trans p 1 0))(cons 50  tAng)
(cons 72 (cond ((= jt "R")2) (T 0)))))
)
;================ Start Here =====================================
(princ "\n<<<Select Closed Region, 3Dsolid, PLine, SPline, Circle, Ellipse >>> ")
(if(setq cSet (ssget '((0 . "REGION,3DSOLID,*POLYLINE,SPLINE,CIRCLE,ELLIPSE"))))
   (progn      
(or (setq ssReg (ST:SS-Filter cSet "REGION,3DSOLID")) (setq ssReg (ssadd)))
	(setq ssOthers (ST:SS-Filter cset "*POLYLINE,SPLINE,CIRCLE,ELLIPSE") elast (entlast) ssRegCreate (ssadd)
	*model* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
		ssOthers  (mapcar 'vlax-ename->vla-object (ST:Ss->ListEnt ssOthers)))
	(foreach other ssOthers
		(if  (ST:isClosed other) 
			(setq ssRegCreate (ssadd (vlax-vla-object->ename (car (vlax-invoke *model* 'addregion (list other)))) ssRegCreate))
			)
	)
     (foreach en  (ST:Ss->ListEnt ssRegCreate)
	(setq ssreg (ssadd en ssreg))
	)	  
  (setq cLst (mapcar 'vlax-ename->vla-object (ST:Ss->ListEnt ssreg))
    oldSnp(getvar "OSMODE")
    )

   (mapcar 'setvar (list "OSMODE" "CMDECHO" "Delobj")(list 0 0 0))
   (foreach ent cLst
(if(vlax-property-available-p ent 'Centroid)
  (progn
    (setq cCen(vlax-get ent 'Centroid)
	  cAre(vlax-get ent 'Area)
	  cmLst(cons(list cCen cAre)cmLst)
	  ); end setq
           (ST:Entmake-Point cCen 1)
		(ST:Entmake-SimpleText (strcat "X = " (rtos (car ccen) 2 2))  (mapcar '+  cCen (list 0 (* 3 (getvar "textsize")) 0)) (getvar "textsize") 0 "L" 6) 
		(ST:Entmake-SimpleText (strcat "Y = " (rtos (cadr ccen) 2 2))  (mapcar '-  cCen (list 0 (* 3 (getvar "textsize")) 0)) (getvar "textsize") 0 "L" 6)
           ); end progn
  ); end if
); end foreach
   (if
     (and
cmLst
(/= 1(length cmLst))
); enad and
     (progn
(setq gCen
       (list
	 (/
	   (apply '+
	      (mapcar '*
		 (mapcar 'caar cmLst)(mapcar 'cadr cmLst)))
	   (apply '+ (mapcar 'cadr cmLst))
	   ); end /
	 (/
	   (apply '+
	      (mapcar '*
		 (mapcar 'cadar cmLst)(mapcar 'cadr cmLst)))
	   (apply '+ (mapcar 'cadr cmLst))
	   ); end /
	 ); end list
      ); end setq
(ST:Entmake-Circle  gCen (getvar "textsize") 3)
(ST:Entmake-Point  gCen  4)
(ST:Entmake-SimpleText (strcat "X = " (rtos (car gCen) 2 2)) (mapcar '+  gCen (list 0 (* 3.5 (getvar "textsize")) 0)) (* 6 (getvar "textsize")) 0 "L" 7)
(ST:Entmake-SimpleText (strcat "Y = " (rtos (cadr gCen) 2 2))  (mapcar '-  gCen (list 0 (* 3.5 (getvar "textsize")) 0)) (* 6 (getvar "textsize")) 0 "L" 7)
(foreach pt (mapcar 'car cmLst)
  (ST:Entmake-Line pt gCen 5)
  ); end foreach
); end progn
     ); end if
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1 1))
     ); end progn
   ); end if
(command ".erase" ssRegCreate "")
(command "undo" "en")
 (princ)
 ); end of c:cen

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.678

Đúng là bác ĐVH, đã đau đáu là cứ làm mãi ^^

Em cũng xin góp vui 1 code

;======= Insert Point in Centroid of each Closed Entity and All
;======= Ketxu 15-8 ============================================
(defun c:cen(/ cSet cLst oldSnp cCen cAre cmLst gCen)
(vl-load-com)
(grtext -1 "Free lisp from CADVIET @Ketxu")
(command "undo" "be")

;============== Local Functions ================================
(defun ST:SS-Filter (ss typeObj / ssRT) ; Filter ss type from another ss
(setq ssRT (ssadd))
(foreach en (ST:Ss->ListEnt ss)(if (wcmatch (cdadr (entget en)) typeObj)(setq ssRT (ssadd en ssRt)))) ssRT)

(defun ST:Ss->ListEnt (ss / n e l) ;Get list Ename of a ss
 (setq n (sslength ss)) (while (setq e (ssname ss (setq n (1- n))))(setq l (cons e l)))  
)

(defun ST:Entmake-Line (p1 p2 Color) ;Draw a Line from p1 to p2, with Color
(entmake (list (cons 0 "Line")(cons 10 (trans p1 1 0))(cons 11 (trans p2 1 0))(cons 62 Color)))
)
(defun ST:Entmake-Point (p Color)    ;Put a point in P with color
(entmake (list (cons 0 "Point")(cons 10 (trans p 1 0))(cons 62 Color)))
)
(defun ST:Entmake-Circle (p D Color)
(entmake (list (cons 0 "Circle")(cons 10 (trans p 1 0))(cons 40 D)(cons 62 Color)))
)
(defun ST:Entmake-SimpleText(txt p h tAng jt color / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq    sty   (getvar "textstyle") ) 
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h)(cons 1 txt) (cons 10 (trans p 1 0))(cons 62 color)(cons 73 2)(cons 11 (trans p 1 0))(cons 50  tAng)
(cons 72 (cond ((= jt "R")2) (T 0)))))
)
;================ Start Here =====================================
(princ "\n<<<Select Closed Region, 3Dsolid, PLine, SPline, Circle, Ellipse >>> ")
(if(setq cSet (ssget '((0 . "REGION,3DSOLID,*POLYLINE,SPLINE,CIRCLE,ELLIPSE"))))
   (progn      
(or (setq ssReg (ST:SS-Filter cSet "REGION,3DSOLID")) (setq ssReg (ssadd)))
	(setq ssOthers (ST:SS-Filter cset "*POLYLINE,SPLINE,CIRCLE,ELLIPSE") elast (entlast) ssRegCreate (ssadd)
	*model* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
		ssOthers  (mapcar 'vlax-ename->vla-object (ST:Ss->ListEnt ssOthers)))
	(foreach other ssOthers
		(if  (= :vlax-true(vla-get-Closed other)) 
			(setq ssRegCreate (ssadd (vlax-vla-object->ename (car (vlax-invoke *model* 'addregion (list other)))) ssRegCreate))
			)
	)
     (foreach en  (ST:Ss->ListEnt ssRegCreate)
	(setq ssreg (ssadd en ssreg))
	)	  
  (setq cLst (mapcar 'vlax-ename->vla-object (ST:Ss->ListEnt ssreg))
    oldSnp(getvar "OSMODE")
    )

   (mapcar 'setvar (list "OSMODE" "CMDECHO" "Delobj")(list 0 0 0))
   (foreach ent cLst
(if(vlax-property-available-p ent 'Centroid)
  (progn
    (setq cCen(vlax-get ent 'Centroid)
	  cAre(vlax-get ent 'Area)
	  cmLst(cons(list cCen cAre)cmLst)
	  ); end setq
           (ST:Entmake-Point cCen 1)
		(ST:Entmake-SimpleText (strcat "X = " (rtos (car ccen) 2 2))  (mapcar '+  cCen (list 0 (* 3 (getvar "textsize")) 0)) (getvar "textsize") 0 "L" 6) 
		(ST:Entmake-SimpleText (strcat "Y = " (rtos (cadr ccen) 2 2))  (mapcar '-  cCen (list 0 (* 3 (getvar "textsize")) 0)) (getvar "textsize") 0 "L" 6)
           ); end progn
  ); end if
); end foreach
   (if
     (and
cmLst
(/= 1(length cmLst))
); enad and
     (progn
(setq gCen
       (list
	 (/
	   (apply '+
	      (mapcar '*
		 (mapcar 'caar cmLst)(mapcar 'cadr cmLst)))
	   (apply '+ (mapcar 'cadr cmLst))
	   ); end /
	 (/
	   (apply '+
	      (mapcar '*
		 (mapcar 'cadar cmLst)(mapcar 'cadr cmLst)))
	   (apply '+ (mapcar 'cadr cmLst))
	   ); end /
	 ); end list
      ); end setq
(ST:Entmake-Circle  gCen (getvar "textsize") 3)
(ST:Entmake-Point  gCen  4)
(ST:Entmake-SimpleText (strcat "X = " (rtos (car gCen) 2 2)) (mapcar '+  gCen (list 0 (* 3.5 (getvar "textsize")) 0)) (* 6 (getvar "textsize")) 0 "L" 7)
(ST:Entmake-SimpleText (strcat "Y = " (rtos (cadr gCen) 2 2))  (mapcar '-  gCen (list 0 (* 3.5 (getvar "textsize")) 0)) (* 6 (getvar "textsize")) 0 "L" 7)
(foreach pt (mapcar 'car cmLst)
  (ST:Entmake-Line pt gCen 5)
  ); end foreach
); end progn
     ); end if
     (mapcar 'setvar (list "OSMODE" "CMDECHO")(list oldSnp 1 1))
     ); end progn
   ); end if
(command ".erase" ssRegCreate "")
(command "undo" "en")
 (princ)
 ); end of c:gecen

check thử bị lỗi như vầy Ketxu ơi:

Command: cen

undo Current settings: Auto = On, Control = All, Combine = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

<1>: be

Command:

<<<Select Closed Region, 3Dsolid, PLine, SPline, Circle, Ellipse >>>

Select objects: Specify opposite corner: 5 found

 

Select objects:

; error: ActiveX Server returned the error: unknown name: Closed

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.652

Ôi giờ mới ngồi được vào máy :(

Cái này Ket bảo sửa r mà lại post nhầm cái cũ, do các đường tròn, Ellipse thì không có Closed, nên bổ sung hàm Check closed chứ k dùng vla-get-closed nữa. Code đã gửi lại bên trên, rất srr mọi người ^^

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×