Đến nội dung


Hình ảnh
- - - - -

Lisp chèn block theo khoảng cách và xuất kết quả


  • Please log in to reply
8 replies to this topic

#1 huyhoa255

huyhoa255

    biết zoom

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

Đã gửi 23 July 2014 - 11:26 PM

Chào các bác, hiện tại em đang phải cắm cọc giải phóng mặt bằng và cọc lộ giới trên bình đồ, công việc với khối lượng khá nhiều mà lại phải làm thủ công, mất rất nhiều thời gian, em có gửi kèm file http://www.cadviet.c...3/53055_km0.dwg , các bác nghiên cứu giúp em được không ak, e cảm ơn nhiều.


  • 0

#2 huyhoa255

huyhoa255

    biết zoom

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

Đã gửi 24 July 2014 - 07:30 AM

Các bác giúp em được ko . Em phải làm mấy chục Km, khối lượng nhiều quá các bác ạ. :( . 


  • 0

#3 huyhoa255

huyhoa255

    biết zoom

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

Đã gửi 24 July 2014 - 10:12 PM

Có bác nào giúp em được không, em tìm mãi trên diễn đàn mà không có lisp nào phù hợp cả, tay to, mắt lồi dần rồi các bác ạ. :D


  • 0

#4 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 25 July 2014 - 02:21 AM

Bạn thử cái này, lưu định dạng .CVS

Lệnh là "camcoc"

Điểm chèn block đặt ở tâm nhé.

Muốn chọn lại chỗ lưu file csv  dùng lệnh "fn"

Muốn chọn lại block mẫu dùng lệnh "maublk"

(vl-load-com)
(defun c:fn ( / )
            (setq fn_camcoc (getfiled "Create Output File" "" "csv" 1))
);;; end defun fi
(defun c:maublk ( / camcoc_ten_blk1)
      (setq  camcoc_ten_blk1 (car (entsel "\nChon block ki hieu chen:")))
      (if (= (cdr (assoc 0 (entget camcoc_ten_blk1))) "INSERT")
        (progn
        (setq camcoc_ten_blk (cdr (assoc 2 (entget camcoc_ten_blk1))))
        (setq XscFactor (vlax-get-property (vlax-ename->vla-object camcoc_ten_blk1) 'XEFFECTIVESCALEFACTOR))
        (setq YscFactor (vlax-get-property (vlax-ename->vla-object camcoc_ten_blk1) 'YEFFECTIVESCALEFACTOR))
        )
        (alert "\nChua chon duoc block mau!")
      );;;end IF
);;; end defun fi

(defun c:camcoc ( / camcoc_gocquay COC EL1 GOC LIST_DON LIST_TONG OSMLAST PHIA_CAM PT10 PT11 PT_CHO_CAM_COC PT_MID TOA_DO_X TOA_DO_Y)
      (setq    OSMLAST    (getvar "osmode"))
      (setq list_tong (list)
      )
(if (null camcoc_khoang_cach)      
    (setq camcoc_khoang_cach 5)
)      
(if (null camcoc_ten_blk)      
      (c:maublk)
)
      ;(setq list_don (list))
(if
      (setq  coc (car (entsel "\nChon coc:")))
      (progn
      (if (= (cdr (assoc 0 (entget coc))) "LINE")
          (progn
              (setq pt_mid  ( mid (setq pt10 (cdr (assoc 10 (entget coc)))) (setq pt11(cdr (assoc 11 (entget coc))))));;;setq
          );;;progn
      );;;end IF
      ;(setq camcoc_khoang_cach (getreal "\nNhap khoang cach: "));;;setq
      ;(setq camcoc_khoang_cach (duy:xd_gts camcoc_khoang_cach camcoc_khoang_cach "\nNhap khoang cach: "))
      (setq camcoc_khoang_cach (duy:xd_gts gtn camcoc_khoang_cach "Nhap khoang cach:"))
      (setq phia_cam (getpoint pt_mid "\nChon phia cam: ") );;;setq
      (setvar "osmode" 0)
      (setq goc (angle pt_mid phia_cam))
      (setq pt_cho_cam_coc (polar pt_mid goc camcoc_khoang_cach));;;setq
      (setq camcoc_gocquay (RTD (- goc (/ pi 2))))
      (command "_.insert" camcoc_ten_blk pt_cho_cam_coc XscFactor YscFactor camcoc_gocquay)
      (setq el1 (entlast))
      ;(vlax-put-property (vlax-ename->vla-object el1) 'XEFFECTIVESCALEFACTOR XscFactor)
      ;(vlax-put-property (vlax-ename->vla-object el1) 'YEFFECTIVESCALEFACTOR YscFactor)
      (command "_.dimaligned" pt_mid (cdr (assoc 10 (entget el1))) (polar pt_mid (+ goc (/ pi 2)) 8))
      (setq toa_do_x  (rtos (cadr (assoc 10 (entget el1))) 2 3));;;setq
      (setq toa_do_y  (rtos (caddr (assoc 10 (entget el1))) 2 3));;;setq
      (setq list_don (list (rtos camcoc_khoang_cach 2 10) toa_do_y toa_do_x));;;setq
      (setq list_tong (append  list_tong (list list_don)));;;setq
      ;(princ list_tong);;;princ
(while (null fn_camcoc)
            (c:fn)
);;; end If
      (LM:WriteCSV list_tong fn_camcoc);      
      ;(startapp "explorer" fn)
      (setvar "osmode" OSMLAST)
        (princ)
      )    
(progn
      (princ "\nChon chua dung");;;princ
(princ)      
)
)
);;; end defun c:camcoc
(defun RTD (x) (/ (* x 180) pi) )
(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)
(defun LM:writecsv ( lst csv / des sep )
    (if (setq des (open csv "a"))
        (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
        )
    )
)

;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token

(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 duy:xd_gts (gtn gtmd mdich / gtn gtmd mdich)
(or gtn (setq gtn gtmd))
(setq gtn (cond ((getreal (strcat "\n" mdich " < " (rtos gtn 2 2) " >:")))(gtn)))
gtn)

  • 1

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#5 huyhoa255

huyhoa255

    biết zoom

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

Đã gửi 25 July 2014 - 06:26 AM

Cám ơn bác nguyentuyen6 quan tâm và giúp đỡ em, bác online muộn thế  :)

Em mới dùng lisp của bác viết, nhưng kết quả vẫn chưa đúng bác ạ, cụ thể là:

- Ở bước "chọn cọc" em chọn vào cọc H3 thì nó có hiểu là chọn vào giữa cọc không bác?

- Ở bước "chọn phía cắm" ý em là mình chọn điểm đầu, điểm cuối của hướng đó, vì sẽ có những cọc bị xiên ạ

- Khi insert ra block em thấy kích thước bị nhỏ đi và khoảng cách không đúng bác à.

- Em muốn kết quả thể hiện luôn khoảng cách từ cọc đến block như trên hình vẽ bác ạ

Hic, bác kiểm tra lại giúp em với. Cảm ơn bác nhiều!!!!!!! 


  • 0

#6 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 25 July 2014 - 12:53 PM

Cám ơn bác nguyentuyen6 quan tâm và giúp đỡ em, bác online muộn thế  :)

Em mới dùng lisp của bác viết, nhưng kết quả vẫn chưa đúng bác ạ, cụ thể là:

- Ở bước "chọn cọc" em chọn vào cọc H3 thì nó có hiểu là chọn vào giữa cọc không bác?

- Ở bước "chọn phía cắm" ý em là mình chọn điểm đầu, điểm cuối của hướng đó, vì sẽ có những cọc bị xiên ạ

- Khi insert ra block em thấy kích thước bị nhỏ đi và khoảng cách không đúng bác à.

- Em muốn kết quả thể hiện luôn khoảng cách từ cọc đến block như trên hình vẽ bác ạ

Hic, bác kiểm tra lại giúp em với. Cảm ơn bác nhiều!!!!!!! 

Bạn down lại ở bài trên của mình nhé!

Bạn chọn cọc H3 thì nó nhận là trung điểm của cọc.

Khoảng cách không đúng là do mình quên tắt bắt điểm

p/s: Thêm giá trị mặc định


  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#7 huyhoa255

huyhoa255

    biết zoom

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

Đã gửi 25 July 2014 - 09:40 PM

Cám ơn  bác Nguyentuyen6, bác thật nhiệt tình, Lisp bác viết giúp em làm nhanh hơn rất nhiều rồi ạ :P . Chúc bác và mọi người trong diễn đàn dồi dào sức khỏe, xây dựng diễn đàn ngày một lớn mạnh.


  • 0

#8 trungputin2003

trungputin2003

    biết vẽ line

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

Đã gửi 26 July 2014 - 10:18 AM

Em vào Cadviet nhiều, bài của Bác thuộc top đỉnh cao. ngưỡng mộ.

nhờ các Bác giúp em với.

Em đang có vấn đề là:

Bản vẽ em có rất nhiều text em muốn xuất các text này sang Excel để sửa các giá trị text này, sau đó nhập lại các text mới này thay text cũ vào cad (các text vẫn đúng vị trí nhưng thay đổi giá trị) 

Chân thành Cảm ơn các Bác nhiều nha.

Em đang có vấn đề này nhờ Bác xem giúp cho.
Bản vẽ em đang có rất nhiều text em muốn xuất sang Excel để sửa nội dung sau đó nhập lại các text mới này thay cho các text cũ (vẫn đúng vị trí text cũ nhưng nội dung là mới.
Nhờ Bác nghiên cứu giúp cho.Cảm ơn Bác nhiều nha.
Không biết Bác có nhận được tin nhắn này hay không nên em gửi lại nội dung qua Yahoo cho Bác nhé.

  • 0

#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 12 September 2014 - 04:15 PM

Bạn thử cái này, lưu định dạng .CVS

Lệnh là "camcoc"

Điểm chèn block đặt ở tâm nhé.

Muốn chọn lại chỗ lưu file csv  dùng lệnh "fn"

Muốn chọn lại block mẫu dùng lệnh "maublk"

(vl-load-com)
(defun c:fn ( / )
            (setq fn_camcoc (getfiled "Create Output File" "" "csv" 1))
);;; end defun fi
(defun c:maublk ( / camcoc_ten_blk1)
      (setq  camcoc_ten_blk1 (car (entsel "\nChon block ki hieu chen:")))
      (if (= (cdr (assoc 0 (entget camcoc_ten_blk1))) "INSERT")
        (progn
        (setq camcoc_ten_blk (cdr (assoc 2 (entget camcoc_ten_blk1))))
        (setq XscFactor (vlax-get-property (vlax-ename->vla-object camcoc_ten_blk1) 'XEFFECTIVESCALEFACTOR))
        (setq YscFactor (vlax-get-property (vlax-ename->vla-object camcoc_ten_blk1) 'YEFFECTIVESCALEFACTOR))
        )
        (alert "\nChua chon duoc block mau!")
      );;;end IF
);;; end defun fi

(defun c:camcoc ( / camcoc_gocquay COC EL1 GOC LIST_DON LIST_TONG OSMLAST PHIA_CAM PT10 PT11 PT_CHO_CAM_COC PT_MID TOA_DO_X TOA_DO_Y)
      (setq    OSMLAST    (getvar "osmode"))
      (setq list_tong (list)
      )
(if (null camcoc_khoang_cach)      
    (setq camcoc_khoang_cach 5)
)      
(if (null camcoc_ten_blk)      
      (c:maublk)
)
      ;(setq list_don (list))
(if
      (setq  coc (car (entsel "\nChon coc:")))
      (progn
      (if (= (cdr (assoc 0 (entget coc))) "LINE")
          (progn
              (setq pt_mid  ( mid (setq pt10 (cdr (assoc 10 (entget coc)))) (setq pt11(cdr (assoc 11 (entget coc))))));;;setq
          );;;progn
      );;;end IF
      ;(setq camcoc_khoang_cach (getreal "\nNhap khoang cach: "));;;setq
      ;(setq camcoc_khoang_cach (duy:xd_gts camcoc_khoang_cach camcoc_khoang_cach "\nNhap khoang cach: "))
      (setq camcoc_khoang_cach (duy:xd_gts gtn camcoc_khoang_cach "Nhap khoang cach:"))
      (setq phia_cam (getpoint pt_mid "\nChon phia cam: ") );;;setq
      (setvar "osmode" 0)
      (setq goc (angle pt_mid phia_cam))
      (setq pt_cho_cam_coc (polar pt_mid goc camcoc_khoang_cach));;;setq
      (setq camcoc_gocquay (RTD (- goc (/ pi 2))))
      (command "_.insert" camcoc_ten_blk pt_cho_cam_coc XscFactor YscFactor camcoc_gocquay)
      (setq el1 (entlast))
      ;(vlax-put-property (vlax-ename->vla-object el1) 'XEFFECTIVESCALEFACTOR XscFactor)
      ;(vlax-put-property (vlax-ename->vla-object el1) 'YEFFECTIVESCALEFACTOR YscFactor)
      (command "_.dimaligned" pt_mid (cdr (assoc 10 (entget el1))) (polar pt_mid (+ goc (/ pi 2)) 8))
      (setq toa_do_x  (rtos (cadr (assoc 10 (entget el1))) 2 3));;;setq
      (setq toa_do_y  (rtos (caddr (assoc 10 (entget el1))) 2 3));;;setq
      (setq list_don (list (rtos camcoc_khoang_cach 2 10) toa_do_y toa_do_x));;;setq
      (setq list_tong (append  list_tong (list list_don)));;;setq
      ;(princ list_tong);;;princ
(while (null fn_camcoc)
            (c:fn)
);;; end If
      (LM:WriteCSV list_tong fn_camcoc);      
      ;(startapp "explorer" fn)
      (setvar "osmode" OSMLAST)
        (princ)
      )    
(progn
      (princ "\nChon chua dung");;;princ
(princ)      
)
)
);;; end defun c:camcoc
(defun RTD (x) (/ (* x 180) pi) )
(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)
(defun LM:writecsv ( lst csv / des sep )
    (if (setq des (open csv "a"))
        (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
        )
    )
)

;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token

(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 duy:xd_gts (gtn gtmd mdich / gtn gtmd mdich)
(or gtn (setq gtn gtmd))
(setq gtn (cond ((getreal (strcat "\n" mdich " < " (rtos gtn 2 2) " >:")))(gtn)))
gtn)

Lisp giải quyết được khoảng cách , tọa độ và xuất ra excel vị trí cọc GPMB, rất hay.

xin nhờ Bạn giúp thêm cho việc chọn hướng gốc của tuyến ( để phân biện bên trái và phải tuyến ), chọn tên cọc ví dụ như H3,..nhập chiều rộng giải tỏa,  chọn hướng cấm cọc trái hay phải  thì xuất cọc theo hướng vuông góc và xuất ra bảng trên cad  và exxcel luôn, theo file minh họa sau

cám ơn

http://www.cadviet.c...81_coc_gpmb.dwg


  • 0