Đến nội dung


Hình ảnh
- - - - -

Giup viet lisp


  • Please log in to reply
11 replies to this topic

#1 nguyenkhanhlucky

nguyenkhanhlucky

    biết vẽ line

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

Đã gửi 01 November 2013 - 08:12 AM

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.c..._sang_excel.rar

http://www.cadviet.c...d33333333_1.pdf


  • 0

#2 nguyenkhanhlucky

nguyenkhanhlucky

    biết vẽ line

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

Đã gửi 12 November 2013 - 10:42 AM

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


  • 0

#3 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 12 November 2013 - 11:24 AM

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.c..._sang_excel.rar

http://www.cadviet.c...d33333333_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))

  • 1

#4 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 12 November 2013 - 12:02 PM

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.c...81_drawing1.dwg

http://www.cadviet.c...14381_book4.rar


  • 0

#5 nguyenkhanhlucky

nguyenkhanhlucky

    biết vẽ line

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

Đã gửi 12 November 2013 - 12:33 PM

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


  • 0

#6 Namvanvo

Namvanvo

    Edu level: li5

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

Đã gửi 12 November 2013 - 01:43 PM

(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é


  • 1

#7 nguyenkhanhlucky

nguyenkhanhlucky

    biết vẽ line

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

Đã gửi 12 November 2013 - 04:48 PM

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


  • 0

#8 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 12 November 2013 - 10:22 PM

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.c...hongkehh3_1.lsp

 

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


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#9 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 13 November 2013 - 07:15 AM

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


  • 0

#10 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 13 November 2013 - 01:18 PM

....

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

  • 1

#11 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 13 November 2013 - 05:06 PM

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.c...114381_05_1.dwg


  • 0

#12 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 20 November 2013 - 12:58 PM

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.c..._drawing1_1.dwg

Cám ơn


  • 0