Đến nội dung


Hình ảnh
- - - - -

Nhờ Chỉnh Lisp Cắt Thép Dầm Momen


  • Please log in to reply
78 replies to this topic

#1 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 09 May 2016 - 03:38 PM

em theo ý tưởng bản thân đã lập lisp như sau:

- có khuôn bao hình dầm, thép dầm

- gõ lệnh lisp qq

- Nhập tọa độ 2 điểm.... nhập chiều cao dầm

- vòng lặp: nhập 2 điểm.... nhập chiều cao dầm

- kết thúc enter

...

(defun c:qq(/  cd pt1 pt2 kc kc1 kc2 d1 d2 d3 d4 d5 d6 d7 d8 d9 

da)
  (setq luu (getvar "osmode"))
  (setq lay (getvar "clayer"))
(SETQ TXT (GETVAR "DIMTXT"))
(SETQ DC (GETVAR "DIMSCALE"))
(setq C (* TXT DC))
;;;nhap du lieu
  (setvar "osmode" 111)
;(COMMAND "OSNAP" "END,INT,INS,NOD,CEN,MID,QUA,PERP")
  (COMMAND "LAYER" "M" "THEPDOC" "C" "1" "" "LW" "0.4" "" "")
  (vl-cmdf "clayer" "THEPDOC")
  (INITGET 7)
(setvar "cmdecho" 1)
  (defun roundup (so)
    (* (atoi (rtos (/ so 50) 2 0)) 50))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (while (setq pt1 (getpoint "nhap toa do diem dau duoi 

dam:"))
    (setq pt2 (getpoint pt1 "nhap toa do diem cuoi duoi dam:"))
    (or	cd (setq cd 400))
(setq cd (cond ((getdist (strcat"\nchieu cao dam <" (rtos cd 2 

2) ">:"))) (cd)))
(setq kc (distance pt1 pt2))
(SETQ kc1 (- (roundup (/ (+ kc 220) 5)) 110))
(SETQ kc2 (- (roundup (/ (+ kc 220) 3)) 110))
(SETQ d1 (POLAR pt1 (/ pi 2) 50))
(SETQ d2 (POLAR d1 0 kc1))
(SETQ d3 (POLAR d2 (/ pi 6) 50))
(SETQ d4 (POLAR d1 0 (- kc kc1)))
(SETQ d5 (POLAR d4 (* 5 (/ pi 6)) 50))
(SETQ da (POLAR pt1 (/ pi 2) (- cd 50)))
(SETQ d6 (POLAR da 0 kc2))
(SETQ d7 (POLAR d6 (* 7 (/ pi 6)) 50))
(SETQ d8 (POLAR da 0 (- kc kc2)))
(SETQ d9 (POLAR d8 (- 0 (/ pi 6)) 50))
(SETQ pt (POLAR da (/ pi 2) (* 8 c)))
(SETQ pd (POLAR d1 (* 3 (/ pi 2)) (* 8 c)))
  (setvar "osmode" 0)
		(COMMAND "LINE" d2 d3 "")
		(COMMAND "LINE" d4 d5 "")
		(COMMAND "LINE" d6 d7 "")
		(COMMAND "LINE" d8 d9 "")
(COMMAND "dimlinear" da d6 pt)
(COMMAND "DIMCONTINUE" d8 pt2 "" "")
(COMMAND "dimlinear" d1 d2 pd)
(COMMAND "DIMCONTINUE" d4 pt2 "" "")
(setvar "osmode" 111)
)
;;;;het vong lap
(setvar "osmode" luu)
(setvar "clayer" lay)
		(princ)
)

- nhờ các bác chỉnh cho em chút làm sao để trong vòng lặp (hoặc ngay cả ban đầu) không hiển thị nhập chiều cao dầm mà chỉ cần pick 2 điểm. cao dầm mặc định là 400, khi gõ lệnh thì khi hiển thị dòng pick điếm 1,2 có gợi ý :(Caodam), nhấn C để thay đổi cao dầm, ko nhấn thì bỏ qua thì nhấn 2 điểm bình thường. Phần này hơi khó, mình chưa lập được :D


  • 1

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 09 May 2016 - 04:06 PM

Bạn tự nghiên cứu nhé:

(or (and kc (or (= (type kc) 'int) (= (type kc) 'real))) (setq kc 100))
(setq kc (cond ((getdist (strcat "\nDistance <" (rtos kc 2 2) ">: "))) (kc)))

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


#3 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 09 May 2016 - 04:13 PM

 

Bạn tự nghiên cứu nhé:

(or (and kc (or (= (type kc) 'int) (= (type kc) 'real))) (setq kc 100))
(setq kc (cond ((getdist (strcat "\nDistance <" (rtos kc 2 2) ">: "))) (kc)))

Biến kc là kc 2 điểm mà anh. chiều cao dầm là CD, em k bik đoạn code trên cho vào đoạn nào! Anh chỉ với. Vì em không muốn hiển thị gợi ý "\nDistance <" nhớ lần nhập trc luôn. mà chỉ cần nhập 2 điểm. Khi muốn thay đổi chiều cao dầm mới nhập (Caodam) chữ C rồi nhập cao dầm. giống như lệnh PL gõ L chuyển vẽ thẳng, a chuyển vẽ cong ấy. chứ dòng lệnh trên của anh cũng giống dòng dưới của em.:(

(or	cd (setq cd 400))
(setq cd (cond ((getdist ("\nchieu cao dam <" (rtos cd 2 

2) ">:"))) (cd)))


  • 1

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 09 May 2016 - 04:44 PM

Tiếp tục nghiên cứu hàm này he:

(defun c:cbs(/ p)
  (initget 1 "c") (setq p (getpoint "Pick point or Press C to say good morning :"))
  (if (= p "c") (alert "Chao buoi sang - Good morning") (alert (vl-princ-to-string p))))

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 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 09 May 2016 - 04:50 PM

 

Tiếp tục nghiên cứu hàm này he:

(defun c:cbs(/ p)
  (initget 1 "c") (setq p (getpoint "Pick point or Press C to say good morning :"))
  (if (= p "c") (alert "Chao buoi sang - Good morning") (alert (vl-princ-to-string p))))

để em thử ng/c. k dc em lại nhờ bác.

Như vậy phải có 2 vòng lặp while đúng k bác.

while (whille ( nhập pt1: (hoặc cao dầm). nếu nhập cao dầm thì lặp, nếu nhập pick point thì thoát lặp)

nhập pt2]. Em hiểu như thế, nhưng không biết thể hiện ntn. thử cứ bị lỗi. Bác giúp em chót :)


  • 1

#6 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 09 May 2016 - 07:03 PM

để em thử ng/c. k dc em lại nhờ bác.

Như vậy phải có 2 vòng lặp while đúng k bác.

while (whille ( nhập pt1: (hoặc cao dầm). nếu nhập cao dầm thì lặp, nếu nhập pick point thì thoát lặp)

nhập pt2]. Em hiểu như thế, nhưng không biết thể hiện ntn. thử cứ bị lỗi. Bác giúp em chót :)

 (while 
  (while 
(initget 1 "c") (setq p (getpoint "nhap toa do diem dau duoi dam: hoac (/Caodam) :"))
  (if (= p "c") (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 2) ">: "))) (cd))) 
(setq pt1 p)))
;het vong lap 1
    (setq pt2 (getpoint pt1 "nhap toa do diem cuoi duoi dam:"))
;.............................................
;
;dong lenh khac
)
;het vong lap 2

em để như thế này nó ko chạy, k hiểu cú phap sai diem nao ma k chay


Bài viết đã được chỉnh sửa nội dung bởi phongtran86: 11 May 2016 - 08:50 AM

  • 1

#7 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 10 May 2016 - 08:21 AM

up lên cho anh Hà với các bác giúp


  • -1

#8 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 10 May 2016 - 10:46 AM

em theo ý tưởng bản thân đã lập lisp như sau:

- có khuôn bao hình dầm, thép dầm

- gõ lệnh lisp qq

- Nhập tọa độ 2 điểm.... nhập chiều cao dầm

- vòng lặp: nhập 2 điểm.... nhập chiều cao dầm

- kết thúc enter

13179067_1061434650546326_76187915834725

(defun c:qq(/  cd pt1 pt2 kc kc1 kc2 d1 d2 d3 d4 d5 d6 d7 d8 d9 

da)
  (setq luu (getvar "osmode"))
  (setq lay (getvar "clayer"))
(SETQ TXT (GETVAR "DIMTXT"))
(SETQ DC (GETVAR "DIMSCALE"))
(setq C (* TXT DC))
;;;nhap du lieu
  (setvar "osmode" 111)
;(COMMAND "OSNAP" "END,INT,INS,NOD,CEN,MID,QUA,PERP")
  (COMMAND "LAYER" "M" "THEPDOC" "C" "1" "" "LW" "0.4" "" "")
  (vl-cmdf "clayer" "THEPDOC")
  (INITGET 7)
(setvar "cmdecho" 1)
  (defun roundup (so)
    (* (atoi (rtos (/ so 50) 2 0)) 50))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (while (setq pt1 (getpoint "nhap toa do diem dau duoi 

dam:"))
    (setq pt2 (getpoint pt1 "nhap toa do diem cuoi duoi dam:"))
    (or	cd (setq cd 400))
(setq cd (cond ((getdist (strcat"\nchieu cao dam <" (rtos cd 2 

2) ">:"))) (cd)))
(setq kc (distance pt1 pt2))
(SETQ kc1 (- (roundup (/ (+ kc 220) 5)) 110))
(SETQ kc2 (- (roundup (/ (+ kc 220) 3)) 110))
(SETQ d1 (POLAR pt1 (/ pi 2) 50))
(SETQ d2 (POLAR d1 0 kc1))
(SETQ d3 (POLAR d2 (/ pi 6) 50))
(SETQ d4 (POLAR d1 0 (- kc kc1)))
(SETQ d5 (POLAR d4 (* 5 (/ pi 6)) 50))
(SETQ da (POLAR pt1 (/ pi 2) (- cd 50)))
(SETQ d6 (POLAR da 0 kc2))
(SETQ d7 (POLAR d6 (* 7 (/ pi 6)) 50))
(SETQ d8 (POLAR da 0 (- kc kc2)))
(SETQ d9 (POLAR d8 (- 0 (/ pi 6)) 50))
(SETQ pt (POLAR da (/ pi 2) (* 8 c)))
(SETQ pd (POLAR d1 (* 3 (/ pi 2)) (* 8 c)))
  (setvar "osmode" 0)
		(COMMAND "LINE" d2 d3 "")
		(COMMAND "LINE" d4 d5 "")
		(COMMAND "LINE" d6 d7 "")
		(COMMAND "LINE" d8 d9 "")
(COMMAND "dimlinear" da d6 pt)
(COMMAND "DIMCONTINUE" d8 pt2 "" "")
(COMMAND "dimlinear" d1 d2 pd)
(COMMAND "DIMCONTINUE" d4 pt2 "" "")
(setvar "osmode" 111)
)
;;;;het vong lap
(setvar "osmode" luu)
(setvar "clayer" lay)
		(princ)
)

- nhờ các bác chỉnh cho em chút làm sao để trong vòng lặp (hoặc ngay cả ban đầu) không hiển thị nhập chiều cao dầm mà chỉ cần pick 2 điểm. cao dầm mặc định là 400, khi gõ lệnh thì khi hiển thị dòng pick điếm 1,2 có gợi ý :(Caodam), nhấn C để thay đổi cao dầm, ko nhấn thì bỏ qua thì nhấn 2 điểm bình thường. Phần này hơi khó, mình chưa lập được :D

Hề hề hề,

Bạn cần coi lại cú pháp của các hàm. Tỷ như hàm 

(getdist ("\nchieu cao dam <" (rtos cd 2 2) ">:")) là sai nặng đó. làm sao lisp chạy được.

Phải hiểu rõ cú pháp từng hàm rồi mới ứng dụng được.

Yêu cầu của bạn không phải quá khó. chỉ cần thêm một biến phụ yes or no trước khi nhập biến chiều cao dầm là được. 


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

#9 ndtnv

ndtnv

    biết lệnh minsert

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

Đã gửi 10 May 2016 - 11:19 AM

Lisp này chỉ chạy cho dầm nằm ngang, vì vậy sao không chọn điểm 2 là điểm trên cuối dầm để tính chiều cao ?

Cách khác là chọn 2 line : có thể chạy cho dầm nằm nghiêng. Cách này có thể xử lý hàng loạt dầm nếu bản vẽ được tiêu chuẩn hóa


  • 1

#10 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 10 May 2016 - 11:41 AM

Hề hề hề,

Bạn cần coi lại cú pháp của các hàm. Tỷ như hàm 

(getdist ("\nchieu cao dam <" (rtos cd 2 2) ">:")) là sai nặng đó. làm sao lisp chạy được.

Phải hiểu rõ cú pháp từng hàm rồi mới ứng dụng được.

Yêu cầu của bạn không phải quá khó. chỉ cần thêm một biến phụ yes or no trước khi nhập biến chiều cao dầm là được. 

em ko bik sai chỗ nào. vì lisp vẫn chạy dc mà. anh chỉ giúp

 

Lisp này chỉ chạy cho dầm nằm ngang, vì vậy sao không chọn điểm 2 là điểm trên cuối dầm để tính chiều cao ?

Cách khác là chọn 2 line : có thể chạy cho dầm nằm nghiêng. Cách này có thể xử lý hàng loạt dầm nếu bản vẽ được tiêu chuẩn hóa

 

em chỉ bập bẹ chút nên chỉ lập theo trường hợp điển hình, k tổng quát hóa dc. Bác nhiệt tình giúp em với


  • 1

#11 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 11 May 2016 - 08:20 AM

Lisp này chỉ chạy cho dầm nằm ngang, vì vậy sao không chọn điểm 2 là điểm trên cuối dầm để tính chiều cao ?

 

Theo gợi ý của bác ndtv thì có thể k cần nhập chiều cao. :) Việc nhập k cần thiết nữa. nhưng trong 1 cơ số trường hợp, các lisp khác việc nhập như thế này là cần nên em nhờ anh demo điển hình cho em 1 lần này để làm mẫu. khi thực hiện lệnh luôn hiện [ Caodam <giá biến hiện tại>], hoặc điển hình hơn [ Bien1 <giá biến 1 hiện tại>/ Bien2 <giá biến 2 hiện tại> ........], khong nhấn lựa chọn thay đổi giá trị biến thì lệnh vẫn thực hiện bình thường với giá trị biến này. Còn khi thực hiện lệnh thay đổi biến xong thì lại chuyển thực hiện tiếp tục lệnh với gia trị biến mới.


  • 0

#12 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 670 Bài viết
Điểm đánh giá: 313 (khá)

Đã gửi 11 May 2016 - 08:38 AM

Bạn thử cái này xem:

(or cd (setq cd 400))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao")
  (setq pt1 (getpoint (strcat "\nNhap toa do diem dau duoi dam/Caodam [" (rtos cd 2 0) "]:")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nchieu cao dam <" (rtos cd 2 2) ">:")))
                        (cd))))
        ((= pt1 nil) (setq temp nil))
        (t (tiep_theo...))))


  • 1

#13 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 11 May 2016 - 10:32 AM

Bạn thử cái này xem:

(or cd (setq cd 400))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao")
  (setq pt1 (getpoint (strcat "\nNhap toa do diem dau duoi dam/Caodam [" (rtos cd 2 0) "]:")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nchieu cao dam <" (rtos cd 2 2) ">:")))
                        (cd))))
        ((= pt1 nil) (setq temp nil))
        (t (tiep_theo...))))

em chưa test :D. Tiện bác cho em trường hợp nhiều biến xem với


  • 0

#14 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 11 May 2016 - 10:55 AM

em chưa test :D. Tiện bác cho em trường hợp nhiều biến xem với

Hề hề hề,

Theo mình bạn có thể làm đơn giản là.

1/- Đặt các biến: (setq b1 a1 b2 a2 .......)

 

2/- Trong vòng lặp

 Đặt bến phụ: (setq an (gesting "Ban muon thay doi gia tri cac bien da có? < Y or N>"))

đưa vào hàm điều kiện

(if (= (strcase an) "Y")

   Lặp lại việc đặt biến (setq .....)

)


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

#15 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 670 Bài viết
Điểm đánh giá: 313 (khá)

Đã gửi 11 May 2016 - 12:37 PM

em chưa test :D. Tiện bác cho em trường hợp nhiều biến xem với

òa... Viết được thì cũng đọc được chứ hả... Thêm nhiều thì cứ copy, paste và edit lại 1 tý thôi mà.

Bạn test nhé:

(defun c:test  (/ bv cd pt1 temp)
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 400))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv 20))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao")
  (setq pt1 (getpoint
             (strcat "\nCaodam <" (rtos cd 2 0) ">/Baove <" (rtos bv 2 0) ">. Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd))))
        ((= pt1 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop bao ve betong <" (rtos bv 2 0) ">:")))
                        (bv))))
        ((= pt1 nil) (setq temp nil))
        (t (alert "Thuc hien cac buoc tiep theo o day..."))))
 (princ))

  • 1

#16 790312

790312

    biết lệnh fillet

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

Đã gửi 11 May 2016 - 03:08 PM

 

òa... Viết được thì cũng đọc được chứ hả... Thêm nhiều thì cứ copy, paste và edit lại 1 tý thôi mà.

Bạn test nhé:

(defun c:test  (/ bv cd pt1 temp)
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 400))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv 20))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao")
  (setq pt1 (getpoint
             (strcat "\nCaodam <" (rtos cd 2 0) ">/Baove <" (rtos bv 2 0) ">. Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd))))
        ((= pt1 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop bao ve betong <" (rtos bv 2 0) ">:")))
                        (bv))))
        ((= pt1 nil) (setq temp nil))
        (t (alert "Thuc hien cac buoc tiep theo o day..."))))
 (princ))

Bác viết giùm chủ thớt đoạn code hoàn chỉnh theo như yêu cầu ở bài 1 luôn với, thấy đây là ý tưởng hay dành cho dân xây dựng, chủ thới mới tập thì sợ viết dài dòng, dễ mắc lỗi. Mong các cao thủ ghi nhận ý. Chân thành cảm ơn.


  • 0

#17 traitimgio

traitimgio

    biết zoom

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

Đã gửi 11 May 2016 - 03:31 PM

Bác viết giùm chủ thớt đoạn code hoàn chỉnh theo như yêu cầu ở bài 1 luôn với, thấy đây là ý tưởng hay dành cho dân xây dựng, chủ thới mới tập thì sợ viết dài dòng, dễ mắc lỗi. Mong các cao thủ ghi nhận ý. Chân thành cảm ơn.

quan trọng nhất lisp này là cái  toán cắt thép như thế nào. 1/3, 1/4,  1/5 j đấy, người trong dân kcau mới bik. COn thuật toán là vấn đề lập trình thôi, sẽ có bác giúp.


  • 1

#18 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 11 May 2016 - 04:00 PM

 

òa... Viết được thì cũng đọc được chứ hả... Thêm nhiều thì cứ copy, paste và edit lại 1 tý thôi mà.

 

Mình đọc được topic 1 số lisp bác sửa mà link die mất rồi. bác up lại dc k

http://www.cadviet.c...n-khai-k-t-c-u/


  • 0

#19 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 670 Bài viết
Điểm đánh giá: 313 (khá)

Đã gửi 11 May 2016 - 08:10 PM

Bác viết giùm chủ thớt đoạn code hoàn chỉnh theo như yêu cầu ở bài 1 luôn với, thấy đây là ý tưởng hay dành cho dân xây dựng, chủ thới mới tập thì sợ viết dài dòng, dễ mắc lỗi. Mong các cao thủ ghi nhận ý. Chân thành cảm ơn.

Theo bài 1:

(defun c:tt  (/ modelSpace lay bv cd pt1 temp create-layer tiep_theo_qm kcach_dau Make-Line laythep)
 (defun kcach_dau  (mm-am len fac / del l-0)
  (if (eq mm-am t)
   (progn (setq l-0 (/ len 4)
                del (rem l-0 50))
          (if (> del 0)
           (setq l-0 (- l-0 del (/ -50 fac)))))
   (progn (setq l-0 (/ len 6)
                del (rem l-0 (/ 50 fac)))
          (if (> del 0)
           (setq l-0 (- l-0 del)))))
  l-0)
 (defun create-layer  (name color lineWeight)
  (entmakex (list '(0 . "LAYER")
                  (cons 100 "AcDbSymbolTableRecord")
                  (cons 100 "AcDbLayerTableRecord")
                  (cons 2 name)
                  (cons 70 0)
                  (cons 62 color)
                  (cons 6 "Continuous")
                  (cons 370 (fix (* 100 lineWeight))))))
 (defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 ;;-------------------
 (defun tiep_theo_qm  (/ cdim pt2 kc pd1 pd2 pd3 pa1 pa2 pa3 ptt)
  (setq cdim (* (getvar "DIMTXT") (getvar "DIMSCALE")))
  (setq pt2 (getpoint "\nNhap toa do diem cuoi duoi dam:" pt1))
  (setq kc (distance pt1 pt2))
  ;; Momen duong
  (setq pd1 (polar pt1 (* pi 0) (kcach_dau nil kc 1))
        pd2 (polar pt2 (* pi 1) (kcach_dau nil kc 1))
        pd3 (polar pt1 (* pi 1.5) (* cdim 4)))
  (setvar "CLAYER" "DIM")
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pd1 pd2))
          (mapcar 'vlax-3d-point (list pd1 pd2 pt2))
          (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))
  (Make-Line (setq ptt (polar pd1 (* pi 0.5) bv)) (polar ptt (* pi 0.25) bv) laythep)
  (Make-Line (setq ptt (polar pd2 (* pi 0.5) bv)) (polar ptt (* pi 0.75) bv) laythep)
  ;; Momen am
  (setq pt1 (polar pt1 (* pi 0.5) cd)
        pt2 (polar pt2 (* pi 0.5) cd)
        pa1 (polar pt1 (* pi 0) (kcach_dau t kc 1))
        pa2 (polar pt2 (* pi 1) (kcach_dau t kc 1))
        pa3 (polar pt1 (* pi 0.5) (* cdim 4)))
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pa1 pa2))
          (mapcar 'vlax-3d-point (list pa1 pa2 pt2))
          (mapcar 'vlax-3d-point (list pa3 pa3 pa3)))
  (Make-Line (setq ptt (polar pa1 (* pi 1.5) bv)) (polar ptt (* pi 1.25) bv) laythep)
  (Make-Line (setq ptt (polar pa2 (* pi 1.5) bv)) (polar ptt (* pi 1.75) bv) laythep)
  (setvar "CLAYER" lay))
 ;; MAIN
 (vl-load-com)
 (setq msp     (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       lay     (getvar "clayer")
       laythep "THEPDOC")
 (create-layer laythep 1 0.4)
 (create-layer "DIM" 8 -3)
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 400))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv 20))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao")
  (setq pt1 (getpoint
             (strcat "\nCaodam <" (rtos cd 2 0) ">/Baove <" (rtos bv 2 0) ">. Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd))))
        ((= pt1 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop betong bao ve <" (rtos bv 2 0) ">:")))
                        (bv))))
        ((= pt1 nil) (setq temp nil))
        (t (tiep_theo_qm))))
 (princ))

 

Mình đọc được topic 1 số lisp bác sửa mà link die mất rồi. bác up lại dc k

http://www.cadviet.c...n-khai-k-t-c-u/

 

Cái đó là có dim trước, rồi chia dim khác với topic này.


  • 2

#20 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 11 May 2016 - 11:10 PM

Theo bài 1:

(defun c:tt  (/ modelSpace lay bv cd pt1 temp create-layer tiep_theo_qm kcach_dau Make-Line laythep)
 (defun kcach_dau  (mm-am len fac / del l-0)
  (if (eq mm-am t)
   (progn (setq l-0 (/ len 4)
                del (rem l-0 50))
          (if (> del 0)
           (setq l-0 (- l-0 del (/ -50 fac)))))
   (progn (setq l-0 (/ len 6)
                del (rem l-0 (/ 50 fac)))
          (if (> del 0)
           (setq l-0 (- l-0 del)))))
  l-0)
 (defun create-layer  (name color lineWeight)
  (entmakex (list '(0 . "LAYER")
                  (cons 100 "AcDbSymbolTableRecord")
                  (cons 100 "AcDbLayerTableRecord")
                  (cons 2 name)
                  (cons 70 0)
                  (cons 62 color)
                  (cons 6 "Continuous")
                  (cons 370 (fix (* 100 lineWeight))))))
 (defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 ;;-------------------
 (defun tiep_theo_qm  (/ cdim pt2 kc pd1 pd2 pd3 pa1 pa2 pa3 ptt)
  (setq cdim (* (getvar "DIMTXT") (getvar "DIMSCALE")))
  (setq pt2 (getpoint "\nNhap toa do diem cuoi duoi dam:" pt1))
  (setq kc (distance pt1 pt2))
  ;; Momen duong
  (setq pd1 (polar pt1 (* pi 0) (kcach_dau nil kc 1))
        pd2 (polar pt2 (* pi 1) (kcach_dau nil kc 1))
        pd3 (polar pt1 (* pi 1.5) (* cdim 4)))
  (setvar "CLAYER" "DIM")
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pd1 pd2))
          (mapcar 'vlax-3d-point (list pd1 pd2 pt2))
          (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))
  (Make-Line (setq ptt (polar pd1 (* pi 0.5) bv)) (polar ptt (* pi 0.25) bv) laythep)
  (Make-Line (setq ptt (polar pd2 (* pi 0.5) bv)) (polar ptt (* pi 0.75) bv) laythep)
  ;; Momen am
  (setq pt1 (polar pt1 (* pi 0.5) cd)
        pt2 (polar pt2 (* pi 0.5) cd)
        pa1 (polar pt1 (* pi 0) (kcach_dau t kc 1))
        pa2 (polar pt2 (* pi 1) (kcach_dau t kc 1))
        pa3 (polar pt1 (* pi 0.5) (* cdim 4)))
  (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
          (mapcar 'vlax-3d-point (list pt1 pa1 pa2))
          (mapcar 'vlax-3d-point (list pa1 pa2 pt2))
          (mapcar 'vlax-3d-point (list pa3 pa3 pa3)))
  (Make-Line (setq ptt (polar pa1 (* pi 1.5) bv)) (polar ptt (* pi 1.25) bv) laythep)
  (Make-Line (setq ptt (polar pa2 (* pi 1.5) bv)) (polar ptt (* pi 1.75) bv) laythep)
  (setvar "CLAYER" lay))
 ;; MAIN
 (vl-load-com)
 (setq msp     (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       lay     (getvar "clayer")
       laythep "THEPDOC")
 (create-layer laythep 1 0.4)
 (create-layer "DIM" 8 -3)
 (or (and cd (or (= (type cd) 'int) (= (type cd) 'real))) (setq cd 400))
 (or (and bv (or (= (type bv) 'int) (= (type bv) 'real))) (setq bv 20))
 (setq temp "T")
 (while (= temp "T")
  (initget 0 "Cao Bao")
  (setq pt1 (getpoint
             (strcat "\nCaodam <" (rtos cd 2 0) ">/Baove <" (rtos bv 2 0) ">. Nhap toa do diem dau duoi dam: ")))
  (cond ((= pt1 "Cao")
         (setq cd (cond ((getdist (strcat "\nChieu cao dam <" (rtos cd 2 0) ">:")))
                        (cd))))
        ((= pt1 "Bao")
         (setq bv (cond ((getdist (strcat "\nChieu day lop betong bao ve <" (rtos bv 2 0) ">:")))
                        (bv))))
        ((= pt1 nil) (setq temp nil))
        (t (tiep_theo_qm))))
 (princ))
 

 
Cái đó là có dim trước, rồi chia dim khác với topic này.
like. Mai em test lisp bác.:). Code bác viết rành mạch, đẹp thế. Nhiều hàm em chưa bik bao giờ :P
  • 0