Giup viet lisp

[nguyenkhanhlucky 9]

Mong tìm được sự giúp đỡ, viết lisp theo file đính kèm, e có tìm một số lisp nhưng không theo yêu cầu công việc của e, xin mọi người giúp đỡ.

 

http://www.cadviet.com/upfiles/3/65580_giup_do_xuat_du_lieu_cad_sang_excel.rar

http://www.cadviet.com/upfiles/3/65580_untitled33333333_1.pdf

[nguyenkhanhlucky 9]

các pro lisp có thể giúp mình cách sử dụng đoạn code trên ko?, một bạn trên diễn đàn nước ngoài trả lời mình và gửi cho mình đoạn code mình ko biết phải sửa và thực hiện như thế nào mong các pro giúp đỡ,

 

Code:

(defun c:exwr (/ ar del elist en ent filename fn hgt i maxp minp obj per pmax
pmin rowdata wid xldata )
(setq i 0 )
(setq xldata (cons
(list "" "Length (mm)" "Width (mm)""Perimeter" "Area")xldata))
(while

(setq ent (entsel "\nSelect a rectangle one by another,
press Enter to stop loop: "))
(if
(and
(setq elist (entget (setq en (car ent))))
(eq (cdr (assoc
0 elist)) "LWPOLYLINE")
(= (cdr (assoc 70 elist)) 1)
(and
(> (cdr (assoc 90 elist)) 5)
(< (cdr
(assoc 90 elist)) 13)

)
)
(progn
(setq obj
(vlax-ename->vla-object en))

(vla-getboundingbox obj 'minp 'maxp)
(setq
pmin (vlax-safearray->list minp)
pmax
(vlax-safearray->list maxp))
(setq
wid (abs (- (car pmax) (car pmin)))

hgt (abs (- (cadr pmax) (cadr pmin)))

per (vla-get-length obj)
ar (vla-get-area
obj)
)
(setq
rowdata (list
(itoa (setq i (1+
i)))
(rtos wid 2
2)
(rtos hgt 2
2)
(rtos per 2
2)
(rtos ar 2
2)))
;; gather data in a
list
(setq xldata (append xldata (list
rowdata)))
)


(prompt "\nNothing or not closed pline
selected.")

)
)
(if (> (length xldata)
1)
(progn
;; put delimiter to suit:

(setq del "\t")


;; build your text file path here:

(setq filename (strcat (getvar
"dwgprefix")
(vl-filename-base (getvar
"dwgname"))

"_Dim.txt"))
(setq fn (open filename
"w"))
;; Write info to a file


(mapcar

'(lambda (x)
(write-line
(apply
'strcat
(append (list (car
x))
(mapcar '(lambda (y) (strcat del
y))
(cdr
x)
)

)
)

fn
)

)

xldata
)



(close
fn)
(gc)
;; just to see
a result
(startapp "notepad"
filename)


)
)
(alert "Open text file with Excel,\nthen save as
.xls or .xlsx file")
(princ)
)
(princ "\n\t***\tStart command
with EXWR \t***")
(princ)
(or (vl-load-com)(princ))

[gia_bach 1.549]

Mong tìm được sự giúp đỡ, viết lisp theo file đính kèm, e có tìm một số lisp nhưng không theo yêu cầu công việc của e, xin mọi người giúp đỡ.

 

http://www.cadviet.com/upfiles/3/65580_giup_do_xuat_du_lieu_cad_sang_excel.rar

http://www.cadviet.com/upfiles/3/65580_untitled33333333_1.pdf

Thử Lisp này xem sao ?

(defun c:entPro2Ex (/ col e i prolst pros row ss x xlapp xlcells)
  ;; By : Gia_Bach 2013 ;;
  (defun getProEnt(e / area bl heigh leng maxp minp obj tr width)
    (setq obj (vlax-Ename->Vla-Object e)
	  leng (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
	  area (vlax-curve-getArea obj))
    (vla-getBoundingBox obj 'minp 'maxp )
    (setq TR (vlax-safearray->list maxp) BL (vlax-safearray->list minp)
	  width (- (car TR) (car BL)) heigh(- (cadr TR) (cadr BL)))
    (list (rtos width 2 0) (rtos heigh 2 0) (rtos leng 2 0) (rtos area 2 0))  )
  ; main
  (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE"))))
    (progn
      (setq i -1)
      (repeat (sslength ss)
	(setq e (ssname ss (setq i (1+ i)))
	      pros (getProEnt e)
	      proLst (append proLst (list pros))))
      (setq xlApp (vlax-get-or-create-object "Excel.Application")
	    xlCells (vlax-get-property(vlax-get-property(vlax-get-property(vlax-invoke-method(vlax-get-property xlApp "Workbooks") "Add") "Sheets") "Item" 1) "Cells"))
      (setq col 2)
      (foreach pt (list "Length (mm)" "Witdth (mm)" "Perimeter" "Area")
	(vlax-put-property xlCells 'Item 1 col pt)
	(setq col (1+ col)))
      (setq col 1 row 2)	
      (foreach pt proLst
	(vlax-put-property xlCells 'Item row col (- row 1))
	(setq col (1+ col))
	(foreach str pt
	  (vlax-put-property xlCells 'Item row col str)
	  (setq col (1+ col)))
	(setq row (1+ row) col 1) )
      (vla-put-visible xlApp :vlax-true)
      (mapcar (function (lambda (x) (vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))	(list xlCells xlApp)) ))
  (princ))

[tientracdia 16]

Lisp entPro2Ex của anh gia_bach viết rất hay. Cám ơn

Khi chọn nhiều đa giác xuất ra execl thì trên exxcel có xuất phần số thứ tự. Mình không biết các đa giác đó hiện nằm trong vùng nào.

Anh có thể bổ sung việc đánh số đó vào cad theo đúng phần đã xuất giúp mình với.

http://www.cadviet.com/upfiles/3/114381_drawing1.dwg

http://www.cadviet.com/upfiles/3/114381_book4.rar

[nguyenkhanhlucky 9]

Cám ơn Gia_bach rất nhiều, đúng với cái mình cần, nó giúp cho công việc nhập liệu bên Excel của mình ko bị gõ nhầm, trên Lisp nếu có thề sửa được phần (Perimeter & Area) giữ đúng số dư bên cad thì tốt,

 

ví dụ:

Lisp của gia_bach

area bên cad = 479887.4470 khi qua excel =479887

 

sửa giữ số dư

area bên cad = 479887.4470 khi qua excel = 479887.4470

 

 

Vì phần đó mình cần đúng như số trong cad

[Namvanvo 44]

(list (rtos width 2 0) (rtos heigh 2 0) (rtos leng 2 0) (rtos area 2 0))

Bạn chuyển thành

(list (rtos width 2 4) (rtos heigh 2 4) (rtos leng 2 4) (rtos area 2 4))

để nó lấy 4 số thập phân như cad nhé

[nguyenkhanhlucky 9]

Thanks Namvanvo mình đã làm được và cám ơn bạn Gia_giabach đã giúp đỡ

chúc diễn đàn luôn thành công trong mọi vấn đề.

[phamthanhbinh 3.146]

Thanks Namvanvo mình đã làm được và cám ơn bạn Gia_giabach đã giúp đỡ

chúc diễn đàn luôn thành công trong mọi vấn đề.

Hề hề hề,

Lisp của bác GiaBach hay hơn cái lisp bạn post khá nhiều do nó xuất thẳng vào Excel và sử dụng được với nhiều loại đối tượng khác nhau.

Tuy nhiên cái lisp bạn post lên cũng rất tốt và nếu bạn muốn sử dụng nó thì cần lưu ý như sau:

1/- Chỉnh lý lại code cho gọn gàng và loại trừ các lỗi do việc ghi chú code. Điều này có thể bạn chưa làm được nên mình đã hiệu chỉnh lại và gửi kèm dưới đây. Sau đó bạn load lisp này vào CAD và sử dụng lệnh là exwr bình thường như mọi lisp khác

2/- Lisp này chỉ sử dụng với các hình được cấu tạo bởi 1 lwpolyline khép kín và có số đỉnh giới hạn từ 5 đến 13. Điều này bạn có thể thay đổi được trong đoạn code sau:

(and (> (cdr (assoc 90 elist)) 5) (< (cdr (assoc 90 elist)) 13)

Trong đó số 5 chỉ giới hạn dưới và số 13 chỉ giới hạn trên. Nhưng lưu ý phải là một lwpolyline khép kín.

3/- Lisp sẽ xuất kết quả vào file txt có đường dẫn trùng với đường dẫn của file CAD, tên file là tên của file cad và kèm theo hậu tố _Dim. Ví dụ :D:\Drawing\Bản vẽ 1_Dim.txt

Để xuất sang Excel bạn phải mở Excel ra rồi sử dụng nó để mở file txt nói trên. Sau đó saveas lại với đuôi xls hay csv túy ý.

 

Mình đã dùng thử và thấy rằng rất tốt với các lwpolyline khép kín, Tuy không hay bằng lisp của bác Gia Bach nhưng cũng rất có ích nhất là với những ai muốn tìm hiểu thêm về lisp.

 

http://www.cadviet.com/upfiles/3/5194_bangthongkehh3_1.lsp

 

@All: Sorry vì quên không đính kèm lissp đã hiệu đính

[tientracdia 16]

Chưa thấy bạn đưa lisp lên

[gia_bach 1.549]

....

Khi chọn nhiều đa giác xuất ra execl thì trên exxcel có xuất phần số thứ tự. Mình không biết các đa giác đó hiện nằm trong vùng nào.

Anh có thể bổ sung việc đánh số đó vào cad theo đúng phần đã xuất giúp mình với.

....

Update theo yêu cầu.

- chiều cao text lấy theo biến hệ thống TextSize

- số chữ số thập phân lấy theo biến hệ thống Luprec (giống như trong Cad)

(defun c:entPro2Ex (/ col i obj prolst pros row sosole spc ss x xlapp xlcells)
  ;; By : Gia_Bach 2013 ;;
  (vl-load-com)
  (defun getProEnt(obj sole / area bl cen heigh leng maxp minp obj tr width)
    (setq leng (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
	  area (vlax-curve-getArea obj))
    (vla-getBoundingBox obj 'minp 'maxp )
    (setq TR (vlax-safearray->list maxp) BL (vlax-safearray->list minp)
	  width (- (car TR) (car BL)) heigh(- (cadr TR) (cadr BL))
	  cen (mapcar '(lambda (a b) (/ (+ a b) 2.0)) TR BL))
    (list cen (rtos width 2 sole) (rtos heigh 2 sole) (rtos leng 2 sole) (rtos area 2 sole))  )
  ; main
  (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE"))))
    (progn
      (setq i -1 sosole (getvar "luprec"))
      (repeat (sslength ss)
	(setq obj (vlax-Ename->Vla-Object(ssname ss (setq i (1+ i))))
	      pros (getProEnt obj sosole)
	      proLst (append proLst (list pros))))
      (setq xlApp (vlax-get-or-create-object "Excel.Application")
	    xlCells (vlax-get-property(vlax-get-property(vlax-get-property(vlax-invoke-method(vlax-get-property xlApp "Workbooks") "Add") "Sheets") "Item" 1) "Cells"))
      (setq col 2 spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
      (foreach pt (list "Length (mm)" "Witdth (mm)" "Perimeter" "Area")
	(vlax-put-property xlCells 'Item 1 col pt)
	(setq col (1+ col)))
      (setq col 1 row 2 txtheight (getvar "TextSize"))
      (foreach pt proLst
	(vla-AddText spc (- row 1) (vlax-3D-point (car pt)) txtheight)
	(vlax-put-property xlCells 'Item row col (- row 1))
	(setq col (1+ col))
	(foreach str (cdr pt)
	  (vlax-put-property xlCells 'Item row col str)
	  (setq col (1+ col)))
	(setq row (1+ row) col 1) )
      (vla-put-visible xlApp :vlax-true)
      (mapcar (function (lambda (x) (vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))	(list xlCells xlApp)) ))
  (princ))

[tientracdia 16]

Trong đa giác có 3 cạnh thì việc tính toán diện tích và xuất ra excel thì có, nhưng việc ghi số thứ tự vào lại trong Cad không vào tâm của hình tam giác đó.

Xin nhờ Bạn giúp chỉnh đưa các texxt vào giữa tâm , Cám ơn

http://www.cadviet.com/upfiles/3/114381_05_1.dwg

[tientracdia 16]

 

Update theo yêu cầu.

- chiều cao text lấy theo biến hệ thống TextSize

- số chữ số thập phân lấy theo biến hệ thống Luprec (giống như trong Cad)

(defun c:entPro2Ex (/ col i obj prolst pros row sosole spc ss x xlapp xlcells)
  ;; By : Gia_Bach 2013 ;;
  (vl-load-com)
  (defun getProEnt(obj sole / area bl cen heigh leng maxp minp obj tr width)
    (setq leng (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
	  area (vlax-curve-getArea obj))
    (vla-getBoundingBox obj 'minp 'maxp )
    (setq TR (vlax-safearray->list maxp) BL (vlax-safearray->list minp)
	  width (- (car TR) (car BL)) heigh(- (cadr TR) (cadr BL))
	  cen (mapcar '(lambda (a b) (/ (+ a b) 2.0)) TR BL))
    (list cen (rtos width 2 sole) (rtos heigh 2 sole) (rtos leng 2 sole) (rtos area 2 sole))  )
  ; main
  (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE"))))
    (progn
      (setq i -1 sosole (getvar "luprec"))
      (repeat (sslength ss)
	(setq obj (vlax-Ename->Vla-Object(ssname ss (setq i (1+ i))))
	      pros (getProEnt obj sosole)
	      proLst (append proLst (list pros))))
      (setq xlApp (vlax-get-or-create-object "Excel.Application")
	    xlCells (vlax-get-property(vlax-get-property(vlax-get-property(vlax-invoke-method(vlax-get-property xlApp "Workbooks") "Add") "Sheets") "Item" 1) "Cells"))
      (setq col 2 spc (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
      (foreach pt (list "Length (mm)" "Witdth (mm)" "Perimeter" "Area")
	(vlax-put-property xlCells 'Item 1 col pt)
	(setq col (1+ col)))
      (setq col 1 row 2 txtheight (getvar "TextSize"))
      (foreach pt proLst
	(vla-AddText spc (- row 1) (vlax-3D-point (car pt)) txtheight)
	(vlax-put-property xlCells 'Item row col (- row 1))
	(setq col (1+ col))
	(foreach str (cdr pt)
	  (vlax-put-property xlCells 'Item row col str)
	  (setq col (1+ col)))
	(setq row (1+ row) col 1) )
      (vla-put-visible xlApp :vlax-true)
      (mapcar (function (lambda (x) (vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x)))))))	(list xlCells xlApp)) ))
  (princ))

Xin nhờ anh gia_bach giúp cho việc xuất nội dung từ excel sang cad them nội dung diện tích nằm dưới số thứ tụ.

http://www.cadviet.com/upfiles/3/114381_drawing1_1.dwg

Cám ơn