Đến nội dung


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

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#1981 tuannguyen314169

tuannguyen314169

    biết lệnh ddedit

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

Đã gửi 27 September 2010 - 04:06 PM

Chào bác tuannguyen314169,
Hề hề hề,
Bác có khỏe không mà sao cái lisp bác post lại bị ngắt đi một khúc đầu vậy, chả thấy cái (defun excute () ......) nó nằm đâu cả thì dò sao ra lỗi được hử bác????
Cái lisp này hình như của bác Duy viết thì phải, nó để scale theo một trục và hai trục thì phải, mình đọc lâu rồi nên cũng không nhớ rõ lắm.
Trong CAD thì các solid đều được hiểu là block nên khi bác xài hàm (tblnext "block") thì nó sẽ lôi cả các thằng solid này vào trong danh sách các block để nó trảm bác ạ.
Có nhẽ cái lisp này được viết không phải cho các đối tượng 3D và cần phải tìm hiểu kỹ hơn mới có thể chỉnh sửa nó được bác ạ. Và nếu bác Duy góp sức thì có thể sẽ gỡ nó nhanh hơn.
Bác hãy gửi lại đầy đủ cái lisp này bác nhé. Bây giờ kiếm nó cũng hơi lâu vì tuy biết là có trên diện đàn nhưng cái khoản tìm kiếm này mình hơi kém bác ạ.
Hề hề hề,....

Chào bác Bình. Chúc Bác khỏe; không có dịp vào TP.HCM để giao lưu gặp gỡ các Bác, nhưng mỗi lần gặp lại làm phiền các Bác. Thật ra tôi cũng đang cần cái lisp 3D solid để có thể Scan 3D solid theo các trục x,y,z như mong muốn nhưng khổ nỗi là chẳng biết gì về cái khoản lisp.
Mong Bác và các Bác trên diễn đàn giúp cho. Cảm ơn
Tôi post lại lisp cũ
;Scale the mot chieu
(DEFUN EXCUTE()
(setq oldvalue (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(princ "Chon doi tuong can scale: ")
(setq ss (ssget))
(setq P0 (getpoint "\nChon diem goc: "))
(initget 1 "X Y X S")
(setq C (getkword "\nScale theo [X,Y,Z,Scale]? :"))
(setq hs (getreal "Cho biet he so scale: "))
(DELBLOCK "vkc_temp")
(CREATEBLOCK ss P0)
(Command "-Insert" "vkc_temp" C hs P0 "")
(setq dt (entlast))
(Command "Explode" dt)
(setvar "CMDECHO" oldvalue)
(princ)
)
(DEFUN CREATEBLOCK(ss P)
(command "-Block" "vkc_temp" P ss "")
)

(DEFUN DELBLOCK (bname)
(if (IsExistBlock bname)
(Command "-Purge" "B" bname "Y" "Y")
)
)
(DEFUN IsExistBlock(bname / kq)
(setq kq Nil)
(setq n (length LiBlk))
(setq i 0)
(while (< i n)
(if (= bname (nth i LiBlk))
(progn
(setq i n)
(setq kq T)
)
)
(setq i (1+ i))
)
kq
)
(DEFUN CREALIBLK (/ NL)
(setq LiBlk (List))
(setq NL (tblnext "BLOCK" T))
(while NL
(setq LiBlk (append LiBlk (list (cdr (assoc 2 NL)))))
(setq NL (tblnext "BLOCK"))
)
(setq LiBlk (Acad_strlsort LiBlk))
)
(DEFUN C:XSCALE()
(CREALIBLK)
(EXCUTE)
)
(DEFUN C:XSC()
(CREALIBLK)
(EXCUTE)
)
(princ "\nfree lisp from www.cadviet.com")
(princ)
  • 0

#1982 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 27 September 2010 - 07:15 PM

Chào các bạn!Nhờ các bạn viết dùm mình lisp có nội dung như sau với!
Chẳng là mình làm cấp thoát nước trong đó mình có thống kê đường kính bao nhiêu thì có tổng chiều dài là bao nhiêu!Giờ mình nhờ các bạn viết dùm mình với!Chi tiết các bạn xem trong bản vẽ dùm mình với!
Trình tự lisp như sau:
Gọi lệnh:
Lisp sẽ hỏi thống kê cấp nước hay thoát nước?
Giả sử mình chọn Cấp nước thì Lisp yêu cầu nhập loại đường kính cần thống kê
sau khi nhập xong lisp yêu cầu select object:
Quét chọn hết tất cả các Text trên màn hình thì sẽ ra kết quả tổng tổng chiều dài của đường kính mà mình mới nhập.
kết thúc lệnh chèn text kết quả ra màn hình (ví dụ:D300=100m)
Tương tự như vậy cho thoát nước
Trên đây chỉ là ý tưởng của em thôi, nếu các anh chị có thể cải tiến được là mình chỉ cần quét chọn hết tất cả các text trên màn hình sau đó pick ra màn hình thì nó sẽ hiện ra cái bảng với thông số từng loại D300=????, D400=????,...... thì quá tốt
Thật ra các text của cấp nước và thoát nước chỉ khác nhau ở chỗ là thoát nước có thêm độ dốc phía sau thôi!Còn mình quan tâm là quan tâm chiều dài.
Thanks các bạn nhiều!
http://www.cadviet.c...3/thongke_1.dwg

Chào bạn Truongthanh,
Có phải bạn cần như thế này không????

(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(setq ss (ssget (list (cons 0 "text")))
n (sslength ss)
i 0
tnlst (list)
cnlst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
txt (cdr (assoc 1 els))
)
(if (= (substr txt 1 1) (chr 216))
(if (> (strlen txt) 12)
(setq tnlst (append tnlst (list txt)))
(setq cnlst (append cnlst (list txt)))
)
)
(setq i (1+ i))
)
(setq tn (strcase (getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= tn "Y")
(seplst cnlst)
)
(setq cn (strcase (getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= cn "Y")
(seplst tnlst)
)


)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst / lst1 lst2 lst3 tdd lo )
(while (/= lst nil)
(setq a (substr (nth 0 lst) 1 4)
lst1 (cdr lst)
lst2 nil
tdd 0
lst2 (append lst2 (list (nth 0 lst)))
)
(foreach b lst1
(if (= (substr b 1 4) a)
(setq lst2 (append lst2 (list b )))
(setq lst3 (append lst3 (list b )))
)
)
(foreach c lst2
(setq tdd (+ tdd (atof (substr c 9 3)))
lo (substr c 1 4)
)
)
(alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2 ) ))
(setq lst lst3
lst3 nil
)
)
)


Bạn lưu ý như sau:
1/- Lisp này viết dựa trên cái file bạn gửi. Do vậy nếu bạn dùng các định dạng khác của text thì nó sẽ không chịu trách nhiệm đâu nhé. (ví dụ bạn sử dụng mtext thì nó sẽ không lọc được đối tượng, bạn sử dụng cách nhập ký tự "phi" khác nó cũng sẽ không biết để nhận dạng, bạn sử dụng số ký tự trong chuỗi text của bạn không đúng như bạn đã post thì nó sẽ cắt chuỗi sai và chạy sai .....)
2/- Do bạn chỉ yêu cầu thông báo kết quả nên mình chỉ trả kết quả bằng các thông báo alert, nếu bạn muốn tạo thành text trên bản vẽ thì cần cải tạo thêm một chút. Nếu bạn muốn lập bảng trên bản vẽ thì lại phải bổ xung thêm kha khá, và nếu bạn muốn xuất thành file text hay file xls sẽ lại phải phức tạp thêm bạn ạ.

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

#1983 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 27 September 2010 - 08:03 PM

Chào bác Bình. Chúc Bác khỏe; không có dịp vào TP.HCM để giao lưu gặp gỡ các Bác, nhưng mỗi lần gặp lại làm phiền các Bác. Thật ra tôi cũng đang cần cái lisp 3D solid để có thể Scan 3D solid theo các trục x,y,z như mong muốn nhưng khổ nỗi là chẳng biết gì về cái khoản lisp.
Mong Bác và các Bác trên diễn đàn giúp cho. Cảm ơn
Tôi post lại lisp cũ
;Scale the mot chieu

Chào bác tuannguyen314169,
Thực ra thì các bác trên diễn đàn có giúp mình tìm lại được cái lisp này rồi bác ạ. Mình cũng đã ngâm cứu nó thì thấy một số vấn đề như sau:
1/- Trông lisp thì nó rậm rì rắc rối vậy nhưng thực ra bản chất của nó chỉ là block cái cần scale lại rồi dùng insert để scale nó theo phương mình chọn mà thôi.
2/- Cái này dùng với 2D thì tốt vì sau khi insert lại explode nó ra để trả nó về các phần tử rời rạc bác ạ.
3/- Khi dùng với 3D, đặc biệt là mấy thằng solid 3D thì nảy sinh ra một việc là sau khi đã tạo block và insert rồi thì bí rị chả thể explode nó ra được nữa bác ạ. Trong khi ở solid thì bác có thể explode nó ra thành các bề mặt riêng rẽ. Đó chính là cái mà mình cũng chưa hiểu nguyên nhân vì sao. Do vậy nếu chỉ scale một phát mà không cần quan tâm tới việc chỉnh sửa tiếp theo thì có nhẽ sẽ giải quyết được bác ạ. Còn như sau khi scale bác lại muốn nắn bóp nó chút chút thì hơi gay. Mình cũng chưa có giải pháp nào khả dĩ. Có nhẽ phải chờ các bác khác rảnh rảnh giúp đỡ mới ăn thua.

Vậy nếu bác chấp nhận cái kiểu scale này thì bác có thể sử dụng ngay các lệnh của CAD để làm mà chả cần đến lisp làm chi cho nó thêm phần loằng ngoằng bác ạ. Cái lisp để làm như vậy có khi chả nhanh được hơn chút nào vì cũng phải bấy nhiêu thao tác bác ạ.

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

#1984 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 27 September 2010 - 08:27 PM

Chào bạn Truongthanh,
Có phải bạn cần như thế này không????


(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(setq ss (ssget (list (cons 0 "text")))
n (sslength ss)
i 0
tnlst (list)
cnlst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
txt (cdr (assoc 1 els))
)
(if (= (substr txt 1 1) (chr 216))
(if (> (strlen txt) 12)
(setq tnlst (append tnlst (list txt)))
(setq cnlst (append cnlst (list txt)))
)
)
(setq i (1+ i))
)
(setq tn (strcase
(getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= tn "Y")
(seplst cnlst)
)
(setq cn (strcase
(getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= cn "Y")
(seplst tnlst)
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst / lst1 lst2 lst3 tdd lo )
(while (/= lst nil)
(setq a (substr (nth 0 lst) 1 4)
lst1 (cdr lst)
lst2 nil
tdd 0
lst2 (append lst2 (list (nth 0 lst)))
)
(foreach b lst1
(if (= (substr b 1 4) a)
(setq lst2 (append lst2 (list b )))
(setq lst3 (append lst3 (list b )))
)
)
(foreach c lst2
(setq tdd (+ tdd (atof (substr c 9 3)))
lo (substr c 1 4)
)
)
(alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2 ) ))
(setq lst lst3
lst3 nil
)
)
)


Bạn lưu ý như sau:
1/- Lisp này viết dựa trên cái file bạn gửi. Do vậy nếu bạn dùng các định dạng khác của text thì nó sẽ không chịu trách nhiệm đâu nhé. (ví dụ bạn sử dụng mtext thì nó sẽ không lọc được đối tượng, bạn sử dụng cách nhập ký tự "phi" khác nó cũng sẽ không biết để nhận dạng, bạn sử dụng số ký tự trong chuỗi text của bạn không đúng như bạn đã post thì nó sẽ cắt chuỗi sai và chạy sai .....)
2/- Do bạn chỉ yêu cầu thông báo kết quả nên mình chỉ trả kết quả bằng các thông báo alert, nếu bạn muốn tạo thành text trên bản vẽ thì cần cải tạo thêm một chút. Nếu bạn muốn lập bảng trên bản vẽ thì lại phải bổ xung thêm kha khá, và nếu bạn muốn xuất thành file text hay file xls sẽ lại phải phức tạp thêm bạn ạ.

Chúc bạn vui.

Quả thật là em vui thiệt đó bác Bình ạ!Xin chân thành cảm ơn bác!
Lưu ý 1 của bác thì em xin ghi nhớ!
Còn lưu ý 2 của bác nếu như bác giúp nốt cho em thì càng tốt ạ!Cái chỗ lập bảng đó ạ!Nếu được như trong ví dụ file đính kèm sau thì càng tốt, còn nếu ko được cũng chả sao, chỉ cần cái bảng đơn giản gồm có đường kính và chiều dài là được rồi nhen bác!
http://www.cadviet.c...ng_thong_ke.dwg
Một lần nữa chân thành cảm ơn bác!
P/s: Bác có rãnh thì mở lớp dạy lập trình lisp đi bác!Em xin ghi danh đầu tiên!
  • 0

#1985 tuannguyen314169

tuannguyen314169

    biết lệnh ddedit

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

Đã gửi 27 September 2010 - 08:47 PM

Chào bác tuannguyen314169,
Thực ra thì các bác trên diễn đàn có giúp mình tìm lại được cái lisp này rồi bác ạ. Mình cũng đã ngâm cứu nó thì thấy một số vấn đề như sau:
1/- Trông lisp thì nó rậm rì rắc rối vậy nhưng thực ra bản chất của nó chỉ là block cái cần scale lại rồi dùng insert để scale nó theo phương mình chọn mà thôi.
2/- Cái này dùng với 2D thì tốt vì sau khi insert lại explode nó ra để trả nó về các phần tử rời rạc bác ạ.
3/- Khi dùng với 3D, đặc biệt là mấy thằng solid 3D thì nảy sinh ra một việc là sau khi đã tạo block và insert rồi thì bí rị chả thể explode nó ra được nữa bác ạ. Trong khi ở solid thì bác có thể explode nó ra thành các bề mặt riêng rẽ. Đó chính là cái mà mình cũng chưa hiểu nguyên nhân vì sao. Do vậy nếu chỉ scale một phát mà không cần quan tâm tới việc chỉnh sửa tiếp theo thì có nhẽ sẽ giải quyết được bác ạ. Còn như sau khi scale bác lại muốn nắn bóp nó chút chút thì hơi gay. Mình cũng chưa có giải pháp nào khả dĩ. Có nhẽ phải chờ các bác khác rảnh rảnh giúp đỡ mới ăn thua.

Vậy nếu bác chấp nhận cái kiểu scale này thì bác có thể sử dụng ngay các lệnh của CAD để làm mà chả cần đến lisp làm chi cho nó thêm phần loằng ngoằng bác ạ. Cái lisp để làm như vậy có khi chả nhanh được hơn chút nào vì cũng phải bấy nhiêu thao tác bác ạ.

Chúc bác luôn vui khỏe và trẻ mãi không già......

Chào Bác Bình, rất vui được gặp lại Bác. Chỉ có thể sử dụng lisp thì mới có thể làm được việc này vì lệnh scale của CAD đối với 3D solid, chỉ scale một phát là nó ra cả x,y,z theo hệ số nhất định.
Chúc bác tóc luôn đen mãi. Khà khà..
  • 0

#1986 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 27 September 2010 - 10:59 PM

Chào bạn Truongthanh,
Có phải bạn cần như thế này không????


(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(setq ss (ssget (list (cons 0 "text")))
n (sslength ss)
i 0
tnlst (list)
cnlst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
txt (cdr (assoc 1 els))
)
(if (= (substr txt 1 1) (chr 216))
(if (> (strlen txt) 12)
(setq tnlst (append tnlst (list txt)))
(setq cnlst (append cnlst (list txt)))
)
)
(setq i (1+ i))
)
(setq tn (strcase
(getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= tn "Y")
(seplst cnlst)
)
(setq cn (strcase
(getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= cn "Y")
(seplst tnlst)
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst / lst1 lst2 lst3 tdd lo )
(while (/= lst nil)
(setq a (substr (nth 0 lst) 1 4)
lst1 (cdr lst)
lst2 nil
tdd 0
lst2 (append lst2 (list (nth 0 lst)))
)
(foreach b lst1
(if (= (substr b 1 4) a)
(setq lst2 (append lst2 (list b )))
(setq lst3 (append lst3 (list b )))
)
)
(foreach c lst2
(setq tdd (+ tdd (atof (substr c 9 3)))
lo (substr c 1 4)
)
)
(alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2 ) ))
(setq lst lst3
lst3 nil
)
)
)


Bạn lưu ý như sau:
1/- Lisp này viết dựa trên cái file bạn gửi. Do vậy nếu bạn dùng các định dạng khác của text thì nó sẽ không chịu trách nhiệm đâu nhé. (ví dụ bạn sử dụng mtext thì nó sẽ không lọc được đối tượng, bạn sử dụng cách nhập ký tự "phi" khác nó cũng sẽ không biết để nhận dạng, bạn sử dụng số ký tự trong chuỗi text của bạn không đúng như bạn đã post thì nó sẽ cắt chuỗi sai và chạy sai .....)
2/- Do bạn chỉ yêu cầu thông báo kết quả nên mình chỉ trả kết quả bằng các thông báo alert, nếu bạn muốn tạo thành text trên bản vẽ thì cần cải tạo thêm một chút. Nếu bạn muốn lập bảng trên bản vẽ thì lại phải bổ xung thêm kha khá, và nếu bạn muốn xuất thành file text hay file xls sẽ lại phải phức tạp thêm bạn ạ.

Chúc bạn vui.

Chào bác Bình!Tối giờ em ngồi test em mới phát hiện ra khi em thống kê tới đường kính D1000 và L=1000 thì lisp ko hiểu bác ơi!Có fai lisp chỉ hiểu chỗ đường kính tối đa có 3 chữ số và chiều dài cũng tối đa 3 chữ số ko bác?Nhờ bác sữa lại dùm em với!
Thanks bác nhiều!
  • 0

#1987 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 27 September 2010 - 11:22 PM

Phù cuối cùng thì cũng hoàn thành cái mớ bòng bong này. Từ lisp ve tường ban đầu mình đã phát triển được như thế này rôi.
Hình đã gửi
Xin lỗi bạn ketxu vì chưa sét thêm phần chọn tỉ lệ vào được. Mình đang kiểm tra xem không biết nó sai chỗ nào mà nhập số nhỏ vào thì nó lại không chạy.
Còn phần dim cho các trường hợp các đường tim chéo thì quá phức tạp có lẽ mình chỉ nên dừng ở trường hợp các đường tim song song với ox oy thôi.
Các bạn test thử xem có bổ xung thêm gì không. Trong khả năng của mình sẽ hết sức để vừa lòng các bạn. Chúc diễn đàn luôn luôn phát triển.

;; free lisp from cadviet.com
(defun c:vetuong ()
(initvetuong)
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setq tbl (tblsearch "layer" "_tim"))
(if (= tbl nil) (command "-layer" "n" "_tim" "c" "8" "_tim" "l" "center" "_tim" ""))
(setq tbl (tblsearch "layer" "template"))
(if (= tbl nil) (command "-layer" "n" "template" ""))
(setvar "clayer" "template")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(setq day (cond (day) (220)))
(setq oldday day)
(setq day (getint (strcat "\nnhap chieu day tuong <"(rtos oldday 2 1)"> : ")))
(if (null day)
(setq day oldday)
)
(setq day1 (/ (* day 7) 15))
(command "change" ss "" "p" "la" "_tim" "")
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while (< j (length lp))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
angf (+ (angle pt1 pt2) (/ pi 2))
t1 (polar pt1 angf day1)
t2 (polar pt1 (+ angf pi) day1)
t3 (polar pt2 (+ angf pi) day1)
t4 (polar pt2 angf day1)
)
(command "trim" ssml "" "f" t1 t2 t3 t4 t1 "" "")
(setq j (1+ j))
)
(setq q 0)
(setq ssml (ssget "x" '((0 . "line") (8 . "template"))))
(while (< q (sslength ssml))
(setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while (< k (sslength ssml))
(setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (and (< d1 (* day1 2)) (> d1 0)) (and (< d2 (* day1 2)) (> d2 0))
(and (< d3 (* day1 2)) (> d3 0)) (and (< d4 (* day1 2)) (> d4 0)))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "tuong" "")
(dimtuong)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
(command "trim" "" "e" "n" "")
)
;******************************************
(defun c:vt ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq dt (cond (dt) (220)))
(setq olddt dt)
(setq dt (getint (strcat "\nrong tuong <"(rtos olddt 2 1)"> : ")))
(if (null dt)
(setq dt olddt)
)
(setq pt1 (getpoint "\ndiem thu nhat:")
pt2 (getpoint "\ndiem thu hai:" pt1)
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" dt pt1 pt2 "")
(setq mll (entlast))
(command "trim" mll "" "f" pt1 pt2 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
(command "trim" "" "e" "n" "")
)
;*****************************************
(defun c:vc ()
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq cua (cond (cua) (900)))
(setq oldcua cua)
(setq cua (getint (strcat "\nrong cua <"(rtos oldcua 2 1)"> : ")))
(if (null cua)
(setq cua oldcua)
)
(setq pc1 (getpoint "\ndiem thu nhat:")
pc2 (getpoint "\ndiem thu hai:" pc1)
ang (+ (angle pc1 pc2) (/ (* 90 pi) 180))
pc3 (polar pc1 ang (+ 110 (/ cua 2)))
pc4 (polar pc2 ang (+ 110 (/ cua 2)))
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" cua pc3 pc4 "")
(setq mll (entlast))
(command "trim" mll "" "f" pc3 pc4 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
)
;*****************************************
(defun dimtuong ()
(setq e nil c nil)
(setq tbl (tblsearch "layer" "_dim"))
(if (= tbl nil) (command "-layer" "n" "_dim" "c" "8" "_dim" ""))
(setvar "clayer" "_dim")
(setq tldim (getvar "dimscale"))
(setq th (getvar "dimtxt"))
(setq a 0)
(setq lpx nil)
(setq lpy nil)
(while (< a (length lp))
(setq px1 (car (car (nth a lp)))
py1 (cadr (car (nth a lp)))
px2 (car (cadr (nth a lp)))
py2 (cadr (cadr (nth a lp)))
)
(if (/= py1 py2)
(setq lpx (append (list px1) lpx))
)
(if (= py1 py2)
(setq lpy (append (list py1) lpy))
)
(setq a (1+ a))
)
(setq lpx (vl-sort lpx '<))
(setq lpy (vl-sort lpy '<))
(setq dc (- (last lpx) (car lpx)))
(setq pdi (list (car lpx) (- (car lpy) (/ dc 40)) 0))
(setq pdi2 (list (- (car lpx) (/ dc 40)) (car lpy) 0))
(setq pdim (polar pdi pi (/ day 2)))
(setq pdim2 (polar pdi2 (/ (* pi 3) 2) (/ day 2)))
(setq pdim1 (polar pdi (/ (* pi 3) 2) (/ dc 25)))
(setq pdim12 (polar pdi2 pi (/ dc 25)))
(command "_dimlinear" pdi pdim pdim1)
(command "_dimlinear" pdi2 pdim2 pdim12)
(setq c 0)
(while (< (1+ c) (length lpx))
(setq y (cadr pdim)
x1 (nth c lpx)
x2 (nth (1+ c) lpx)
dd1 (list x1 y 0)
dd2 (list x2 y 0)
tam (list x1 (- (cadr pdim1) (* (* tldim th) 6)) 0)
)
(command "_dimlinear" dd1 dd2 pdim1)
(vetruc)
(setq c (1+ c))
)
(setq tam (list x2 (- (cadr pdim1) (* (* tldim th) 6)) 0))
(vetruc)
(setq c nil)
(setq e 0)
(while (< (1+ e) (length lpy))
(setq x (car pdim2)
y1 (nth e lpy)
y2 (nth (1+ e) lpy)
ddy1 (list x y1 0)
ddy2 (list x y2 0)
tam (list (- (car pdim12) (* (* tldim th) 7)) y1 0)
)
(command "_dimlinear" ddy1 ddy2 pdim12)
(vetruc)
(setq e (1+ e))
)
(setq tam (list (- (car pdim12) (* (* tldim th) 7)) y2 0))
(vetruc)
(setq e nil)
(setq pcc (polar dd2 0 (/ day 2)))
(setq pcc2 (polar ddy2 (/ pi 2) (/ day 2)))
(command "_dimlinear" dd2 pcc pdim1)
(command "_dimlinear" ddy2 pcc2 pdim12)
(command "_dimlinear" pdim pcc (polar pdim1 (/ (* pi 3) 2) (* (* tldim th) 3)))
(command "_dimlinear" pdim2 pcc2 (polar pdim12 pi (* (* tldim th) 3)))
)
;*************************
(defun vetruc ()
(if (= (tblsearch "style" "chutruc") nil)
(command "style" "chutruc" ".VnAvantH" "" "0.8" "" "" ""))
(setq r (* (* th tldim) 2)
r2 (/ r 1.2)
dline1 (polar tam 0 r2)
dline2 (polar dline1 0 (/ (* r2 2) 3))
listtrucx '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
listtrucy '("A" "B" "C" "D" "E" "F" "G" "H" "I" "K" "L" "N" "M" "O"
"P" "Q" "R" "S" "T" "U" "V" "X" "Y" "Z")
)
(command "circle" tam r)
(command "change" "l" "" "p" "la" "tuong" "")
(command "circle" tam r2)
(command "change" "l" "" "p" "la" "_dim" "")
(command "line" dline1 dline2 "")
(command "change" "l" "" "p" "la" "tuong" "")
(command "-array" "p" "" "p" tam "4" "360" "y")
(if (= e nil)
(command "-text" "j" "m" tam r "0" (rtos (nth c listtrucx)))
)
(if (= c nil)
(command "-text" "j" "m" tam r "0" (nth e listtrucy))
)
)
;********************************
(defun initvetuong ()
(setq
vetuong_old_er *error*
*error* vetuongerror
)
)
;**************************
(defun vetuongerror (errmsg)
(loivetuong)
)
;**************************
(defun loivetuong ()
(setq *error* vetuong_old_er)
(command "undo" "end")
(command "undo" "")
(princ "xay ra loi trong qua trinh ve")
)
;**************************

BS: Cái lệnh VT với VC là mình viết thêm để chổ cửa và vẽ tường cho nhanh thôi các bạn tự nghiên cứu.
  • 4
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#1988 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 28 September 2010 - 07:32 AM

Chào các bạn!Nhờ các bạn viết dùm mình lisp có nội dung như sau với!
Chẳng là mình làm cấp thoát nước trong đó mình có thống kê đường kính bao nhiêu thì có tổng chiều dài là bao nhiêu!Giờ mình nhờ các bạn viết dùm mình với!Chi tiết các bạn xem trong bản vẽ dùm mình với!
Trình tự lisp như sau:
Gọi lệnh:
Lisp sẽ hỏi thống kê cấp nước hay thoát nước?
Giả sử mình chọn Cấp nước thì Lisp yêu cầu nhập loại đường kính cần thống kê
sau khi nhập xong lisp yêu cầu select object:
Quét chọn hết tất cả các Text trên màn hình thì sẽ ra kết quả tổng tổng chiều dài của đường kính mà mình mới nhập.
kết thúc lệnh chèn text kết quả ra màn hình (ví dụ:D300=100m)
Tương tự như vậy cho thoát nước
Trên đây chỉ là ý tưởng của em thôi, nếu các anh chị có thể cải tiến được là mình chỉ cần quét chọn hết tất cả các text trên màn hình sau đó pick ra màn hình thì nó sẽ hiện ra cái bảng với thông số từng loại D300=????, D400=????,...... thì quá tốt
Thật ra các text của cấp nước và thoát nước chỉ khác nhau ở chỗ là thoát nước có thêm độ dốc phía sau thôi!Còn mình quan tâm là quan tâm chiều dài.
Thanks các bạn nhiều!
http://www.cadviet.c...3/thongke_1.dwg

Truongthanh thử cái này :
http://www.cadviet.c...les/3/tkn_2.zip

Bài viết đã được chỉnh sửa nội dung bởi Tue_NV: 29 September 2010 - 07:08 PM
Đã fix lỗi Cong so - ngay 29/09/2010

  • 1

#1989 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 28 September 2010 - 08:29 AM

Phù cuối cùng thì cũng hoàn thành cái mớ bòng bong này. Từ lisp ve tường ban đầu mình đã phát triển được như thế này rôi.
Hình đã gửi
Xin lỗi bạn ketxu vì chưa sét thêm phần chọn tỉ lệ vào được. Mình đang kiểm tra xem không biết nó sai chỗ nào mà nhập số nhỏ vào thì nó lại không chạy.
Còn phần dim cho các trường hợp các đường tim chéo thì quá phức tạp có lẽ mình chỉ nên dừng ở trường hợp các đường tim song song với ox oy thôi.
Các bạn test thử xem có bổ xung thêm gì không. Trong khả năng của mình sẽ hết sức để vừa lòng các bạn. Chúc diễn đàn luôn luôn phát triển.


;; free lisp from cadviet.com
(defun c:vetuong ()
(initvetuong)
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setq tbl (tblsearch "layer" "_tim"))
(if (= tbl nil) (command "-layer" "n" "_tim" "c" "8" "_tim" "l" "center" "_tim" ""))
(setq tbl (tblsearch "layer" "template"))
(if (= tbl nil) (command "-layer" "n" "template" ""))
(setvar "clayer" "template")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(setq day (cond (day) (220)))
(setq oldday day)
(setq day (getint (strcat "\nnhap chieu day tuong <"(rtos oldday 2 1)"> : ")))
(if (null day)
(setq day oldday)
)
(setq day1 (/ (* day 7) 15))
(command "change" ss "" "p" "la" "_tim" "")
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while (< j (length lp))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
angf (+ (angle pt1 pt2) (/ pi 2))
t1 (polar pt1 angf day1)
t2 (polar pt1 (+ angf pi) day1)
t3 (polar pt2 (+ angf pi) day1)
t4 (polar pt2 angf day1)
)
(command "trim" ssml "" "f" t1 t2 t3 t4 t1 "" "")
(setq j (1+ j))
)
(setq q 0)
(setq ssml (ssget "x" '((0 . "line") (8 . "template"))))
(while (< q (sslength ssml))
(setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while (< k (sslength ssml))
(setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (and (< d1 (* day1 2)) (> d1 0)) (and (< d2 (* day1 2)) (> d2 0))
(and (< d3 (* day1 2)) (> d3 0)) (and (< d4 (* day1 2)) (> d4 0)))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "tuong" "")
(dimtuong)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
(command "trim" "" "e" "n" "")
)
;******************************************
(defun c:vt ()
(command "trim" "" "e" "e" "p" "n" "")
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq dt (cond (dt) (220)))
(setq olddt dt)
(setq dt (getint (strcat "\nrong tuong <"(rtos olddt 2 1)"> : ")))
(if (null dt)
(setq dt olddt)
)
(setq pt1 (getpoint "\ndiem thu nhat:")
pt2 (getpoint "\ndiem thu hai:" pt1)
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" dt pt1 pt2 "")
(setq mll (entlast))
(command "trim" mll "" "f" pt1 pt2 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
(command "trim" "" "e" "n" "")
)
;*****************************************
(defun c:vc ()
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq cua (cond (cua) (900)))
(setq oldcua cua)
(setq cua (getint (strcat "\nrong cua <"(rtos oldcua 2 1)"> : ")))
(if (null cua)
(setq cua oldcua)
)
(setq pc1 (getpoint "\ndiem thu nhat:")
pc2 (getpoint "\ndiem thu hai:" pc1)
ang (+ (angle pc1 pc2) (/ (* 90 pi) 180))
pc3 (polar pc1 ang (+ 110 (/ cua 2)))
pc4 (polar pc2 ang (+ 110 (/ cua 2)))
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" cua pc3 pc4 "")
(setq mll (entlast))
(command "trim" mll "" "f" pc3 pc4 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
)
;*****************************************
(defun dimtuong ()
(setq e nil c nil)
(setq tbl (tblsearch "layer" "_dim"))
(if (= tbl nil) (command "-layer" "n" "_dim" "c" "8" "_dim" ""))
(setvar "clayer" "_dim")
(setq tldim (getvar "dimscale"))
(setq th (getvar "dimtxt"))
(setq a 0)
(setq lpx nil)
(setq lpy nil)
(while (< a (length lp))
(setq px1 (car (car (nth a lp)))
py1 (cadr (car (nth a lp)))
px2 (car (cadr (nth a lp)))
py2 (cadr (cadr (nth a lp)))
)
(if (/= py1 py2)
(setq lpx (append (list px1) lpx))
)
(if (= py1 py2)
(setq lpy (append (list py1) lpy))
)
(setq a (1+ a))
)
(setq lpx (vl-sort lpx '<))
(setq lpy (vl-sort lpy '<))
(setq dc (- (last lpx) (car lpx)))
(setq pdi (list (car lpx) (- (car lpy) (/ dc 40)) 0))
(setq pdi2 (list (- (car lpx) (/ dc 40)) (car lpy) 0))
(setq pdim (polar pdi pi (/ day 2)))
(setq pdim2 (polar pdi2 (/ (* pi 3) 2) (/ day 2)))
(setq pdim1 (polar pdi (/ (* pi 3) 2) (/ dc 25)))
(setq pdim12 (polar pdi2 pi (/ dc 25)))
(command "_dimlinear" pdi pdim pdim1)
(command "_dimlinear" pdi2 pdim2 pdim12)
(setq c 0)
(while (< (1+ c) (length lpx))
(setq y (cadr pdim)
x1 (nth c lpx)
x2 (nth (1+ c) lpx)
dd1 (list x1 y 0)
dd2 (list x2 y 0)
tam (list x1 (- (cadr pdim1) (* (* tldim th) 6)) 0)
)
(command "_dimlinear" dd1 dd2 pdim1)
(vetruc)
(setq c (1+ c))
)
(setq tam (list x2 (- (cadr pdim1) (* (* tldim th) 6)) 0))
(vetruc)
(setq c nil)
(setq e 0)
(while (< (1+ e) (length lpy))
(setq x (car pdim2)
y1 (nth e lpy)
y2 (nth (1+ e) lpy)
ddy1 (list x y1 0)
ddy2 (list x y2 0)
tam (list (- (car pdim12) (* (* tldim th) 7)) y1 0)
)
(command "_dimlinear" ddy1 ddy2 pdim12)
(vetruc)
(setq e (1+ e))
)
(setq tam (list (- (car pdim12) (* (* tldim th) 7)) y2 0))
(vetruc)
(setq e nil)
(setq pcc (polar dd2 0 (/ day 2)))
(setq pcc2 (polar ddy2 (/ pi 2) (/ day 2)))
(command "_dimlinear" dd2 pcc pdim1)
(command "_dimlinear" ddy2 pcc2 pdim12)
(command "_dimlinear" pdim pcc (polar pdim1 (/ (* pi 3) 2) (* (* tldim th) 3)))
(command "_dimlinear" pdim2 pcc2 (polar pdim12 pi (* (* tldim th) 3)))
)
;*************************
(defun vetruc ()
(if (= (tblsearch "style" "chutruc") nil)
(command "style" "chutruc" ".VnAvantH" "" "0.8" "" "" ""))
(setq r (* (* th tldim) 2)
r2 (/ r 1.2)
dline1 (polar tam 0 r2)
dline2 (polar dline1 0 (/ (* r2 2) 3))
listtrucx '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
listtrucy '("A" "B" "C" "D" "E" "F" "G" "H" "I" "K" "L" "N" "M" "O"
"P" "Q" "R" "S" "T" "U" "V" "X" "Y" "Z")
)
(command "circle" tam r)
(command "change" "l" "" "p" "la" "tuong" "")
(command "circle" tam r2)
(command "change" "l" "" "p" "la" "_dim" "")
(command "line" dline1 dline2 "")
(command "change" "l" "" "p" "la" "tuong" "")
(command "-array" "p" "" "p" tam "4" "360" "y")
(if (= e nil)
(command "-text" "j" "m" tam r "0" (rtos (nth c listtrucx)))
)
(if (= c nil)
(command "-text" "j" "m" tam r "0" (nth e listtrucy))
)
)
;********************************
(defun initvetuong ()
(setq
vetuong_old_er *error*
*error* vetuongerror
)
)
;**************************
(defun vetuongerror (errmsg)
(loivetuong)
)
;**************************
(defun loivetuong ()
(setq *error* vetuong_old_er)
(command "undo" "end")
(command "undo" "")
(princ "xay ra loi trong qua trinh ve")
)
;**************************

BS: Cái lệnh VT với VC là mình viết thêm để chổ cửa và vẽ tường cho nhanh thôi các bạn tự nghiên cứu.

Cám ơn bác,code đã khá đẹp và công phu ^^.Nhưng em vẫn chờ ngày Tỉ lệ được đặt vào ^^.Hihi(tham)
Hiện tại thì trục vẽ rất đẹp,nhưng vì không có lựa chọn cho user là đánh số từ trái qua phải sẽ bắt đầu từ đâu,tăng hay giảm,từ trên xuống dưới cũng vậy.Nên vô hình chung,chẳng may trục có sẵn của bên Ktrúc (giả sử bọn e là dân KCấu vẽ lại) lại đặt là 7-6-5-4...,C-D-E... thì lại phải ngồi sửa lại bác ạ.Nhưng nói chung phần này chưa quan trọng lắm ^^.E tiếp tục test nữa,có gì bác đừng phật ý nhé
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#1990 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 28 September 2010 - 08:37 AM

Chào Bác Bình, rất vui được gặp lại Bác. Chỉ có thể sử dụng lisp thì mới có thể làm được việc này vì lệnh scale của CAD đối với 3D solid, chỉ scale một phát là nó ra cả x,y,z theo hệ số nhất định.
Chúc bác tóc luôn đen mãi. Khà khà..

Hề hề hề,
Không phải đâu là không phải đâu bác tuannguyen314169 ạ.Thằng Insert nó cho scale theo cả ba phương đó mà là tỷ lệ mỗi phuong do bác tùy hứng bác à.
Bác làm thế này nhé:
1/- Bác tạo một block chứa cái thằng Solid của bác, nếu muốn bác nhét vài chục thằng vô đó cũng được bác ạ.
2/- Bác dùng lệnh Insert để insert cái thằng block vừa tạo vào bản vẽ. Khi Insert, nó hỏi bác
Specify insertion point or [Scale/X/Y/Z/Rotate/PScale/PX/PY/PZ/PRotate]: Bác đừng chọn insert point ngay mà nhập x từ bàn phím. Sau đó Cad thong báo:
Specify X scale factor: Bác nhập giá trị tỷ lệ theo trục x. Lúc này Cad sẽ yêu cầu bác nhập điểm insert:
Specify insertion point: Bác đừng chọn điểm mà nhập tiếp y từ bàn phím và CAD sẽ thông báo:
Specify Y scale factor: Bác nhập vào tỷ lệ scale theo trục y. Khi đó CAD lại yêu cầu bác nhập điểm insert:
Specify insertion point: Bác nhập tiếp z thay vì nhập điểm insert point. Cad sẽ thông báo:
Specify Z scale factor: Bác nhập nốt tỷ lệ scale theo trục z . Lúc nay CAD sẽ yêu cầu bác nhập điểm insert:
Specify insertion point: Giờ thì bác yên tâm nhập vào cái điểm insert point mà bác muốn. Lúc này CAD sẽ yêu cầu bác nhập góc quay của block
Specify rotation angle <0>: Tùy ý thich của bác mà bác nhập cho nó một giá trị góc hay nhấn enter để chấp nhận giá trị mặc định là 0.

Và thế là bác có một (hay nhiều) thằng solid đã được scale theo các trục y như bác mong đợi. Có diều nếu bác muốn explode thằng cu này ra để sửa chữa thì ô hô ai tai lắm vì nó không chịu explode bác ạ.

Bác cứ thử vài thằng xem sao, có khi lại tìm ra cái hay hay của nó đó bác à

Chúc bác vui.


PS: Cám ơn lời chúc của bác, Dưng mà như vậy tốn thuốc nhuộm lắm bác à. Hề hề hề......
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1991 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 28 September 2010 - 09:19 AM

Chào bác Bình!Tối giờ em ngồi test em mới phát hiện ra khi em thống kê tới đường kính D1000 và L=1000 thì lisp ko hiểu bác ơi!Có fai lisp chỉ hiểu chỗ đường kính tối đa có 3 chữ số và chiều dài cũng tối đa 3 chữ số ko bác?Nhờ bác sữa lại dùm em với!
Thanks bác nhiều!

Chào bạn Truongthanh,
Cái điều bạn nói mình đã biết từ khi viết lisp nên mới có cái ghi chú 1 cho bạn.
Vấn đề chính là mình không biết bạn cần tối đa đến bao nhiêu chữ số để thống kê nên làm tạm thời cái để bạn dùng theo như bản vẽ bạn đã post mà thôi. Bạn muốn thống kê với các kích thước lên tới bao nhiêu chữ số thì phải đề xuất chứ làm sao mình biết được.
Trong trường hợp số chữ số tăng lên khá lớn thì bạn cũng sẽ phải cấu trúc lại cái text ghi chú của bạn cho phù hợp mới được bạn ạ. Tỳ như lấy số chữ số lơn nhất của đường kinh làm giới hạn thì tất cả những kích thước có ít chữ số hơn số này bạn nên thêm vào các ký tự để nó có tổng số ký tự là như tổng số ký tự của kích thước lớn nhất.
Sở dĩ vậy là vì trong lisp mình sử dụng hàm tách chuỗi dựa trên số ký tự này bạn ạ.
Cũng tương tự đối với trường hợp kích thước chiều dài bạn ạ.
Thực ra cũng có phương án tách chuỗi khác nhưng phức tạp hơn và mình chưa thử. Mình sẽ xem xét kỹ lại vấn đề này.
Chúc bạn vui.

PS: Về lớp học viết lisp thì trên diễn đàn đã có, và mình cũng chỉ là một trong số những học trò trong lớp. Nếu bạn muốn bạn có thể tham gia vào lớp học này mà chả mất xu học phí nào. Bạn hãy tìm các topic Hương dẫn viết lisp và cùng nhau học lisp để tham gia bạn nhé.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1992 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 28 September 2010 - 10:42 AM

Chào bạn Truongthanh,
Cái điều bạn nói mình đã biết từ khi viết lisp nên mới có cái ghi chú 1 cho bạn.
Vấn đề chính là mình không biết bạn cần tối đa đến bao nhiêu chữ số để thống kê nên làm tạm thời cái để bạn dùng theo như bản vẽ bạn đã post mà thôi. Bạn muốn thống kê với các kích thước lên tới bao nhiêu chữ số thì phải đề xuất chứ làm sao mình biết được.
Trong trường hợp số chữ số tăng lên khá lớn thì bạn cũng sẽ phải cấu trúc lại cái text ghi chú của bạn cho phù hợp mới được bạn ạ. Tỳ như lấy số chữ số lơn nhất của đường kinh làm giới hạn thì tất cả những kích thước có ít chữ số hơn số này bạn nên thêm vào các ký tự để nó có tổng số ký tự là như tổng số ký tự của kích thước lớn nhất.
Sở dĩ vậy là vì trong lisp mình sử dụng hàm tách chuỗi dựa trên số ký tự này bạn ạ.
Cũng tương tự đối với trường hợp kích thước chiều dài bạn ạ.
Thực ra cũng có phương án tách chuỗi khác nhưng phức tạp hơn và mình chưa thử. Mình sẽ xem xét kỹ lại vấn đề này.
Chúc bạn vui.

PS: Về lớp học viết lisp thì trên diễn đàn đã có, và mình cũng chỉ là một trong số những học trò trong lớp. Nếu bạn muốn bạn có thể tham gia vào lớp học này mà chả mất xu học phí nào. Bạn hãy tìm các topic Hương dẫn viết lisp và cùng nhau học lisp để tham gia bạn nhé.

Dạ em xin lỗi bác vì file em đưa ko có tổng quát ạ! Vậy bây giờ nhờ bác sửa dùm em với:
Đối với đường kính thì tối đa là 4 chữ số, chiều dài cũng vậy bác ạ (tóm lại là đến đơn vị hàng ngàn là tối đa nhen bác)
Em xin cảm ơn bác nhiều!
Sory bác nhen!
  • 0

#1993 tuannguyen314169

tuannguyen314169

    biết lệnh ddedit

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

Đã gửi 28 September 2010 - 10:50 AM

Hề hề hề,
Không phải đâu là không phải đâu bác tuannguyen314169 ạ.Thằng Insert nó cho scale theo cả ba phương đó mà là tỷ lệ mỗi phuong do bác tùy hứng bác à.
Bác làm thế này nhé:
1/- Bác tạo một block chứa cái thằng Solid của bác, nếu muốn bác nhét vài chục thằng vô đó cũng được bác ạ.
2/- Bác dùng lệnh Insert để insert cái thằng block vừa tạo vào bản vẽ. Khi Insert, nó hỏi bác
Specify insertion point or [Scale/X/Y/Z/Rotate/PScale/PX/PY/PZ/PRotate]: Bác đừng chọn insert point ngay mà nhập x từ bàn phím. Sau đó Cad thong báo:
Specify X scale factor: Bác nhập giá trị tỷ lệ theo trục x. Lúc này Cad sẽ yêu cầu bác nhập điểm insert:
Specify insertion point: Bác đừng chọn điểm mà nhập tiếp y từ bàn phím và CAD sẽ thông báo:
Specify Y scale factor: Bác nhập vào tỷ lệ scale theo trục y. Khi đó CAD lại yêu cầu bác nhập điểm insert:
Specify insertion point: Bác nhập tiếp z thay vì nhập điểm insert point. Cad sẽ thông báo:
Specify Z scale factor: Bác nhập nốt tỷ lệ scale theo trục z . Lúc nay CAD sẽ yêu cầu bác nhập điểm insert:
Specify insertion point: Giờ thì bác yên tâm nhập vào cái điểm insert point mà bác muốn. Lúc này CAD sẽ yêu cầu bác nhập góc quay của block
Specify rotation angle <0>: Tùy ý thich của bác mà bác nhập cho nó một giá trị góc hay nhấn enter để chấp nhận giá trị mặc định là 0.

Và thế là bác có một (hay nhiều) thằng solid đã được scale theo các trục y như bác mong đợi. Có diều nếu bác muốn explode thằng cu này ra để sửa chữa thì ô hô ai tai lắm vì nó không chịu explode bác ạ.

Bác cứ thử vài thằng xem sao, có khi lại tìm ra cái hay hay của nó đó bác à

Chúc bác vui.
PS: Cám ơn lời chúc của bác, Dưng mà như vậy tốn thuốc nhuộm lắm bác à. Hề hề hề......

Cảm ơn Bác rất nhiều, tôi dùng lệnh scale sau đó select objects_specify base point _specify factor or [copy/reference] thì nó ra cả x,y,z và sau đó là bó tay.com may mà có Bác gợi ý để làm tiếp nhưng mình làm theo bác vẫn không thực hiện được. Như sau:
1/Tạo một block chứa cái thằng Solid như bác chỉ dẫn.
2/ Dùng lệnh insert thì nó ra cái bản insert * chư không theo bác chỉ dẫn nữa.
Không biết có phải do mình sử dụng cad 2008 nên không được chăng? hoặc có gì sai sót trong qu1a trình thao tác? Mong bác chỉ giáo. Cảm ơn. Lấn này thì chúc bác lấy tiền thuốc nhuộm anh em ta đi nhậu. khà khà..
*Hình đã gửi
  • 0

#1994 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 28 September 2010 - 11:01 AM

Dạ em xin lỗi bác vì file em đưa ko có tổng quát ạ! Vậy bây giờ nhờ bác sửa dùm em với:
Đối với đường kính thì tối đa là 4 chữ số, chiều dài cũng vậy bác ạ (tóm lại là đến đơn vị hàng ngàn là tối đa nhen bác)
Em xin cảm ơn bác nhiều!
Sory bác nhen!

Chiều dài bao nhiêu cũng được tất.
Lísp đã viết cho truongthanh ở bài viết số 2018
Bai viet so 2018
  • 1

#1995 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 28 September 2010 - 11:10 AM

Chiều dài bao nhiêu cũng được tất.
Lísp đã viết cho truongthanh ở bài viết số 2018
Bai viet so 2018

Xin lỗi TUE nhiều!Do bài nhiều bài viết dài quá nên mình ko thấy bài viết TUE giúp mình!Xin chân thành cảm ơn TUE rất nhiều!Mình đang test có gì mình sẽ báo liền!
Cảm ơn TUE và bác BÌNH rất nhiều!
  • 0

#1996 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 28 September 2010 - 11:35 AM

Chiều dài bao nhiêu cũng được tất.
Lísp đã viết cho truongthanh ở bài viết số 2018
Bai viet so 2018

Chào Tue!
Trước hết xin cảm ơn TUE rất nhiều!Mình đã test và thấy OK nhưng có 1 vấn đề nhỏ là khi lập bảng thống kê ko biết theo quy luật nào hết (Mình muốn từ đường kính nhỏ đến lớn). Tue xem file cad mình đính kèm nhen!
Cảm ơn TUE nhiều!
http://www.cadviet.c...es/3/test_5.dwg
  • 0

#1997 manhdlk

manhdlk

    biết pan

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

Đã gửi 28 September 2010 - 04:53 PM

Chào các bác.

Em có một bài toán này mong muốn các bác giúp em. Em cũng đã search trên forum nhưng không thấy.
Đề bài như thế này: Cho hai đường thẳng cắt nhau, em muốn vẽ một cung tròn tiếp tuyến với hai đường thẳng này tại tiếp điểm cho trước. Cảm ơn các bác trước.
Hình đã gửi
  • 0

#1998 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 28 September 2010 - 05:35 PM

Cảm ơn Bác rất nhiều, tôi dùng lệnh scale sau đó select objects_specify base point _specify factor or [copy/reference] thì nó ra cả x,y,z và sau đó là bó tay.com may mà có Bác gợi ý để làm tiếp nhưng mình làm theo bác vẫn không thực hiện được. Như sau:
1/Tạo một block chứa cái thằng Solid như bác chỉ dẫn.
2/ Dùng lệnh insert thì nó ra cái bản insert * chư không theo bác chỉ dẫn nữa.
Không biết có phải do mình sử dụng cad 2008 nên không được chăng? hoặc có gì sai sót trong qu1a trình thao tác? Mong bác chỉ giáo. Cảm ơn. Lấn này thì chúc bác lấy tiền thuốc nhuộm anh em ta đi nhậu. khà khà..
*Hình đã gửi

Ối giời ơi, xin lỗi bác tuannguyen314169 nghen,
Mình nói chua kỹ làm bác chưa hiểu ra.
Số là khi tạo block bác phải cho nó một cái tên, tí Tèo chi cũng được nhưng mà phải có cái tên này thì khi insert bác mới vào cái ô (block) name để chọn nó được bác ạ. (chọn bằng cách kích vào cái mũi tên đen ở góc phải ô , nó xổ ra một loạt cái name rồi bác click cái tên bác vừa đặt) Sau khi chọn cái tên Tí hoặc tèo đó xong là bác nhấn Ok khi đó nó sẽ ra đúng như cái mình đã nói ở bài trước. Bác làm lại xem nhé.
Hề hề hề,
Sorry bác mấy cái nữa nghen.....
PS: cái bảng hiện ra của bác là chính hiệu ông cụ rồi đó bác, nó y chang cái bảng của 2004 mình vẫn xài bác ạ. Hề hề hề....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1999 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 28 September 2010 - 06:10 PM

Dạ em xin lỗi bác vì file em đưa ko có tổng quát ạ! Vậy bây giờ nhờ bác sửa dùm em với:
Đối với đường kính thì tối đa là 4 chữ số, chiều dài cũng vậy bác ạ (tóm lại là đến đơn vị hàng ngàn là tối đa nhen bác)
Em xin cảm ơn bác nhiều!
Sory bác nhen!

Chào bạn Truongthanh,
Lisp này mình bổ sung phần tạo bảng thống kê theo mẫu bạn đã gửi. Tuy nhiên phần bổ sung cho các kích thước có tới 4 chữ số thì mình chưa nghĩ ra giải pháp hữu hiệu vì muốn nó tổng quát hơn. Định mót của bác Tue_NV nhưng bác ấy xài file .fas nên mình bó tay luôn. Bạn chờ thêm chút để mình ngâm cứu thêm nha.

(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(setq ss (ssget (list (cons 0 "text")))
n (sslength ss)
i 0
tnlst (list)
cnlst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
txt (cdr (assoc 1 els))
)
(if (= (substr txt 1 1) (chr 216))
(if (> (strlen txt) 12)
(setq tnlst (append tnlst (list txt)))
(setq cnlst (append cnlst (list txt)))
)
)
(setq i (1+ i))
)
(setq cn (strcase (getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= cn "Y")
(progn
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "\\U+1ED0NG NH\\U+1EF0A uPVC ")
(crtbl pt)
(seplst cnlst pt)
)
)
(setq tn (strcase (getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= tn "Y")
(progn
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "C\\U+1ED0NG BTCT ")
(crtbl pt)
(seplst tnlst pt)
)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst p1 / lst1 lst2 lst3 tdd lo p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 cnt )
(setq cnt 0)
(while (/= lst nil)
(setq a (substr (nth 0 lst) 1 4)
lst1 (cdr lst)
lst2 nil
tdd 0
lst2 (append lst2 (list (nth 0 lst)))
)
(foreach b lst1
(if (= (substr b 1 4) a)
(setq lst2 (append lst2 (list b )))
(setq lst3 (append lst3 (list b )))
)
)
(foreach c lst2
(setq tdd (+ tdd (atof (substr c 9 3)))
lo (substr c 1 4)
)
)
(alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2 ) ))
(setq lst lst3
lst3 nil
cnt (1+ cnt)
)
(setq p2 (polar p1 (- (/ pi 2)) (* cnt 5))
p3 (polar p2 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p2 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 (rtos cnt 2 0)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 2) (+ (cadr p7) 1) ))
(cons 1 (strcat prtxt lo)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 4) (+ (cadr p7) 1) ))
(cons 1 (rtos tdd 2 0)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 5) (+ (cadr p7) 1) ))
(cons 1 "m") (cons 8 "ahs-tnt-text") ) )
(command "pline" p2 p7 p11 p6 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun crtbl ( p1 / p2 p3 p4 p5 p6 p7 p8 p9 p10 p11)
(setq p2 (list (+ (car p1) 12.5) (+ (cadr p1) 2))
p3 (polar p1 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p1 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 3) (cons 50 0) (cons 10 p2)
(cons 1 "%%UB\\U+1EA2NG T\\U+1ED4NG H\\U+1EE2P KH\\U+1ED0I L\\U+01AF\\U+1EE2NG")
(cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 "TT") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 14) (+ (cadr p7) 1) ))
(cons 1 "H\\U+1EA0NG M\\U+1EE4C") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 1) (+ (cadr p7) 1) ))
(cons 1 "KH\\U+1ED0I L\\U+01AF\\U+1EE2NG") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 2) (+ (cadr p7) 1) ))
(cons 1 "\\U+0110\\U+01A0N V\\U+1ECA") (cons 8 "ahs-tnt-text") ) )
(command "pline" p1 p6 p11 p7 p1 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")

)


Trong lúc chờ đợi, bạn dùng thử cái của bác Tue_NV xem sao, mình xài không nổi vì CAD 2004 của mình nó chả có cái hàm vla-addtable của bác Tue-NV, khổ thế....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2000 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 28 September 2010 - 06:22 PM

Chào các bác.

Em có một bài toán này mong muốn các bác giúp em. Em cũng đã search trên forum nhưng không thấy.
Đề bài như thế này: Cho hai đường thẳng cắt nhau, em muốn vẽ một cung tròn tiếp tuyến với hai đường thẳng này tại tiếp điểm cho trước. Cảm ơn các bác trước.
Hình đã gửi

Chào bạn manhlk,
Hề hề hề, cái đề bài bạn ra sai tóe loe rồi, hổng làm được đâu, đừng mất công nghĩ nữa....
Hãy xem lại hình học phẳng cơ bản từ hồi lớp 8 bạn nhé....
Hề hề hề....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.