Đến nội dung


Hình ảnh
* * * - - 5 Bình chọn

[yêu cầu &thảo luận] lisp vẽ mặt bằng kết cấu


  • Please log in to reply
118 replies to this topic

#81 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 25 May 2013 - 09:45 AM

1). Bạn kiểm tra và xoá 1 line trùng trong hình của bạn đi nhé.

2). Mình bổ sung thêm tí xíu cho lisp chạy nhanh hơn. Mình không ngờ khi zoom bé thì lisp chạy cực chậm như bản vẽ của bạn.

 

;Doan Van Ha - CADViet.com - Ngay 25/05/2013
;Chuc nang: ve luoi dam/tuong theo he truc // XOY, be rong tuy chon, luoi break bat ky nhung o ngoai cung phai la HCN.
(defun C:HA(/ ss lsti lst lstg1 giao lstg kcm ptx pty ent col lstb)
 (vl-load-com) (command "undo" "be") (redraw)
 (setq cmd (getvar "cmdecho") osm (getvar "osmode") hpb (getvar "hpbound")) (setvar "cmdecho" 0) (setvar "osmode" 0) (setvar "hpbound" 1)
 (setq col 1)
 (while
  (and
   (princ "\nChon cac Line duong truc...")
   (setq ss (ssget '((0 . "LINE"))))
   (setq lsti (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (or kc (setq kc 110))
   (setq kc (cond ((getdist (strcat "\nBe rong tuong/dam <" (rtos kc 2 2) ">:"))) (kc))))
  (mapcar '(lambda(ent) (grdraw (vlax-curve-getStartPoint ent) (vlax-curve-getEndPoint ent) col)) lsti)
  (setq lst (append (mapcar '(lambda(ent) (list ent kc)) lsti) lst))
  (setq lstb (append lsti lstb))
  (setq col (1+ col)))
 (command "zoom" "w" (car (setq c (LM:ListBoundingBox lstb))) (cadr c))
 (setq lst (reverse lst))
 (foreach n1 lst
  (setq lstg1 nil)
  (foreach n2 lst
   (if (setq giao (car (HA:Giao (vlax-ename->vla-object (car n1)) (vlax-ename->vla-object (car n2)) acExtendNone)))
    (setq lstg1 (cons giao lstg1))))
  (if lstg1 (setq lstg (append lstg1 lstg))))
 (setq lstg (LM:UniqueFuzz (vl-sort lstg '(lambda(p q) (if (equal (car p) (car q) 1E-3) (< (cadr p) (cadr q)) (< (car p) (car q))))) 1E-3))
 (HA:hcn (car lstg) (last lstg) 0)
 (setq a lstg)
 (HA:OffsetInOut (entlast) lst "N")
 (setq kcm (* 0.9 (HA:DisMinMax lstg "min")))
 (setq ss (ssadd) ptx (polar (car lstg) 0 kcm))
 (while (< (car ptx) (car (last lstg)))
  (setq pty (polar ptx (/ pi 2) kcm))
  (while (< (cadr pty) (cadr (last lstg)))
   (setq ent (entlast))
   (command "boundary" pty "")
   (if (setq ent (entnext ent)) (setq ss (ssadd ent ss)))
   (setq pty (polar pty (/ pi 2) kcm)))
  (setq ptx (polar ptx 0 kcm)))
 (load "overkillsup.lsp") (acet-overkill2 (list ss 1E-3 nil "N" "N" "N"))
 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "w" (car lstg) (last lstg) '((0 . "LWPOLYLINE"))))))
  (HA:OffsetInOut ent lst "T"))
 (acet-overkill2 (list (ssget "w" (car lstg) (last lstg) '((0 . "LWPOLYLINE"))) 1E-3 nil "N" "N" "N"))
 (setvar "cmdecho" cmd) (setvar "hpbound" hpb) (setvar "osmode" osm) (command "undo" "e") (redraw) (princ))
;-----
(defun LM:ListBoundingBox ( entlst / l1 l2 ll ur )
 (foreach ent entlst
  (setq obj (vlax-ename->vla-object ent))
  (vla-getboundingbox obj 'll 'ur)
  (setq l1 (cons (vlax-safearray->list ll) l1) l2 (cons (vlax-safearray->list ur) l2)))
  (mapcar (function (lambda (a b) (apply 'mapcar (cons a b)))) '(min max) (list l1 l2)))
;----- Check xem 2 lines ent1 vµ ent2 n»m trªn cïng ®­êng th¼ng kh«ng?
(defun HA:2LineCollinear-p(ent1 ent2)
 (setq p1 (vlax-curve-getStartPoint ent1) p2 (vlax-curve-getEndPoint ent1)
       q1 (vlax-curve-getStartPoint ent2) q2 (vlax-curve-getEndPoint ent2))
 (and
  ((lambda(a b c) (or (equal (+ a b) c 1E-3) (equal (+ b c) a 1E-3) (equal (+ c a) b 1E-3))) (distance p1 p2) (distance p2 q1) (distance q1 p1))
  ((lambda(a b c) (or (equal (+ a b) c 1E-3) (equal (+ b c) a 1E-3) (equal (+ c a) b 1E-3))) (distance p1 p2) (distance p2 q2) (distance q2 p1))))
;----- Check xem ®iÓm p co n»m trong/ngoµi obj kin hay kh«ng?
(defun HA:PointInOut (p obj flag / flag1 obj1 obj2 lon nho)
 (setq obj1 (car (vlax-invoke obj 'Offset 1E-3))
       obj2 (car (vlax-invoke obj 'Offset -1E-3)))
 (if (> (vla-get-area obj1)(vla-get-area obj2))
  (setq lon obj1 nho obj2)
  (setq lon obj2 nho obj1))
 (if (> (distance p (vlax-curve-getClosestPointTo lon p))(distance p (vlax-curve-getClosestPointTo nho p)))
  (if (= flag "T")
   (setq flag1 T)))
 (mapcar 'vla-delete (list lon nho))
 flag1)
;----- Offset ent vµo bªn trong polygon, víi dis mçi c¹nh kh¸c nhau.
(defun HA:OffsetInOut(ent lstx flag / obj0 obj obj1 obj2 i mid objc objl lst lst1 lst2 lst3 lst4)
 (setq obj0 (vlax-ename->vla-object ent))
 (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget ent))))
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "cp" lst '((0 . "LINE")))))))
 (setq lst1 (append lst lst))
 (setq i 0)
 (repeat (length lst)
  (setq obj (vlax-ename->vla-object (setq ent1 (entmakex (list (cons 0 "LINE") (cons 10 (nth i lst1)) (cons 11 (nth (1+ i) lst1)))))))
  (foreach ent2 entlst
   (if (HA:2LineCollinear-p ent1 ent2) (setq entL ent2)))
  (foreach ent lstx
   (if (equal entL (car ent)) (setq kcx (cadr ent))))
  (setq obj1 (car (vlax-invoke obj 'Offset (/ kcx 2))) obj2 (car (vlax-invoke obj 'Offset (/ kcx -2))))
  (setq mid (mapcar '(lambda(x y) (/ (+ x y) 2)) (vlax-curve-getStartPoint obj1) (vlax-curve-getEndPoint obj1)))
  (if (HA:PointInOut mid obj0 flag)
   (setq objc obj1 objl obj2)
   (setq objc obj2 objl obj1))
  (setq lst2 (cons objc lst2))
  (mapcar 'vla-delete (list objl obj))
  (setq i (1+ i)))
 (setq lst3 (append lst2 lst2))
 (setq i 0)
 (repeat (length lst2)
  (if (setq giao (HA:Giao (nth i lst3) (nth (1+ i) lst3) acExtendBoth))
   (setq lst4 (cons (car giao) lst4)))
  (setq i (1+ i)))
 (LWPoly lst4 1)
 (mapcar 'vla-delete (cons obj0 lst2)))
(defun LWPoly(lst cls)
 (entmakex (append (list 
    (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))))
(defun HA:Giao(obj1 obj2 mode / l r)
 (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length l) 3)
  (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))
 r)
(defun HA:hcn(p1 p3 kc / p1x p3x)
 (setq p1x (list (+ (min (car p1) (car p3)) kc) (+ (min (cadr p1) (cadr p3)) kc))
       p3x (list (- (max (car p1) (car p3)) kc) (- (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" p1x p3x))
(defun LM:UniqueFuzz(l fz)
 (if l 
  (cons (car l) (LM:UniqueFuzz (vl-remove-if '(lambda(x) (equal x (car l) fz)) (cdr l)) fz))))
(defun HA:DisMinMax(lst func / ghan)
 (if (= (strcase func) "MIN") (setq func min ghan 1E15) (setq func max ghan -1E15))
 (apply 'func (apply 'append (mapcar '(lambda(p) (mapcar '(lambda(q) (if (equal p q 1E-3) ghan (distance p q))) lst)) lst))))

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


#82 phongtran86

phongtran86

    biết lệnh offset

  • Members
  • PipPipPip
  • 177 Bài viết
Điểm đánh giá: 22 (tàm tạm)

Đã gửi 25 May 2013 - 12:21 PM

Tốt rồi. :) Giờ anh fix cả lỗi đường trùng nhau rồi. vẫn cái mb líp mới chạy phe phé. líp cũ đơ như cây cơ :))

Ah Nhầm anh ơi. cái đường trung nhau là do dùng lisp cũ sinh ra. nó ko tạo ra dầm mà chỉ tạo ra mỗi 1 đường đấy. Không biết anh fix lỗi gì mà hay thế. he he :D


  • 0

#83 tien2005

tien2005

    biết lệnh properties

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

Đã gửi 27 May 2013 - 09:26 AM

3202_mbkc.jpghic

 

 

Hôm trước chạy ngon lành, bây giờ xuất hiện cái bảng này. kể cả khi tạo bản vẽ mới cũng bị

 

Bạn có thể không dùng grdraw để đánh dấu các line đã được chọn, vì trong quá trình chọn mà pan đi thì các grdraw sẽ mất mất hết.

Thay vào đó vẽ các line, sau khi kết thúc chọn thì xóa các line này đi (chưa tính đến việc ESC trong quá trình chọn, nếu được thì Bạn bẫy lỗi luôn để nó trả về như trước khi chọn)


  • 0

#84 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 27 May 2013 - 09:43 AM

1). Bạn sửa như thế này chắc hết xuất hiện dialog phụ.

(command "boundary" pty "")

Thành

(command ".-boundary" pty "")

2). Chức năng đánh dấu này không quan trọng lắm nên mình dùng grdraw cho đơn giản, nhưng nhược điểm là biến mất khi zoom >> nếu cần thiết thì lúc nào rảnh sẽ thay bằng các line tạm và bẫy lỗi đàng hoàng.


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


#85 01693583958

01693583958

    Chưa sử dụng CAD

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

Đã gửi 09 July 2013 - 09:18 AM

a HÀ cho e cái hướng dẫn sử dụng ,khi e dùng xong lệnh sao khoảng cách của tường chỉ có 1 nửa vậy ,e nhập 800 mà khoảng cách chỉ có 400. thank a nhiều .^^


  • 0

#86 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 09 July 2013 - 09:20 AM

Nếu thế thì nhập 1600


  • 1

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


#87 01693583958

01693583958

    Chưa sử dụng CAD

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

Đã gửi 09 July 2013 - 09:24 AM

ok a ,nhưng tường nó lại trùng vào trục rồi a .a giải thích cho e với ,^^


  • 0

#88 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 09 July 2013 - 09:56 AM

Bạn gởi bản vẽ cho tôi nhé, save xuống 2007.


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


#89 tien2005

tien2005

    biết lệnh properties

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

Đã gửi 12 July 2013 - 03:06 PM

1). Bạn sửa như thế này chắc hết xuất hiện dialog phụ.

(command "boundary" pty "")

Thành

(command ".-boundary" pty "")

Nhân tiện cho hỏi là có biến hệ thống nào ảnh hưởng đến cách viết lệnh bên trên không. Vì nhiều lúc viết thì người này dùng được người khác không dùng được, khi đó phải đi sửa cho từng người thì mệt quá (người sử dụng không biết về lisp)


  • 0

#90 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 12 July 2013 - 03:11 PM

Bạn dùng dòng thứ 2 thì lúc nào cũng OK.


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


#91 phongtran86

phongtran86

    biết lệnh offset

  • Members
  • PipPipPip
  • 177 Bài viết
Điểm đánh giá: 22 (tàm tạm)

Đã gửi 25 July 2013 - 10:43 AM

Mình vừa cài cad 2014. chạy lisp này lại lỗi.

Select objects:
Be rong tuong/dam <110>:
Chon cac Line duong truc...
Select objects:  ; error: LOAD failed: "overkillsup.lsp"

Hình như trong express tool cua cad 2014 bỏ mất cái này rồi hay sao ấy


  • 0

#92 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 25 July 2013 - 01:47 PM

Bạn sửa:

"overkillsup.lsp"

Thành:

"overkillsup"

Mình không có cad2014 nên không test được. Nếu không được nữa thì đành bó tay.


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


#93 sonnv36

sonnv36

    biết lệnh copy

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

Đã gửi 25 July 2013 - 03:43 PM

Phongtran86 thuê ai massage cho bác HA k kìa :D


  • 0

Online một ngày đàng...học vài sàng khôn :)


#94 phongtran86

phongtran86

    biết lệnh offset

  • Members
  • PipPipPip
  • 177 Bài viết
Điểm đánh giá: 22 (tàm tạm)

Đã gửi 25 July 2013 - 09:14 PM

cad mới lệnh overkill nó ko phải líp cúa express nữa, mình lấy líp này trong express tôl 2007 copy vào, lại chạy ngon ơ :D. Mình chạy song song 2 cad nên làm cách đấy


  • 0

#95 donvinhhp

donvinhhp

    biết zoom

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

Đã gửi 14 October 2013 - 08:59 AM

Bác "Doan Van Ha" ơi, sao e làm theo cái Lisp này để vẽ mặt bằng dầm mà nó bị lỗi bác ợ, bác để ý trên cái hình e đính kèm ý, chỗ 2 cái trục chéo, nó bị mất hẳn 1 bên của nét dầm, chỗ 2 tam giác e khoanh tròn ý ạ, mong bác sớm khắc phục giúp anh em với nha ! Chúc bác mạnh khỏe ! Thanks bác nhìu ! :), e quên mất còn 1 điều nữa, đó là mỗi khi sử dụng lisp này thì ta lại phải định nghĩa lại những điểm cần bắt như bắt điểm giao, bắt điểm song song, vuông góc ... hình như gọi là Osnap ý ợ, bác khắc phục luôn giúp cho e với nhé !

 

10033_dam_bi_loi.jpg


  • 0

#96 donvinhhp

donvinhhp

    biết zoom

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

Đã gửi 15 October 2013 - 08:58 AM

Hic, bác Ha ơi, bác vào giúp cho e với, cái lisp này mà hoàn thiện thì tốt quá bác ạ, e thấy ở các bài Comment trước bác đã Fix lỗi bị mất bắt điểm Snap, mà sao mỗi khi e dùng lệnh "HA" thì vẫn bị mất bắt điểm bác ợ, lại phải chọn bắt điểm lại, bác giúp sửa lisp cho anh em với bác nhá ! :blush:


  • 0

#97 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 October 2013 - 09:09 AM

Sao bạn không gởi bản vẽ ấy lên để test?


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


#98 donvinhhp

donvinhhp

    biết zoom

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

Đã gửi 15 October 2013 - 10:57 AM

Vâng, e gửi kèm theo bản vẽ bên dưới, mong bác kiên nhẫn giúp cho e với ạ, có 3 vấn đề mà e thắc mắc:

1. Mỗi khi dùng lệnh "HA" thì lại bị mất hết bắt điểm, ta phải chọn lại !

2. Tại chỗ các trục chéo thường xuyên bị xảy ra lỗi mất nét dầm !

3. Với các trục hình bán nguyệt để vẽ dầm cong thì không chọn được trục cong !

E mong bác kiên nhẫn giúp bọn e khắc phục các nhược điểm trên bác nhé, e xin chân thành cảm ơn bác, chúc bác mạnh khỏe để có thể cống hiến nhiều hơn cho diễn đàn !

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


  • 0

#99 donvinhhp

donvinhhp

    biết zoom

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

Đã gửi 15 October 2013 - 09:20 PM

Bác Doan Ha cố gắng nghiên cứu giúp anh em với bác nhá, e đợi tin vui của bác !


  • 0

#100 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 October 2013 - 10:23 PM

Vâng, e gửi kèm theo bản vẽ bên dưới, mong bác kiên nhẫn giúp cho e với ạ, có 3 vấn đề mà e thắc mắc:

1. Mỗi khi dùng lệnh "HA" thì lại bị mất hết bắt điểm, ta phải chọn lại !

2. Tại chỗ các trục chéo thường xuyên bị xảy ra lỗi mất nét dầm !

3. Với các trục hình bán nguyệt để vẽ dầm cong thì không chọn được trục cong !

E mong bác kiên nhẫn giúp bọn e khắc phục các nhược điểm trên bác nhé, e xin chân thành cảm ơn bác, chúc bác mạnh khỏe để có thể cống hiến nhiều hơn cho diễn đàn !

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

Tôi chỉ đủ sức 2 trong 3 điều bạn y/c mà thôi:

1). Như đã nói từ đầu là lisp không thể vẽ cho dạng đường trục bất kỳ như bán nguyệt, tròn, zích zắc... Nó chỉ chơi với các ô chữ nhật, tam giác, hình thang thôi.

Tôi không đủ sức để mở rộng cho mọi kiểu ô. Thông cảm nhé!

2). Vì vậy, bạn phải loại các đường trục đặc biệt ấy ra khi chạy lisp. Khi đó osnap sẽ không bị mất.

Bạn down lại ở đây:

http://www.cadviet.c...uc_tuong_ha.lsp


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