Đế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

#101 donvinhhp

donvinhhp

    biết zoom

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

Đã gửi 16 October 2013 - 08:46 AM

E xin chân thành cảm ơn bác, bác làm được thế này đã là quá tuyệt vời đối với e rùi, bác cho e hỏi thêm với, hình như cái Code bây giờ nó dài gấp 3 lần trước hả bác ???


  • 0

#102 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 16 October 2013 - 08:49 AM

E xin chân thành cảm ơn bác, bác làm được thế này đã là quá tuyệt vời đối với e rùi, bác cho e hỏi thêm với, hình như cái Code bây giờ nó dài gấp 3 lần trước hả bác ???

Dài như cũ thôi. Chỉ là do tôi quên không delete các đoạn thừa, nhưng không ảnh hưởng tới hòa bình.


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


#103 donvinhhp

donvinhhp

    biết zoom

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

Đã gửi 16 October 2013 - 09:39 AM

Hic, bác ơi, bác giúp e xóa bớt đoạn không cần thiết nhìn cho gọn được không ạ, vì e cảm giác nó hơi nặng khi e chạy bác ạ, mà máy e thì thuộc dạng cùi bắp !E cảm ơn !


  • 0

#104 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 16 October 2013 - 09:50 AM

Hic, bác ơi, bác giúp e xóa bớt đoạn không cần thiết nhìn cho gọn được không ạ, vì e cảm giác nó hơi nặng khi e chạy bác ạ, mà máy e thì thuộc dạng cùi bắp !E cảm ơn !

Không liên quan gì những điều bạn nói cả. Kệ nó.


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


#105 donvinhhp

donvinhhp

    biết zoom

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

Đã gửi 16 October 2013 - 11:10 AM

Vâng, e cảm ơn bác, e cũng chỉ muốn nhìn cho nó gọn gàng hơn thui, nhưng thế cũng đã tốt lắm rùi ạ ! :unsure:


  • 0

#106 donvinhhp

donvinhhp

    biết zoom

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

Đã gửi 13 December 2013 - 07:23 PM

Dài như cũ thôi. Chỉ là do tôi quên không delete các đoạn thừa, nhưng không ảnh hưởng tới hòa bình.

Bác "Doan Van Ha" ơi, e vừa sử dụng Lisp vẽ Mặt bằng kết cấu này thì lại bị lỗi bác à, với một số mặt bằng vẽ thì không sao, nhưng đến mặt bằng này thì lại phát sinh lỗi, mà mặt bằng tim trục này thuộc lại đơn giản, không phức tạp, e gửi lại Lisp lần trước bác Update lần cuối với File Cad mà e check bị lỗi không tạo được mặt bằng dầm bác xem lại giúp e với nhé !

e xin chân thành cảm ơn, nhân tiện nếu Lisp này có thể rút gọn được thì bác rút gọn giúp e với bác nhé !

Chúc bác sức khỏe và sự thành công !

Hic, e đính kèm File mà không được, bác vào tạm Mediafire nhé !

 

http://www.mediafire...cnol7/Check.rar


  • 0

#107 donvinhhp

donvinhhp

    biết zoom

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

Đã gửi 17 December 2013 - 09:44 PM

Dài như cũ thôi. Chỉ là do tôi quên không delete các đoạn thừa, nhưng không ảnh hưởng tới hòa bình.

Bác Doan Van Ha" ơi vào giúp e với, Lisp này vẫn bị lỗi bác ợ !!!


  • 0

#108 phamhung12

phamhung12

    biết vẽ ellipse

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

Đã gửi 03 August 2014 - 12:19 PM

Sao mình sử dụng lisp của bạn Doan Van Ha để vẽ tường 200 không được ta :wub:  . Nhờ chủ Lisp test lại giúp file đính kèm

http://www.cadviet.c...2_luoi_truc.rar


  • 0

#109 phamhung12

phamhung12

    biết vẽ ellipse

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

Đã gửi 05 August 2014 - 05:05 PM

Trục phức tạp làm được, trục đơn giản không làm được :( ... chẳng lẻ đấy là lỗi "oái oăm" trong LISP :wub:


  • 0

#110 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 05 August 2014 - 05:22 PM

Trục phức tạp làm được, trục đơn giản không làm được :( ... chẳng lẻ đấy là lỗi "oái oăm" trong LISP :wub:

Nó không oái oăm đâu. Ngay đầu lisp tôi đã ghi chú "ô ngoài cùng phải là hình chữ nhật". Bạn xem lại 4 Line ngoài cùng, nó không tạo thành hình chữ nhật (kiểm tra X và Y của các đầu mút line sẽ thấy).


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


#111 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 06 August 2014 - 02:10 PM

Lấy ý tưởng từ bài

http://www.cadviet.c...uong-giao-nhau/

Tôi sửa lại lisp của bạn Doan Van Ha như sau:

- Sửa hàm chính: MBCK

- Sửa lỗi hàm HA:PointInOut luôn trả về nil nếu flag là "N"

- Các hàm khác như cũ.

Các bạn check xem còn lỗi nào không

 

(defun SsNext (e f / ss)
    (setq ss (ssadd))
    (while (setq e (entnext e))
        (if (or (not f) (vl-position (cons 0 f) (entget e)))(ssadd e ss))    )
)
(defun C:MBKC(/ c col ent giao i kc ll lst lstb lstg1 lsti n o ss sv sy)
 (command "undo" "be") (redraw)
    (setq sy '("CMDECHO" "OSMODE" "PEDITACCEPT" "DELOBJ") sv (mapcar 'getvar sy))
    (mapcar 'setvar sy '(0 0 1 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))
    (setq ll (entlast))
 (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
         (progn
             (setq i 0 o (cdr (assoc 10 (entget (car n1)))))
             (setq lstg1 (LM:UniqueFuzz(vl-sort lstg1 '(lambda(p q) (< (distance p o) (distance q o)) ))1e-10))
             (repeat (1- (length lstg1))
                 (entmake (list (cons 0 "LINE") (cons 10 (nth i lstg1)) (cons 11 (nth (setq i (1+ i)) lstg1)) ))         )
         )
    ))
 ;(load "overkillsup.lsp")
    (vl-cmdf "._REGION" (SsNext ll nil) "")
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "REGION"))))
        (vl-cmdf "._EXPLODE" ent)
        ;(acet-overkill2 (list (ssget "P") 1E-3))
        (vl-cmdf "PEDIT" "M" "p" "" "J" "" "" )
        )
    
    (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "LWPOLYLINE")))))
    (setq ss (vl-sort ss '(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) )))
 (HA:OffsetInOut (car ss) lst "N")
 (foreach ent (cdr ss)
  (HA:OffsetInOut ent lst "T"))
    (mapcar 'setvar sy sv)(command "undo" "e")
    (redraw) (princ))

(defun HA:PointInOut (p obj flag / flag1 obj1 obj2 lon nho)
 (setq obj1 (car (vlax-invoke obj 'Offset 1E-1))
       obj2 (car (vlax-invoke obj 'Offset -1E-1)))
 (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))
     (if (= flag "N")(setq flag1 T)
   ))
 (mapcar 'vla-delete (list lon nho))
 flag1)
 

  • 2

#112 phamhung12

phamhung12

    biết vẽ ellipse

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

Đã gửi 06 August 2014 - 03:04 PM

Thanks bạn! Với Lisp này thì OK cho trường hợp của mình!


  • 0

#113 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 30 December 2014 - 09:43 AM

Lấy ý tưởng từ bài

http://www.cadviet.c...uong-giao-nhau/

Tôi sửa lại lisp của bạn Doan Van Ha như sau:

- Sửa hàm chính: MBCK

- Sửa lỗi hàm HA:PointInOut luôn trả về nil nếu flag là "N"

- Các hàm khác như cũ.

Các bạn check xem còn lỗi nào không

 

(defun SsNext (e f / ss)
    (setq ss (ssadd))
    (while (setq e (entnext e))
        (if (or (not f) (vl-position (cons 0 f) (entget e)))(ssadd e ss))    )
)
(defun C:MBKC(/ c col ent giao i kc ll lst lstb lstg1 lsti n o ss sv sy)
 (command "undo" "be") (redraw)
    (setq sy '("CMDECHO" "OSMODE" "PEDITACCEPT" "DELOBJ") sv (mapcar 'getvar sy))
    (mapcar 'setvar sy '(0 0 1 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))
    (setq ll (entlast))
 (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
         (progn
             (setq i 0 o (cdr (assoc 10 (entget (car n1)))))
             (setq lstg1 (LM:UniqueFuzz(vl-sort lstg1 '(lambda(p q) (< (distance p o) (distance q o)) ))1e-10))
             (repeat (1- (length lstg1))
                 (entmake (list (cons 0 "LINE") (cons 10 (nth i lstg1)) (cons 11 (nth (setq i (1+ i)) lstg1)) ))         )
         )
    ))
 ;(load "overkillsup.lsp")
    (vl-cmdf "._REGION" (SsNext ll nil) "")
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "REGION"))))
        (vl-cmdf "._EXPLODE" ent)
        ;(acet-overkill2 (list (ssget "P") 1E-3))
        (vl-cmdf "PEDIT" "M" "p" "" "J" "" "" )
        )
    
    (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SsNext ll "LWPOLYLINE")))))
    (setq ss (vl-sort ss '(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) )))
 (HA:OffsetInOut (car ss) lst "N")
 (foreach ent (cdr ss)
  (HA:OffsetInOut ent lst "T"))
    (mapcar 'setvar sy sv)(command "undo" "e")
    (redraw) (princ))

(defun HA:PointInOut (p obj flag / flag1 obj1 obj2 lon nho)
 (setq obj1 (car (vlax-invoke obj 'Offset 1E-1))
       obj2 (car (vlax-invoke obj 'Offset -1E-1)))
 (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))
     (if (= flag "N")(setq flag1 T)
   ))
 (mapcar 'vla-delete (list lon nho))
 flag1)
 

cảm ơn bạn đoàn văn hà đã viết code và bạn đã có công phát triển hoàn thiện tiếp, bạn nghĩ sao nếu phát triển trục dầm là đường cong  :D


  • 0

#114 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 31 December 2014 - 04:35 PM

error: no function definition: LM:LISTBOUNDINGBOX

Hôm trc dùng ok. hôm nay ko bik sao cứ bị lỗi nhu trên.

lisp bị lỗi do 1 số hàm cũ file trc bác không copy lại. copy lại là dc. :D
Lisp này bị 1 lỗi nữa là nếu mà chỉ 2 trục ngang, 2 trục đứng thì vẽ bị lỗi. 3 trục trở lên mới k bị lỗi. Nếu được phiền bạn chỉnh lại giúp :)


  • 0

#115 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 31 December 2014 - 09:01 PM

error: no function definition: LM:LISTBOUNDINGBOX

Hôm trc dùng ok. hôm nay ko bik sao cứ bị lỗi nhu trên.

lisp bị lỗi do 1 số hàm cũ file trc bác không copy lại. copy lại là dc. :D
Lisp này bị 1 lỗi nữa là nếu mà chỉ 2 trục ngang, 2 trục đứng thì vẽ bị lỗi. 3 trục trở lên mới k bị lỗi. Nếu được phiền bạn chỉnh lại giúp :)

Nếu lần trước bạn không bị lỗi, đó là do "ơn giời, cậu có rồi!", vì hàm LM:LISTBOUNDINGBOX chưa có sẵn, nhưng chẳng may bạn đã load 1 lisp có hàm đó trước khi dùng lsp của ndtnv. Còn lần này, vì hàm trên chưa được load. Chắc vậy?


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


#116 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 31 December 2014 - 10:05 PM

Nếu lần trước bạn không bị lỗi, đó là do "ơn giời, cậu có rồi!", vì hàm LM:LISTBOUNDINGBOX chưa có sẵn, nhưng chẳng may bạn đã load 1 lisp có hàm đó trước khi dùng lsp của ndtnv. Còn lần này, vì hàm trên chưa được load. Chắc vậy?

chính xác. em vẫn còn lisp cũ của anh chạy trc mà, nó không lỗi. không load cung nó lỗi ngay. em copy lại dc rồi  LM:LISTBOUNDINGBOX và 1 số hàm khác. nó chạy vào vèo rồi.

Còn lỗi thứ 2: ndtnv chỉnh hàm  mà bjo hàm không vẽ được 4 đối tượng trục hay sao ý (2 trục đứng +2 trục ngang). 5 trở lên thì được :D. Hàm trước của bác Hà thì đc. Bác mà ghé qua được fix dùm em với. Thanks bác


  • 0

#117 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 05 January 2015 - 10:06 PM

@

ndtnv
  • 0

#118 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 06 January 2015 - 08:51 AM

Sửa

(setq ss (vl-sort ss '(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) )))

thành

 

    (if (= (length ss) 1)
        (progn
            (vla-copy (vlax-ename->vla-object (car ss))  )
            (setq ss (cons (entlast) ss))
        )
    (setq ss (vl-sort ss '(lambda(p q) (> (vlax-curve-getarea p) (vlax-curve-getarea q)) )))
        )

  • 0

#119 suachua

suachua

    Chưa sử dụng CAD

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

Đã gửi 28 October 2015 - 03:45 PM

EM mới tập dùng lisp. Không hiểu sao em gõ ap rồi add lisp bác Hà vào mà gõ lệnh ha =>enter mà cad không chạy được. Em đã thử khởi động lại Cad vẫn không được. Có phải lisp này dùng cho Cad đời cao hơn không? Em xài Cad 2007.


  • 0