Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
D3-2015

thảo luận về Lisp thay block

Bởi D3-2015 , trong AutoLisp

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

D3-2015    0

D3-2015
Đã đăng

xin chao các anh, em mới bắt đầu nhập môn về autolisp, có cái lisp này nhờ các cao thủ chỉ giáo giúp.

ý tưởng như sau:

1: Đối tượng mẫu A là dạng block có sẵn.

2: Lấy đối tượng mẫu( A) điền vào khu vực mong muốn (khung màu hồng) với số hàng và số cột do người dùng nhấp.

 

(defun C:VD (/ P1 P3 HA CO P2 P4 D R KH KC D1 R1 P0)
        (setq P1 (getpoint "\n DIEM DAU TIEN CUA CAN PHONG")
          P3 (getcorner P1 "\n DIEM THU HAI CUA CAN PHONG")
          HA (getint "\n NHAP SO HANG DEN CUA CAN PHONG")
          CO (getint "\n NHAP SO COT DEN CUA CAN PHONG")
       
          P2 (list (car P1) (cadr P3))
          P4 (list (car P3) (cadr P1))
              D (distance P1 P4)
          R (distance P1 P2)
          KH (/ R HA)
          KC (/ D CO)
          D1 (/ D (* 2 CO))
          R1 (/ R (* 2 HA)) 
          P0 (list (+ (car P1) D1) (+ (cadr P1) R1))
          SEL (entget (car (entsel "\n CHON DEN DE LAP :")))
          SEL_1 (entmod (subst (CONS 10 '(25 25 0)) (assoc 10 SEL) SEL)))
        (command 
            ".select" SEL_1 ""
            ".insert" P0 SEL_1
           ".array" SEL_1 "" "R" HA CO KH KC)
  )

 

 

 

TRƯỚC.PNG

SAU.PNG

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

D3-2015    0

D3-2015
Đã đăng

+ Thay đoạn code bằng dòng này: thì lisp mới chạy được.

 ".array" "L" "" "R" HA CO KH KC

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

H bác Mèo Mun:

không được bác ơi, khi thay vào  dòng code của bác nó toàn array block tạo ra cuối cùng trên bản vẽ. em thử lấy 1 block bất kỳ tao ở trước đó thì nó không chạy như ý muốn.

 

Thứ 2. như trên dòng lisp này: em muốn chèn vào vị trí P0 là điểm đầu tiên, từ đó mới array theo dòng và cột. nhưng chưa có cách nào chèn blcok và vị trí đó. đang tạm lấy vị trí chèn ban đầu là  '(25) 25 0) như dòng code thứ 2. bác có cách nào khong.

          P0 (list (+ (car P1) D1) (+ (cadr P1) R1))
          SEL (entget (car (entsel "\n CHON DEN DE LAP :")))
          SEL_1 (entmod (subst (CONS 10 '(25) 25 0) (assoc 10 SEL) SEL)))

 

(xin cảm ơn bác nhiều:  mới học nên đang gà mờ 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

duy782006    1.551

duy782006
Đã đăng

-Giữ cơ bản của bạn mình chỉ chỉnh dòng đọc tên block được chọn sau đó array.

-Có hướng khác là đọc điểm chèn của block rồi copy nó tới điểm P0 xong array thì hiệu quả như nhau. bạn mò thêm.

-Cái nửa là hình như khi thứ tự và vị trí hai điểm chọn của bạn không đúng kiểu sẽ tính ra điểm P0 là ngoài căn phòng của bạn. Gợi ý trước hết so sánh xy của hai điểm P1 và P3 từ đó gán lại thứ tự hai điểm này để P0 luôn đúng. 

(defun C:VD (/ P1 P3 HA CO P2 P4 D R KH KC D1 R1 P0)
        (setq P1 (getpoint "\n DIEM DAU TIEN CUA CAN PHONG")
          P3 (getcorner P1 "\n DIEM THU HAI CUA CAN PHONG")
          HA (getint "\n NHAP SO HANG DEN CUA CAN PHONG")
          CO (getint "\n NHAP SO COT DEN CUA CAN PHONG")
       
          P2 (list (car P1) (cadr P3))
          P4 (list (car P3) (cadr P1))
              D (distance P1 P4)
          R (distance P1 P2)
          KH (/ R HA)
          KC (/ D CO)
          D1 (/ D (* 2 CO))
          R1 (/ R (* 2 HA)) 
          P0 (list (+ (car P1) D1) (+ (cadr P1) R1)))
         (setq SEL (cdr (assoc 2 (entget (car (entsel "\nCHON DEN DE LAP"))))))
(command ".insert" SEL "_non" P0 "" "" "")
(command ".array" "last" "" "r" HA CO KH KC)
 )

(defun C:VD1 (/ P1 P3 HA CO P2 P4 D R KH KC D1 R1 P0)
        (setq P1 (getpoint "\n DIEM DAU TIEN CUA CAN PHONG")
          P3 (getcorner P1 "\n DIEM THU HAI CUA CAN PHONG")
          HA (getint "\n NHAP SO HANG DEN CUA CAN PHONG")
          CO (getint "\n NHAP SO COT DEN CUA CAN PHONG")
       
          P2 (list (car P1) (cadr P3))
          P4 (list (car P3) (cadr P1))
              D (distance P1 P4)
          R (distance P1 P2)
          KH (/ R HA)
          KC (/ D CO)
          D1 (/ D (* 2 CO))
          R1 (/ R (* 2 HA)) 
          P0 (list (+ (car P1) D1) (+ (cadr P1) R1)))
         (setq SEL (car (entsel "\nCHON DEN DE LAP")))
         (setq SELN (cdr (assoc 10 (entget SEL))))
(command ".copy" SEL "" "_non" SELN P0)
(command ".array" "last" "" "r" HA CO KH KC)
 )

 

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

D3-2015    0

D3-2015
Đã đăng

Thanks you bác PHẠM QUỐC DUY nhiều nhiều.

Đúng ý em đang cần tìm, mấu chốt có 2 dòng code cuối mà ngồi mò mẫm mãi không ra, cũng vỡ ra được nhiều thứ.  Bác có ở HCM không, hnao rủ bác đi cafe hôm để cảm ơ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

D3-2015    0

D3-2015
Đã đăng
9 giờ trước, Mèo Mun đã nói:

-Giữ cơ bản của bạn mình chỉ chỉnh dòng đọc tên block được chọn sau đó array.

-Có hướng khác là đọc điểm chèn của block rồi copy nó tới điểm P0 xong array thì hiệu quả như nhau. bạn mò thêm.

-Cái nửa là hình như khi thứ tự và vị trí hai điểm chọn của bạn không đúng kiểu sẽ tính ra điểm P0 là ngoài căn phòng của bạn. Gợi ý trước hết so sánh xy của hai điểm P1 và P3 từ đó gán lại thứ tự hai điểm này để P0 luôn đúng

???   Nhờ gợi ý của bác em sửa như này đã ổn chưa.

Hiện tại lại phát sinh thêm 1 vấn đề khi chèn block thông thường thì không sao nhưng khi chèn block attribute thì nó không thực hiện được, mong bác chỉ giáo tiếp.

 

 ........lisp ve den cho can ho..............           
(prompt "\n THIET LAP THONG SO BAN DAU")
 (defun C:VD (/ P1-Point P3-Point Max-Point Min-Point HA CO P2-Point P4-Point L-Dist W-Dist HA-Dist CO-Dist Insert-Point)
    (setq P1-Point (getpoint "\n DIEM DAU TIEN CUA CAN PHONG")
          P3-Point (getcorner P1-Point "\n DIEM THU HAI CUA CAN PHONG")
          HA (getint "\n NHAP SO HANG DEN: ")
          CO (getint "\n NHAP SO COT DEN: "))
(prompt "\n NOI SUY THONG SO")
    (setq Max-Point (list (Max (car P1-Point) (car P3-Point)) (Max (cadr P1-Point) (cadr P3-Point)))
      Min-Point (list (Min (car P1-Point) (car P3-Point)) (Min (cadr P1-Point) (cadr P3-Point)))
          P2-Point (list (car P1-Point) (cadr P3-Point))
          P4-Point (list (car P3-Point) (cadr P1-Point))
          L-Room (distance P1-Point P4-Point)
          W-Room (distance P1-Point P2-Point)
          HA-Dist (/ W-Room HA)
      CO-Dist (/ L-Room CO)
          L-Dist-1 (/ L-Room (* 2 CO))
          W-Dist-1 (/ W-Room (* 2 HA)) 
          Insert-Point (list (+ (car Min-Point) L-Dist-1) (+ (cadr Min-Point) W-Dist-1)))  
(prompt "\n CHON BLOCK DEN CAN VE")
     (setq Sel-oject (cdr (assoc 2 (entget (car (entsel "\nCHON DEN DE LAP"))))))
(command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                    ".Insert" Sel-oject "_Non" Insert-Point "" "" ""
                    ".Array" "Last" "" "R" HA CO HA-Dist CO-Dist))
 

 

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    3.201

Doan Van Ha
Đã đăng
29 phút trước, D3-2015 đã nói:

Cảm ơn bác, em làm được rồi, bác thật là cao thủ.

 

Không cao thủ đâu. Tôi cũng đã bị lỗi này, chỉ khác bạn là tôi tìm cách học còn bạn tìm cách hỏi, gọi chung là học hỏ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

duy782006    1.551

duy782006
Đã đăng

-Bác hà: Do bạn ấy hỏi không rỏ nên giải quyết kiểu copy cho gọn.

-Vì thấy bác chỉ phần tắt câu hỏi khi chèn block chứa att mà bạn ấy không ý kiến gì nên Duy nghi là block của bạn ấy là Block "nhúc nhích" nên khi dùng DXF 2 để đọc tên block hiện có sẽ là tên khác tên block gốc nên ko chèn ra được. 

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

D3-2015    0

D3-2015
Đã đăng

Hi Bác Duy, Nhờ bác check giúp em Insert-Point Hàm if ở cuối lisp:     ( P/S em gỡ rối 1 buổi tối mà chưa tìm ra lỗi)

+ Trường hợp 1, 2, 3 lisp chạy ok theo số HÀNG và số CỘT người dùng nhập vào.

+ Tuy nhiên cho trường hợp 4 khi điểm B trùng với điểm C (HANG=1 CỘT=5),  Trường hợp 5 điểm A trùng với điểm B (HÀNG=4 CỘT=1), lisp chạy không đúng yêu cầu,  (Yều cầu là phải rải đều trên đoạn thẳng DC trường hợp 4:   BC trường hợp 5).   Thanks Bác.

 

**********************************************************************************

(defun C:VD (/ P1-Point P3-Point Max-Point Min-Point HA CO P2-Point P4-Point L-Dist W-Dist HA-Dist CO-Dist Insert-Point)
    (setq P1-Point (getpoint "\n DIEM DAU TIEN CUA CAN PHONG")
          P3-Point (getcorner P1-Point "\n DIEM THU HAI CUA CAN PHONG")
      HA (getint "\n NHAP SO HANG DEN CUA CAN PHONG")
          CO (getint "\n NHAP SO COT DEN CUA CAN PHONG"))
(prompt "\n NOI SUY THONG SO")
    (setq Max-Point (list (Max (car P1-Point) (car P3-Point)) (Max (cadr P1-Point) (cadr P3-Point)))
      Min-Point (list (Min (car P1-Point) (car P3-Point)) (Min (cadr P1-Point) (cadr P3-Point)))
          P2-Point (list (car P1-Point) (cadr P3-Point))
          P4-Point (list (car P3-Point) (cadr P1-Point))
          L-Room (abs(- (car P3-Point) (car P1-Point)))
          W-Room (abs(- (cadr P3-Point) (cadr P1-Point)))
          HA-Dist (/ W-Room HA)
      CO-Dist (/ L-Room CO)
          L-Dist-1 (/ L-Room (* 2 CO))
          W-Dist-1 (/ W-Room (* 2 HA)) )
   (setq Sel-oject (car (entsel "\nCHON DEN DE LAP")))
   (setq Sel-oject-1 (cdr (assoc 10 (entget Sel-oject))))
  (if
    ((and (> L-Room 0) (> W-Room 0))
      (cond
     ((and (> HA 1) (> CO 1))
      (progn
       (setq Insert-Point (list (+ (car Min-Point) L-Dist-1) (+ (cadr Min-Point) W-Dist-1)))
         (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 Insert-Point
                      ".Array" "Last" "" "R" HA CO HA-Dist CO-Dist
              )))
     ((and (= HA 1) (> CO 1))
      (progn
        (setq Insert-Point (list (+ (car Min-Point) L-Dist-1) (+ (cadr Min-Point) W-Dist-1)))
         (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 Insert-Point
                      ".Array" "Last" "" "R" 1 CO CO-Dist
              )))
     ((and (> HA 1) (= CO 1))
      (progn
        (setq Insert-Point (list (+ (car Min-Point) L-Dist-1) (+ (cadr Min-Point) W-Dist-1)))
         (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 Insert-Point
                      ".Array" "Last" "" "R" HA 1 HA-Dist)))))
    (if
      ((and (> L-Room 0) (= W-Room 0))
    (progn
      (setq Insert-Point (list (+ L-Dist-1 (car Min-Point)) (cadr Min-Point)))
         (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 Insert-Point
                      ".Array" "Last" "" "R" 1 CO CO-Dist)))
      ((and (= L-Room 0) (> W-Room 0))
    (progn
      (setq Insert-Point (list (car Min-Point) (+ (cadr Min-Point) W-Dist-1)))
         (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 Insert-Point 
                      ".Array" "Last" "" "R" HA 1 HA-Dist)))
      )
    )
  )1408310869_LOITH4-5.thumb.PNG.9129ca77c6d1a913687e399a8ca08ec3.PNG
    

VD-1907.lsp

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

ndtnv    481

ndtnv
Đã đăng

Thêm

(setvar "OSMODE" 0)

vào trước

(if
    ((and (> L-Room 0) (> W-Room 0))

 

rồi khôi phục "OSMODE" vào cuối chương trình

Chương trình viết quá dài dòng

Dồn if  and thành 1 cho gọn

Chỉ cần tách riêng  (command "   ".Array" ..)

hàm abs không cần vì max >= min

(/ L-Room (* 2 CO)) => (/ L-Room 2 CO)

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

duy782006    1.551

duy782006
Đã đăng

-Lỗi do lisp tự bắt điểm. 

-Lưu ý thêm "_non" trước bất kỳ chỉ định điểm nào trong lisp thì sẽ vô hiệu hoá bắt điểm tự động ngay lúc đó.

-Sửa thêm cho bạn nếu x trùng thì không hỏi số cột, y trùng thì không hỏi số hàng.

-Cơ bản giữ nguyên của bạn, muốn tối ưu hoá cho gọn thì bạn mò nhé. 

(defun C:VD (/ P1-Point P3-Point Max-Point Min-Point HA CO P2-Point P4-Point L-Dist W-Dist HA-Dist CO-Dist Insert-Point)
    (setq P1-Point (getpoint "\n DIEM DAU TIEN CUA CAN PHONG")
          P3-Point (getcorner P1-Point "\n DIEM THU HAI CUA CAN PHONG"))
          (setq HA 1)
          (setq CO 1)

(cond
((/= (cadr P1-Point) (cadr P3-Point))(setq HA (getint "\n NHAP SO HANG DEN CUA CAN PHONG")))
)
(cond
((/= (car P1-Point) (car P3-Point))(setq CO (getint "\n NHAP SO COT DEN CUA CAN PHONG")))
)

(prompt "\n NOI SUY THONG SO")
    (setq Max-Point (list (Max (car P1-Point) (car P3-Point)) (Max (cadr P1-Point) (cadr P3-Point)))
	  Min-Point (list (Min (car P1-Point) (car P3-Point)) (Min (cadr P1-Point) (cadr P3-Point)))
          P2-Point (list (car P1-Point) (cadr P3-Point))
          P4-Point (list (car P3-Point) (cadr P1-Point))
          L-Room (abs(- (car P3-Point) (car P1-Point)))
          W-Room (abs(- (cadr P3-Point) (cadr P1-Point)))
          HA-Dist (/ W-Room HA)
	  CO-Dist (/ L-Room CO)
          L-Dist-1 (/ L-Room (* 2 CO))
          W-Dist-1 (/ W-Room (* 2 HA)) 
         )


   (setq Sel-oject (car (entsel "\nCHON DEN DE LAP")))
   (setq Sel-oject-1 (cdr (assoc 10 (entget Sel-oject))))
  (if
    ((and (> L-Room 0) (> W-Room 0))
      (cond
	 ((and (> HA 1) (> CO 1))
	  (progn
	   (setq Insert-Point (list (+ (car Min-Point) L-Dist-1) (+ (cadr Min-Point) W-Dist-1)))
	     (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 "_Non" Insert-Point
                      ".Array" "Last" "" "R" HA CO HA-Dist CO-Dist
		      )))
	 ((and (= HA 1) (> CO 1))
	  (progn
	    (setq Insert-Point (list (+ (car Min-Point) L-Dist-1) (+ (cadr Min-Point) W-Dist-1)))
	     (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 "_Non" Insert-Point
                      ".Array" "Last" "" "R" 1 CO CO-Dist
		      )))
	 ((and (> HA 1) (= CO 1))
	  (progn
	    (setq Insert-Point (list (+ (car Min-Point) L-Dist-1) (+ (cadr Min-Point) W-Dist-1)))
	     (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 "_Non" Insert-Point
                      ".Array" "Last" "" "R" HA 1 HA-Dist)))))
    (if
      ((and (> L-Room 0) (= W-Room 0))
	(progn
	  (setq Insert-Point (list (+ L-Dist-1 (car Min-Point)) (cadr Min-Point)))
	     (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 "_Non" Insert-Point
                      ".Array" "Last" "" "R" 1 CO CO-Dist)))
      ((and (= L-Room 0) (> W-Room 0))
	(progn
	  (setq Insert-Point (list (car Min-Point) (+ (cadr Min-Point) W-Dist-1)))
	     (command ".Pline" P1-Point P2-Point P3-Point P4-Point P1-Point "C"
                      ".copy" Sel-oject "" "_Non" Sel-oject-1 "_Non" Insert-Point 
                      ".Array" "Last" "" "R" HA 1 HA-Dist)))
      )
    )
  )

 

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

quocmanh04tt    635

quocmanh04tt
Đã đăng
42 phút trước, ndtnv đã nói:

Thêm

(setvar "OSMODE" 0)

vào trước

(if
    ((and (> L-Room 0) (> W-Room 0))

 

rồi khôi phục "OSMODE" vào cuối chương trình

Chương trình viết quá dài dòng

Dồn if  and thành 1 cho gọn

Chỉ cần tách riêng  (command "   ".Array" ..)

hàm abs không cần vì max >= min

(/ L-Room (* 2 CO)) => (/ L-Room 2 CO)

Hehehe... Dài như chân Ngọc Trinh. :-)

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

D3-2015    0

D3-2015
Đã đăng
5 giờ trước, ndtnv đã nói:

Thêm

(setvar "OSMODE" 0)

vào trước

(if
    ((and (> L-Room 0) (> W-Room 0))

 

rồi khôi phục "OSMODE" vào cuối chương trình

Chương trình viết quá dài dòng

Dồn if  and thành 1 cho gọn

Chỉ cần tách riêng  (command "   ".Array" ..)

hàm abs không cần vì max >= min

(/ L-Room (* 2 CO)) => (/ L-Room 2 CO)

 

Em giờ mới nhập môn chưa có nhiều kinh nghiệm về tối ưu hóa lisp bác. Dẫu sao cảm ơn bác đã góp ý.

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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×