Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
8 replies to this topic

#1 18011985

18011985

    biết lệnh properties

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

Đã gửi 11 August 2011 - 08:41 AM

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.
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 11 August 2011 - 09:50 AM

Massprop có chế độ ghi file, bác ghi kết quả ra file rồi truy xuất nó thôi.
  • 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


#3 18011985

18011985

    biết lệnh properties

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

Đã gửi 11 August 2011 - 09:52 AM

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ì.
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 11 August 2011 - 09:54 AM

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


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


#5 quan08

quan08

    biết vẽ pline

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

Đã gửi 14 August 2011 - 06:38 PM

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

#6 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 15 August 2011 - 11:44 AM

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)

  • 3

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


#7 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 16 August 2011 - 08:53 AM

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

  • 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


#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 16 August 2011 - 09:08 AM

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


#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 16 August 2011 - 12:56 PM

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