Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
phongtran86

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

Các bài được khuyến nghị

phongtran86    21

nhanh mà anh Tue_NV. Mình chỉ chuyển 1 số nét tường dầm phụ trên mặt bằng kiến trúc tắt later, copy sang. sẽ nhanh hơn thủ công phải copy offset rồi trim. :D Mong được sự giúp của bác để lisp tỏng quát :)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Mình hỏi bạn chút: giả dụ bạn chọn trục rồi chọn bề rộng dầm rồi thì làm sao bạn biết bạn đã chọn trục chưa, bề rộng dầm nhập cho trục đó là bao nhiêu? Mặt bằng tương đối lớn rất dễ nhâm lẫn đó bạn.

Cần thiết để tránh nhầm thì đánh dấu vào những thằng đã chọn?

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

Cần thiết để tránh nhầm thì đánh dấu vào những thằng đã chọn?

 

Với MB nhỏ thì dễ , với MB tương đối lớn tí thì dễ bị nhầm. Bác có thể đánh dấu vào những lưới trục đã chọn, bác biết đã chọn rồi ok, nhưng liệu bác có nhớ đã nhập vào dầm đó là bề rộng là bao nhiêu không? Lấy gì để nhớ?

Chương trình thì chỉ làm có được một lần, chưa biết chắc đúng hay sai, lưới trục thì không phải lúc nào cũng trùng với trục dầm, modify thì phải dò và Stretch, có khi còn khổ hơn làm thủ công... :)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phongtran86    21

tr­­ường hợp thông thường các dầm chính thường là 220 nên trục dầm trùng với trục định vị. Các dầm phụ vẽ trục định vị cho dầm này bên mb kiến trúc.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Với MB nhỏ thì dễ , với MB tương đối lớn tí thì dễ bị nhầm. Bác có thể đánh dấu vào những lưới trục đã chọn, bác biết đã chọn rồi ok, nhưng liệu bác có nhớ đã nhập vào dầm đó là bề rộng là bao nhiêu không? Lấy gì để nhớ?

Chương trình thì chỉ làm có được một lần, chưa biết chắc đúng hay sai, lưới trục thì không phải lúc nào cũng trùng với trục dầm, modify thì phải dò và Stretch, có khi còn khổ hơn làm thủ công... :)

2). OK

1). Cũng như các trục (đánh dấu), thì kể cả bề rộng từng dầm tương ứng với chúng cũng có cách để "nhớ" và thấy trực quan trên màn hình luôn. Nhưng mệt!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

tr­­ường hợp thông thường các dầm chính thường là 220 nên trục dầm trùng với trục định vị. Các dầm phụ vẽ trục định vị cho dầm này bên mb kiến trúc.

 

Đó là trường hợp nhỏ lẻ, gặp đặc biệt phải dò lại thôi bạn.........

Mình chưa viết Lisp này bởi lẽ chưa tìm được Phương án tối ưu nhất, chưa thấy sự hiệu quả của nó, bạn ạ. 

Nếu cứ vẽ ra rồi thì không modify gì được hết, phải mất công dò lại, thì thà rằng làm tay vừa kiểm tra vừa soát lại còn khỏe hơn

Mà công trình thì không phải lúc nào làm một lần là xong đâu bạn, phải thay đổi khá nhiều đó.

Không lẽ mỗi lúc thay đổi lại bạn phải chạy lại chương trình? Có kiểm soát hết được đâu bạn? 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phongtran86    21

trường hợp đặc biệt mới vậy. còn trường hợp không đặc biệt chiếm phần lớn chứ sao lại nhỏ lẻ :D Anh cứ viết đi rồi phát triển và hoàn thiện dần. :)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Kết thúc lisp này ở đây, vì quá khó, quá mất công, và còn dành thời gian kiếm cơm nữa!

File cad để test:

http://www.cadviet.com/upfiles/3/67029_test2.dwg

File hình để rửa mắt:

67029_untitled_10.png

File lisp trần ai:


 

;Doan Van Ha - CADViet.com - Ngay 22/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)
 (vl-load-com) (command "undo" "be")
 (setq cmd (getvar "cmdecho") osm (getvar "osmode") hpb (getvar "hpbound")) (setvar "cmdecho" 0) (setvar "osmode" 0) (setvar "hpbound" 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))))
  (setq lst (append (mapcar '(lambda(ent) (list ent kc)) lsti) 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-8) (< (cadr p) (cadr q)) (< (car p) (car q))))) 1E-8))
 (HA:hcn (car lstg) (last lstg) 0)
 (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-8 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-8 nil "N" "N" "N"))
 (setvar "cmdecho" cmd) (setvar "hpbound" hpb) (command "undo" "e") (princ) lst)
;----- 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-8) (equal (+ b c) a 1e-8) (equal (+ c a) b 1e-8))) (distance p1 p2) (distance p2 q1) (distance q1 p1))
  ((lambda(a b c) (or (equal (+ a b) c 1e-8) (equal (+ b c) a 1e-8) (equal (+ c a) b 1e-8))) (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-8) ghan (distance p q))) lst)) lst))))
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phongtran86    21

Liên kết một số comment lại, đọc thấy vui vui!

 

Xin LISP cũng nhiệt tình:

 

Kêu gọi:

 

Chuyển mục đích, từ chỗ cần xin chuyển sang giúp người ta sửa LISP:

 

Đe dọa!

 

Chuyển hướng đối tượng:

 

Không hiểu, nếu anh Doan Van Ha và anh Tue_NV không viết giúp, thì có bị bạn đe dọa, hay kêu gọi cứ mạnh dạn viết đi, sai thì bạn sửa dzùm không nhỉ? Hi hi, spam tý, để mọi người relax phát thôi!

Ha ha. Lyky bóc mẽ mình rồi :))

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phongtran86    21

Lisp của anh Hà đỉnh của đỉnh rồi :D. Cảm ơn nhiều nhiều. ha ha 100like luôn. :)).

.

.

.

.

Có chút là khi mình chọn đường trục cho bề rộng trước rồi, thi về sau chọn lại nó vẫn theo cái chọn trước rồi. HI HI HI HI. Thui chú ý 1 chút là được.

Anh Hà mệt với líp này quá.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Lisp của anh Hà đỉnh của đỉnh rồi :D. Cảm ơn nhiều nhiều. ha ha 100like luôn. :)).

.

.

.

.

Có chút là khi mình chọn đường trục cho bề rộng trước rồi, thi về sau chọn lại nó vẫn theo cái chọn trước rồi. HI HI HI HI. Thui chú ý 1 chút là được.

Anh Hà mệt với líp này quá.

Tôi quên mất việc đánh dấu các đối tượng đã chọn. Bạn bổ sung như sau:

1). Thêm dòng này:

(mapcar '(lambda(ent) (grdraw (vlax-curve-getStartPoint ent) (vlax-curve-getEndPoint ent) 2)) lsti)

Vào ngay dưới dòng này:

(setq lsti (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

2). Và thêm đoạn này:

(redraw)

Vào ngay trước đoạn này:

(princ)

Số 2 ở dòng trên tượng trưng màu vàng. Bạn thích màu nào thì sửa con số đó. Chúc thành công!

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phongtran86    21

cái này là cái đánh dấu, khá hay. ý em là nếu mình đã lỡ chọn trục nhập kích thước 220 rồi chẳng hạn. mà về sau chọn này trục này nhập 150 thì nó vẫn theo cái bề rông ban đầu, ý em muốn là nó theo cái bề rông sau cùng mà mình chọn ấy. :D:D, như thế hay hơn. he he

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

cái này là cái đánh dấu, khá hay. ý em là nếu mình đã lỡ chọn trục nhập kích thước 220 rồi chẳng hạn. mà về sau chọn này trục này nhập 150 thì nó vẫn theo cái bề rông ban đầu, ý em muốn là nó theo cái bề rông sau cùng mà mình chọn ấy. :D:D, như thế hay hơn. he he

Sửa tất tần tật các yêu cầu cho bạn đây!


 

;Doan Van Ha - CADViet.com - Ngay 22/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)
 (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)
 (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) 2)) lsti))
  (setq lst (reverse (append (mapcar '(lambda(ent) (list ent kc)) lsti) 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-8) (< (cadr p) (cadr q)) (< (car p) (car q))))) 1E-8))
 (HA:hcn (car lstg) (last lstg) 0)
 (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-8 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-8 nil "N" "N" "N"))
 (setvar "cmdecho" cmd) (setvar "hpbound" hpb) (command "undo" "e") (redraw) (princ) lst)
;----- 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-8) (equal (+ b c) a 1e-8) (equal (+ c a) b 1e-8))) (distance p1 p2) (distance p2 q1) (distance q1 p1))
  ((lambda(a b c) (or (equal (+ a b) c 1e-8) (equal (+ b c) a 1e-8) (equal (+ c a) b 1e-8))) (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-8) ghan (distance p q))) lst)) lst))))
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phongtran86    21

ok anh. thanks anh nhiều. cơ mà sao bây h sau khi ấn enter cuối cùng, nó đơ 1 lúc luôn. hiện 1 loạt code ở dòng cmd:

((<Entity name: -5902b00> 220.0) (<Entity name: -5902b08> 220.0) (<Entity name:
-5902b10> 220.0) (<Entity name: -5902b18> 220.0) (<Entity name: -5902b20>
220.0) (<Entity name: -5902b28> 220.0) (<Entity name: -5902b30> 220.0) (<Entity
name: -5902b00> 150.0)). mặt bằng kc to to tí thì đơ khá là lâu.

Code này sửa chọn dầm được 1 lần thôi phải không anh, chọn tất cả trục bề rộng 220 này, chọn lại 1 số trục để 150 này thì đc. Nhưng nếu để 1 số trục 150 này, chọn tiếp số trục khác để 110 chẳng hạn thì chỉ cái chọn cuối thay đổi. cái 150 kia ko đổi dc. :D, Nói chung vấn đề nhỏ anh nhỉ. Quá tuyệt vời rồi.

Với lại mình định thêm code (COMMAND "OSNAP" "END,INT,INS,NOD,CEN,MID,QUA,PERP,NEA") vào sau cái (princ) lst để nó bật bắt điểm. Sau khi lệnh thực hiện mất hết bắt điểm mà :D

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

1). Bổ sung đãng trí quên reverse osnap.

 

2). Bỏ mấy dòng đãng trí in ra trên screen.

 

3). Bổ sung chọn lần sau thay lần trước.

 

4). Bổ sung xanh đỏ tím vàng lục lam cam chàm tím cho mỗi lần chọn theo y/c của bạn Tien05.


 

;Doan Van Ha - CADViet.com - Ngay 23/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)
 (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 col (1+ col)))
 (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-8) (< (cadr p) (cadr q)) (< (car p) (car q))))) 1E-8))
 (HA:hcn (car lstg) (last lstg) 0)
 (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-8 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-8 nil "N" "N" "N"))
 (setvar "cmdecho" cmd) (setvar "hpbound" hpb) (setvar "osmode" osm) (command "undo" "e") (redraw) (princ))
;----- 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-8) (equal (+ b c) a 1e-8) (equal (+ c a) b 1e-8))) (distance p1 p2) (distance p2 q1) (distance q1 p1))
  ((lambda(a b c) (or (equal (+ a b) c 1e-8) (equal (+ b c) a 1e-8) (equal (+ c a) b 1e-8))) (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-8) ghan (distance p q))) lst)) lst))))
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

Cái này người ta gọi là pơ phẹc đấy anh Hà ah. Quá tuyệt vời, hoàn hảo há há

 

Chưa pơ phẹc đâu. Lisp còn có điểm hạn chế, tác giả đã ghi như vầy, xử được điểm này nữa mới "pơ phẹc" được

 

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Chưa pơ phẹc đâu. Lisp còn có điểm hạn chế, tác giả đã ghi như vầy, xử được điểm này nữa mới "pơ phẹc" được

 

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

Xử lý được cái gọi là "pơ phẹc" ấy thì cũng chưa pơ phẹc đâu. Còn vô vàn thứ nữa, bởi ai biết được mặt bằng đường trục ấy gồm những gì?

Quan trọng gì cái gọi là pơ phẹc kia nhỉ?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phongtran86    21

Ha ha. Anh TUe_NV đam mê sự hoàn hảo ah. Nếu nói thế thì đúng là còn vô vàn thứ thật. Hehe. Thế anh Tuệ tiếp tục phát triển đi. Em ủng hộ 2 chân 2 tay.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

Xử lý được cái gọi là "pơ phẹc" ấy thì cũng chưa pơ phẹc đâu. Còn vô vàn thứ nữa, bởi ai biết được mặt bằng đường trục ấy gồm những gì?

Quan trọng gì cái gọi là pơ phẹc kia nhỉ?

 

- Chỉ đơn thuần là MB nhà không phải là Hình chữ nhật thôi bác ạ.

Trục đơn thuần chỉ là trục dầm, tạo nên các ô sàn

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

- Chỉ đơn thuần là MB nhà không phải là Hình chữ nhật thôi bác ạ.

Trục đơn thuần chỉ là trục dầm, tạo nên các ô sàn

Cái này đã nghĩ rồi, le lói giải thuật rồi, nhưng còn vài thứ lăn tăn quanh quẩn nó mà lại tốn khá nhiều noron and time nên tạm ngừng. Chừng nào hứng mần tiếp, hoặc bác đang hứng thì mần giùm mọi người đi!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×