Đến nội dung


Hình ảnh
- - - - -

[Yêu Cầu] Lisp Đánh Dấu Rectange, Thống Kê Độ Dài Rectange Và Xuất Ra Excell.


  • Please log in to reply
12 replies to this topic

#1 illumina

illumina

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 29 June 2015 - 04:12 PM

Chả là em đang phải bóc tách khối lượng phần cấp thoát nước, cơ mà bên thiết kế cứ thay đổi bản vẽ liên tục khiến cho em phải bóc đi bóc lại rất mệt mỏi  :(. Em muốn nhờ các pro dành chút thời gian làm hộ em cái lisp như sau ạ:

_  Tự động đánh dấu thứ tự ống nước (ống nước em sẽ vẽ là một rectange) là d1, d2, d3.

_ Thống kê chiều dài của ống nước (sẽ là độ dài cạnh dài hơn của rectange).

==> Xuất ra file excell với các cột là tên ống, layer, độ dài.

Mong các pro giúp em với, chỉ cần 1 trong 2 yêu cầu em cũng xin cảm ơn ạ.  :D

Dưới đây là file mẫu autocad ạ.

http://www.cadviet.c...thoat_xam_1.dwg


  • -1

#2 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 29 June 2015 - 04:55 PM

Chả là em đang phải bóc tách khối lượng phần cấp thoát nước, cơ mà bên thiết kế cứ thay đổi bản vẽ liên tục khiến cho em phải bóc đi bóc lại rất mệt mỏi  :(. Em muốn nhờ các pro dành chút thời gian làm hộ em cái lisp như sau ạ:

_  Tự động đánh dấu thứ tự ống nước (ống nước em sẽ vẽ là một rectange) là d1, d2, d3.

_ Thống kê chiều dài của ống nước (sẽ là độ dài cạnh dài hơn của rectange).

==> Xuất ra file excell với các cột là tên ống, layer, độ dài.

Mong các pro giúp em với, chỉ cần 1 trong 2 yêu cầu em cũng xin cảm ơn ạ.  :D

Dưới đây là file mẫu autocad ạ.

http://www.cadviet.c...thoat_xam_1.dwg

Hề hề hề,

Tên ống lây ở đâu??? Hay là cứ bịa ra???

Số thứ tự ống được quy định thế nào ??? Hay là cứ uýnh bừa???


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

#3 illumina

illumina

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 29 June 2015 - 05:24 PM

Tên ống chính là d1,d2,d3 đó anh admin đẹp zai :3. Số thứ tự ống uýnh bừa cũng được anh :3, miễn là trong một bản vẽ số thứ tự ko trùng nhau là được, kiểu như từ 1 đến n ấy, cón ống nào là 1, ống nào là n thì ko cần quan tâm đâu ạ. Chủ yếu cần đánh số ống chính là để phân biệt được ống này dài nhiêu, ống kia dài nhiêu, từ đó còn bóc vật tư theo chiều dọc nữa ạ. Nếu không đánh số ống thì chỉ biết được tổng độ dài thôi. :D


  • 0

#4 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 671 Bài viết
Điểm đánh giá: 313 (khá)

Đã gửi 29 June 2015 - 05:58 PM

Bạn thử nhé!
(defun c:test (/ wtxt ang color dis1 dis2 len0pl list-len list_pl lst-ppl pot ss2ent style)
(defun wtxt (string Point Height Ang Layer / Lst)
(setq Lst (list '(0 . "TEXT")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 10 point)
(cons 40 Height)
(cons 41 0.6)
(cons 1 string)
(if Ang (cons 50 Ang))
(cons 7 (if Style Style (getvar "Textstyle")))))
(setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2))))
(entmake Lst))
;;---------------
(setq list-len '())
(if (setq ss2ent (ssget '((0 . "*POLYLINE"))))
(progn (setq list_pl (acet-ss-to-list ss2ent))
(foreach plent list_pl
(setq lst-ppl (cdr (acet-geom-vertex-list plent)))
(setq dis1 (distance (car lst-ppl) (cadr lst-ppl))
dis2 (distance (cadr lst-ppl) (caddr lst-ppl))
len0pl (max dis1 dis2))
(if (eq len0pl dis1)
(setq ang (angle (car lst-ppl) (cadr lst-ppl)))
(setq ang (angle (cadr lst-ppl) (caddr lst-ppl))))
(cond ((<= ang (* 0.5 pi)) (setq ang ang))
((<= ang (* pi 1.5)) (setq ang (+ ang (* pi 1.0))))
((< ang (* pi 2.0)) (setq ang ang)))
(setq pot (polar (car lst-ppl)
(angle (car lst-ppl) (caddr lst-ppl))
(* (distance (car lst-ppl) (caddr lst-ppl)) 0.5)))
(wtxt (strcat "D" (itoa (1+ (vl-position plent list_pl))) " - L=" (rtos len0pl))
pot
(getvar "textsize")
ang
"AN-NONG")
(setq list-len (append list-len (list len0pl))))))
(princ))

  • 1

#5 illumina

illumina

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 29 June 2015 - 09:08 PM

Tuyệt vời lắm anh ơi :)), gần như đúng y chang ý em rồi. Còn một vấn đề nhỏ là làm sao để chữ nó to lên hả anh, to lên khoảng 100 lần. Thực ra em ko rõ lắm về mấy cái tỉ lệ trong bản vẽ :D.

Tks anh nhiều lắm ạ.


  • 0

#6 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 671 Bài viết
Điểm đánh giá: 313 (khá)

Đã gửi 29 June 2015 - 09:14 PM

Bạn đặt biến Textsize bằng bao nhiêu tùy ý (gõ Textsize vào dòng command).


  • 1

#7 illumina

illumina

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 29 June 2015 - 09:24 PM

Em làm được rồi ạ :D, với cho em hỏi có cách nào xuất thông số này ra excell không ạ, vì em thường làm việc với độ hơn 100 đường ống này mỗi tầng. Ngồi thống kê không chắc die quớ :D


  • 0

#8 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 671 Bài viết
Điểm đánh giá: 313 (khá)

Đã gửi 29 June 2015 - 09:28 PM

Có, nhưng phải viết thêm.  :D


  • 1

#9 illumina

illumina

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 29 June 2015 - 09:35 PM

*Cúi người* *Năn nỉ* *Tung hoa*  :lol:


  • 0

#10 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 671 Bài viết
Điểm đánh giá: 313 (khá)

Đã gửi 29 June 2015 - 10:29 PM

Kiếm được nhánh hoa mà toát cả mồ hôi.
(defun c:test (/ wtxt color dis1 dis2 len0pl list-len list_pl lst-ppl pot ss2ent style lst-stt lst lay LM:writecsv LM:lst->csv LM:csv-addquotes)
(defun LM:writecsv (lst csv / des sep)
(if (setq des (open csv "w"))
(progn (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList"))
(",")))
(foreach row lst (write-line (LM:lst->csv row sep) des))
(close des)
t)))
(defun LM:lst->csv (lst sep)
(if (cdr lst)
(strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
(LM:csv-addquotes (car lst) sep)))
(defun LM:csv-addquotes (str sep / pos)
(cond ((wcmatch str (strcat "*[`" sep "\"]*"))
(setq pos 0)
(while (setq pos (vl-string-position 34 str pos))
(setq str (vl-string-subst "\"\"" "\"" str pos)
pos (+ pos 2)))
(strcat "\"" str "\""))
(str)))
(defun wtxt (string Point Height Ang Layer / Lst)
(setq Lst (list '(0 . "TEXT")
(cons 8
(if Layer
Layer
(getvar "Clayer")))
(cons 10 point)
(cons 40 Height)
(cons 41 0.6)
(cons 1 string)
(if Ang
(cons 50 Ang))
(cons 7
(if Style
Style
(getvar "Textstyle")))))
(setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2))))
(entmake Lst))
;;--- MAIN ---
(setq list-len '())
(if (setq ss2ent (ssget '((0 . "*POLYLINE"))))
(progn (setq list_pl (acet-ss-to-list ss2ent))
(foreach plent list_pl
(setq lst-ppl (cdr (acet-geom-vertex-list plent)))
(setq dis1 (distance (car lst-ppl) (cadr lst-ppl))
dis2 (distance (cadr lst-ppl) (caddr lst-ppl))
len0pl (max dis1 dis2))
(if (eq len0pl dis1)
(setq ang (angle (car lst-ppl) (cadr lst-ppl)))
(setq ang (angle (cadr lst-ppl) (caddr lst-ppl))))
(cond ((<= ang (* 0.5 pi)) (setq ang ang))
((<= ang (* pi 1.5)) (setq ang (+ ang (* pi 1.0))))
((< ang (* pi 2.0)) (setq ang ang)))
(setq pot (polar (car lst-ppl)
(angle (car lst-ppl) (caddr lst-ppl))
(* (distance (car lst-ppl) (caddr lst-ppl)) 0.5)))
;;(wtxt (strcat "D" (itoa (1+ (vl-position plent list_pl))) " - L=" (rtos len0pl)) pot (getvar "textsize") ang "AN-NONG")
(setq lay (cdr (assoc 8 (entget plent))))
(setq lst-stt (list (strcat "D" (itoa (1+ (vl-position plent list_pl)))) (rtos len0pl) lay))
(setq lst (append lst (list lst-stt))))))
(if (setq fn (getfiled "Create Output File" "" "csv" 1))
(progn
(repeat (setq in (length lst)))
(if (LM:WriteCSV lst fn)
(startapp "explorer" fn))))
(princ))

  • 1

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 29 June 2015 - 10:33 PM

*Cúi người* *Năn nỉ* *Tung hoa*  :lol:

 Nhiều thứ quá, mà mỗi thứ đơn giản nhất là nhấn "like" cũng quên mấy bận.


  • 2

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


#12 illumina

illumina

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 30 June 2015 - 05:11 AM

Kiếm được nhánh hoa mà toát cả mồ hôi.
 

Cảm ơn bác nhiều lắm  :D  , không có bác chắc e chịu không kịp tiến độ luôn. Sau đợt này chắc mày mò học lập trình líp quá  :D


  • 0

#13 illumina

illumina

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 30 June 2015 - 05:15 AM

Tại em không biết là forum mình có like đó bác :D, tại em để ý không thấy mấy cái kiểu như "abc like this, xyz like this" :D. H mới biết hóa ra có cái nút +1 :'(


  • 0