Chuyển đến nội dung
Diễn đàn CADViet
Jin Yong

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

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

Nhoclangbat thử cái này anh vừa viết xem sao

(defun c:CBL (/ TenBlock  Lts_EnameLine Lts_EnamePLine Lt1 Lt2 Lts LtsFilter  )
(vl-load-com)
(setvar "CMDECHO" 0)
(setq TenBlock (getstring "\n Nh\U+1EADp t\U+00EAn Block / Enter \U+0111\U+1EC3 ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng:  "))
(if (= TenBlock "") (setq TenBlock (cdr (assoc 2 (entget (car (entsel "\n Chon Block :")))))))
(Alert (strcat "\nQuet chon LINE, POLYLINE: "))
(setq ss (ssget '((0 . "*POLYLINE,LINE"))))
(setq Lts_EnameLine (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "LINE") x nil)) (acet-ss-to-list ss))))
(setq Lts_EnamePLine (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "LWPOLYLINE") x nil)) (acet-ss-to-list ss))))
(setq Lt1 (ConverLine2Point Lts_EnameLine))
(setq Lt2 (ConverPline2Point Lts_EnamePLine))
(setq Lts (append Lt1 Lt2))
(setq LtsFilter (TD:Remove-Point-duplicates Lts))
(mapcar '(lambda (x) (MakeInsert TenBlock x 1 0)) LtsFilter)
(princ)
)


(defun ConverLine2Point (Lts_EnameLine / EnameLine )
(setq L2 (list))
(foreach EnameLine Lts_EnameLine
  	(setq L2 (append L2 (list (cdr (assoc 10 (entget  EnameLine))) (cdr (assoc 11 (entget  EnameLine))))))
)
L2
)


(defun ConverPline2Point (Lts_EnamePLine / Dsdinh EnamePLine )
(setq L3 (list))
(foreach EnamePLine Lts_EnamePLine
        (setq L3 (append L3 (acet-geom-vertex-list EnamePLine)))
)
L3
)



(defun LM:_UniqueFuzz ( l fz )
    (if l
      (cons (car l)
        (LM:_UniqueFuzz
          (vl-remove-if '(lambda ( x ) (equal x (car l)  fz)) (cdr l)) fz
        )
      )
    )
)


(defun LM:RemoveOnce ( l1 l2 )
  (if l1
    (if (equal (car l1) l2)
      (LM:RemoveOnce (cdr l1) l2)
      (cons (car l1) (LM:RemoveOnce (cdr l1) l2))
    )
  )
)

(defun TD:Remove-Point-duplicates (ss_list /  Lts1 Lts2 )
(vl-load-com)
(setq Lts1  (LM:_UniqueFuzz ss_list 0.00000001))
(setq Lts3 (LM:RemoveOnce Lts1 ss_list))
Lts3
)


(defun MakeInsert (Blkname inspoint scale ang / lst obj i)
(setq lst '()
      i -1
      en (cdr (last (tblsearch "block" Blkname)))
      obj (entget en)
)
(entmakex  (list
	  	'(0 . "INSERT")
		'(100 . "AcDbEntity")
		'(100 . "AcDbBlockReference")
		(cons 2 Blkname)
		(cons 10 (trans inspoint 1 0))
		(cons 41 scale)(cons 42 scale)(cons 43 scale)
		(cons 50 Ang)
)
)
)
  • Vote tăng 2

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

- ^^ anh Duan hay mấy a khác viết lun theo y/c của nhoc thì lẹ rùi, lúc đầu nhoc tính chuyển qua muc y/c nhưng thử xem sức nhoc tới đâu, có lẽ bài toán này chưa phù hợp với sức nhoc hiện tại ^^

- thanks a Duan và a Tot nhiều lắm ^^

P/s: nhoc ráng dựa trên gợi mấy anh, viết lại cho hoàn thiện cái lsp nhoc viết từ đầu thử xem sao, chưa ra nữa thì xài  lsp a Duan viết, rùi học từ từ vậy hehe

  • Vote tăng 1

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


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

Dựa vào Code trên thì thuật toán chỉ đơn giản thế này

- Quét tất cả các đối tượng dạng Line và Polyline

- Lọc ra 2 danh sách Line và Polyline

- Với danh sách Line thì lấy tọa độ 2 đầu của Line ra và ném nó vào 1 danh sách mới. Danh sách này có thể bao hàm rất nhiều điểm trùng nhau. Không quan trọng, ta xử lý danh sách đó trong công đoạn sau.

- Tương tự như Line thì với danh sách Polyline ta làm tương tự.

- Gộp tọa độ của 2 danh sách đó lại với nhau thành 1 danh sách mới.

- Dùng hàm loại bỏ phần tử trùng nhau trong danh sách của Lee-Mac ta sẽ có được một danh sách các tọa độ trong đó không có điểm trùng.

- Tiến hành chèn Block theo tọa độ đó là xong. 

 

:wub:

  • Vote tăng 1

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


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

Dựa vào Code trên thì thuật toán chỉ đơn giản thế này

- Quét tất cả các đối tượng dạng Line và Polyline

- Lọc ra 2 danh sách Line và Polyline

- Với danh sách Line thì lấy tọa độ 2 đầu của Line ra và ném nó vào 1 danh sách mới. Danh sách này có thể bao hàm rất nhiều điểm trùng nhau. Không quan trọng, ta xử lý danh sách đó trong công đoạn sau.

- Tương tự như Line thì với danh sách Polyline ta làm tương tự.

- Gộp tọa độ của 2 danh sách đó lại với nhau thành 1 danh sách mới.

- Dùng hàm loại bỏ phần tử trùng nhau trong danh sách của Lee-Mac ta sẽ có được một danh sách các tọa độ trong đó không có điểm trùng.

- Tiến hành chèn Block theo tọa độ đó là xong. 

 

:wub:

 

Mình nghĩ nếu xét về tốc độ thì không tối ưu.

Đã mất công duyệt qua từng phần tử để lấy toạ độ điểm, sao không nhân đó mà khử các phần tử trùng nhau luôn rồi nhân có toạ độ đó chèn block luôn 

Lại phải mất công duyệt qua từng phần tử lần nữa để loại bỏ phần tử trùng nhau  rồi lại phải duyệt qua từng toạ độ đã loại bỏ phần tử trùng để chèn Block

Sao mà nhiều lần lặp như thế? ^_^

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

Mình nghĩ nếu xét về tốc độ thì không tối ưu.

Đã mất công duyệt qua từng phần tử để lấy toạ độ điểm, sao không nhân đó mà khử các phần tử trùng nhau luôn rồi nhân có toạ độ đó chèn block luôn 

Lại phải mất công duyệt qua từng phần tử lần nữa để loại bỏ phần tử trùng nhau  rồi lại phải duyệt qua từng toạ độ đã loại bỏ phần tử trùng để chèn Block

Sao mà nhiều lần lặp như thế?

Nếu đỉnh Line và Polyline nó trùng nhau thì sao ạ?

Em tách nó ra ấy ạ.

Với lại tốc độ chưa cần thiết với bài toán nhỏ anh ạ. Em biết là có cách nhanh hơn. Hiii.

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

Chương trình sẽ xét từng đỉnh Line và Pline riêng, khi duyệt qua từng đỉnh đó, chương trình sẽ kiểm tra tọa độ đỉnh đó có trong danh sách tọa độ điểm chưa? Nếu chưa có thì thêm vào (Danh sách tọa độ khởi tạo là tập rông) 

 

Tại thấy em lặp nhiều quá nên anh 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

Dạ em hiểu. ^^

Vấn đề tốc độ em còn học các anh nhiều ạ. Hiiii

Em đang học mót mờ. Hì hì. Có được học qua trường lớp nào đâu ạ. ^^

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

-nhoc rố rùi ^^, cái hàm anh Duan gợi ý cho nhoc, nhoc vẫn chưa bắt đc lắm, nhưng nhoc thấy cài hàm đầu hiểu sơ là nó dò thằng 10 gần = nhau.

- còn cái dòng nhoc lấy lst nếu là line của a Tot thì là nó lấy theo từng cặp 10 11 của 1 đối tượng, sau đó rãi block nên có sự trùng nhau nếu là line nối tiếp nhau 

- nhoc ko pit dùng cách nào để so sánh giữa thằng 11 của thằng này với 10 của thằng khác có gần = nhau ko

- cái lst của a Tot nó trả về dạng này

- nhoc thử tách lấy thằng 10 riêng, 11 riêng bằng cách này

rồi nối 2 thằng lại với nhau để có thể loại đc thằng nào trùng nhau, nhưng cái lsp nối nó trả về dạng này @@

- nếu mà nó trả về giống dòng đầu mà dạng này thằng 10 và 11 của từng đối tượng thành 1lsp rời vô chung 1 lst tổng mà ko phải dạng phức 10 với 11 thành 1lst riêng trong lst tổng thì dể xử rùi hix

@ Nhóc:

+ Nếu muốn "gói bánh" (thêm cặp ngoặc) thì dùng các hàm LIST, QUOTE ...

+ Nếu muốn "bóc bánh" (gỡ cặp ngoặc) thì dùng các hàm CAR, LAST, NTH ...

 

Là lý thuyết cũ cả, sao Nhóc lại rối lên vậy ??? :D :D :D

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


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

- hihi giờ tạm thời nhoc xài lsp anh Duan viết hộ nhoc, có mông má lại tí cho phù hợp y/c của mình, còn về tốc độ chạy từ từ rùi tính ^^, khi đủ sức binh lại sau

- nhoc cũng thử hết các kiểu xử lý danh sách rùi mà chưa đc như ý, có thể nhoc chưa phối hợp các hàm đó hợp lý, luyện từ từ vậy :)

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

 

-nhoc rố rùi ^^, cái hàm anh Duan gợi ý cho nhoc, nhoc vẫn chưa bắt đc lắm, nhưng nhoc thấy cài hàm đầu hiểu sơ là nó dò thằng 10 gần = nhau.

- còn cái dòng nhoc lấy lst nếu là line của a Tot thì là nó lấy theo từng cặp 10 11 của 1 đối tượng, sau đó rãi block nên có sự trùng nhau nếu là line nối tiếp nhau 

- nhoc ko pit dùng cách nào để so sánh giữa thằng 11 của thằng này với 10 của thằng khác có gần = nhau ko

- cái lst của a Tot nó trả về dạng này

- nhoc thử tách lấy thằng 10 riêng, 11 riêng bằng cách này

rồi nối 2 thằng lại với nhau để có thể loại đc thằng nào trùng nhau, nhưng cái lsp nối nó trả về dạng này @@

- nếu mà nó trả về giống dòng đầu mà dạng này thằng 10 và 11 của từng đối tượng thành 1lsp rời vô chung 1 lst tổng mà ko phải dạng phức 10 với 11 thành 1lst riêng trong lst tổng thì dể xử rùi hix

Hề hề hề,

Nhóc thử thay cái hàm con getp của Nhóc bằng hàm con này xem sao nhé:

 

(defun getp(v / l1 l2 l3)
(setvar "cmdecho" 0)
(cond 
((= "LINE" (cdr (assoc 0 (entget v))))
      (setq l1 (append l1 (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v))))))  )
((= "LWPOLYLINE" (cdr (assoc 0 (entget v))))
      (setq l2 (append l2 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v))))) )
)
(setq l3 nil)
 (foreach x l1
        (if (not (member x l3)) (setq l3 (cons x l3)))   )
(mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) l3)
(setq l4 nil)
 (foreach x l2
       (if (not (member x l4)) (setq l4 (cons x l4)))   )
(mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) l4)
)

 

Lưu ý là mình chưa test nên có thể chưa đạt yêu cầu của nhóc bởi cái phần lọc điểm trùng sử dụng hàm (not (member .....)). Theo lý thì nó phải được nhưng thấy mọi người ít dùng mà lại hay dùng kiểu so sánh khoảng cách với một sai số nào đó. 

Nếu Nhóc test thấy chưa Ok thì có thể thay thế phần lọc điểm trùng này bằng các hàm như bác Thanduan2407 hay bác Tot77 đã dùng.

Chủ yếu ở đây là mình sử dụng hàm append đẩ tạo ra danh sách các điểm thuộc các đối tượng được chon, giải trường hợp khó khăn của nhóc là bị list trong list như Nhóc nói thôi.

Sau khi đã lọc xong, có các l3 và l4 thì insert như Nhóc đã làm thôi.

Nhóc cũng nên lưu ý gợi ý của bác Tue_NV bởi có thể kết hợp việc lọc danh sách với việc insert để đẩy nhanh tốc độ và để .....oai hơn tí ti.

 

(cond 
    ((= "LINE" (cdr (assoc 0 (entget v))))
      (setq l1 (append l1 (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v))))))
 
)
 
((= "LWPOLYLINE" (cdr (assoc 0 (entget v))))
      (setq l2 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v))))
       
      )    
  )
  • Vote tăng 1

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


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

- ^^ nhoc mới test hàm con anh Binh viết, đúng là nó vẫn bị tình trạng list trong list nên công thức not member ko có tác dụng trong trường hợp này ^^

- biến l1 nó trả về như vầy

(((24.6622 14.9767 0.0) (28.353 12.0994 0.0)) ((19.8462 11.0653 0.0) (24.6622 14.9767 0.0)) nil)

- biến l3 dùng not member nó trả về y chang ^^

(((28.353 12.0994 0.0) (24.6622 14.9767 0.0)) ((24.6622 14.9767 0.0) (19.8462 11.0653 0.0)) nil)

- nhoc nghĩ là do thằng màu đỏ nên member nó xem cặp đó là 1 phần tử

- l1 nó trả về như vầy thì member mới xử đc ^^

((28.353 12.0994 0.0) (24.6622 14.9767 0.0) (24.6622 14.9767 0.0) (19.8462 11.0653 0.0))

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

@Nhoc: không bao giờ có chuyện l1 trả về list trong list như nhoc nói. Rất có thể là nhoc chép hàm getp của bác Bình vào phía trên nhưng lại còn hàm getp của nhoc ở phía dưới trong lsp.

@PTB: dùng (not (member... đối với list point là khá nguy hiểm, bởi đôi khi 2 point trùng nhau nhưng tọa độ thì khác nhau "chút xíu". Các lỗi oái oăm có nói đến vấn đề này rồi. Do đó người ta mới dùng distance hoặc equal. 

  • Vote tăng 1

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


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

- nhoc cũng ko pit nữa nhoc copy hàm getp của anh Bình rùi chép đè vô lsp của nhoc vào đùng hàm getp cũ  lun mà

- mấy anh cho nhoc hỏi tí, sao hàm getpoint  nhoc viết tự dưng trả về định dạng trục y kỳ lắm (589346.0 1.18935e+006 0.0), sao nó lại là khoa học nhỉ, nhoc xem hết units là decimal rùi , ko pit sao nó lại vậy, dùng lệnh id vẫn bình thường chỉ có hàm getpoint trả về vậy

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

- có 1 triệu thui mà, tọa độ nhoc hay làm việc, trục x tới trăm ngàn, trục y 1triệu, bình thường nhoc dùng getpoint bình thường ko để ý lắm, nhưng giờ sao lsp nhoc viết bị lỗi ngay thằng pick đầu tiên mới gê, nó báo vậy

- nhoc đang viết 1 lsp, sáng giờ kím lỗi nó bị gì mà ko ra, mấy anh giúp nhoc với ^^

error: bad argument type: point: nil

;hàm tao textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil))))) 
;;;;;;--------------------------------------------------------------------------------------------
;================================================================================================
(defun dtr (a)
(* (/ a 180.0) pi)
)
;;;
(defun c:kkk(/ donvi nx ny  kcx kcy goc1 goc2 x1 x y  heso old ptext1 ptext2 ptext3 ptext4 str str2 goc3 htext num)
(vl-load-com)
(setq old (getvar "osmode"))
(if (null (tblsearch "STYLE" "vusaln"))
    (emk_style "vusaln" "Vaptimn.TTF"))
(if (null (tblsearch "LAYER" "A1-luoik"))
    (_layer2 "A1-luoik" 7))
  (setq donvi (list (cons 1  100) (cons 2  50) (cons 3  25)))
  (setq tyleVT (getvalue tyleVT 1000.0 "Nhap ty le ban do VT: "))
  (setq heso (/ 1000 tyleVT))
  (setq htext (/ 2.0 heso))
  (setvar "osmode" 1)
  (setq pt1 (getpoint "\nChon diem goc duoi trai khung:"))
  (setq pt2 (getpoint pt2 "\nChon diem goc tren phai khung:"))
  (setq pt3 (inters pt1 (polar pt1 (/ pi 2) 90000) pt2 (polar pt2 pi 90000) nil))
  (setq pt4 (inters pt1 (polar pt1 0 90000) pt2 (polar pt2 (dtr 270) 90000) nil))
  (setq kcx (distance pt1 pt4) kcy (distance pt1 pt3))

;=================================================================
(setvar "osmode" old)
(princ)
)
;==============================================================================================
;;;;;;;;;;;;;;;;;;;;
(defun lamtron (n / sodu)
  (setq sodu (rem n 100))
  (if (/= sodu 0)
    (setq n (+ (- n sodu) 100))
  )
  n
)
;=================================
(defun vediem (xx yy r / left right top bot)
  (setq top (+ yy r))
  (setq bot (- yy r))
  (setq right (+ xx r))
  (setq left (- xx r))
  (makeline (list left yy) (list right yy) "A1-luoik" nil nil nil)
  (makeline (list xx top) (list xx bot) "A1-luoik" nil nil nil)
)
;============================

;=================================================================================
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;=====================================================================================
;; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 0) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;;ham tao text 2
(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 (if textstyle textstyle (getvar "textstyle")))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun them0(chuoi)
  (setq len (strlen chuoi))
  (if (= len 1)
    (strcat "00" chuoi)
    (if (= len 2)
      (strcat "0" chuoi)
      chuoi
    )  
  )
 )
 ;=========================================

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

-Sax chắc bị anh Ket trừ lv quá ^^

(set pt1 (getpoint))

(set pt2 (getpoint pt2)

=> kaka mất căn bản trầm trọng  :P

Hề hề hề,

Chuyện thường ngày ở quê tớ mà, có chi phải lo. Nhóc chăm học như vầy là chóng lên tay lắm đó. Cứ viết nhiều, lỗi nhiều rồi kiếm ra lỗi là lên như thăng thiên ấy mà. Nhưng mà cẩn thận chút chút, viết ít bị lỗi thì thăng thiên nhanh hơn........

Hề hề hề, diễn đàn lại có thêm lisper nữa rùi.....

  • Vote tăng 1

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


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

- hi thanks a Binh động viên, cái lsp nhoc đang mò hồi sáng hoàn thành rùi, anh Binh có rãnh ghé ngang topic Listp vn-2000, xem chơi thành quả đầu của nhoc  :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

nhoc đang tính cải tiến lsp của nhoc bằng pick chọn khung, mấy anh cho nhoc hỏi có cách nào lọc ra đc 2 điểm dưới trái goc khung với trên phải góc khung ko ạ ^^, nếu cụ thể vẽ rectang từ dưới lên thì nhoc có thể lấy ra đc còn trường khác thì ko pit ^^,nhoc tính viết 1 cái tổng quát hơ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
 

nhoc đang tính cải tiến lsp của nhoc bằng pick chọn khung, mấy anh cho nhoc hỏi có cách nào lọc ra đc 2 điểm dưới trái goc khung với trên phải góc khung ko ạ ^^, nếu cụ thể vẽ rectang từ dưới lên thì nhoc có thể lấy ra đc còn trường khác thì ko pit ^^,nhoc tính viết 1 cái tổng quát hơn

 

nhoc đang tính cải tiến lsp của nhoc bằng pick chọn khung, mấy anh cho nhoc hỏi có cách nào lọc ra đc 2 điểm dưới trái goc khung với trên phải góc khung ko ạ ^^, nếu cụ thể vẽ rectang từ dưới lên thì nhoc có thể lấy ra đc còn trường khác thì ko pit ^^,nhoc tính viết 1 cái tổng quát hơn

 

Việc lấy toạ độ 4 đỉnh của Rectang thì quá dễ với nhóc.

Sắp xếp list theo toạ độ Y  -> lấy 2 điểm đầu hoặc cuối tuỳ theo sort từ nhỏ đến lớn hay ngược lại.

 

T/hợp đặc biệt : nếu Rectang có 1 đuòng chéo song song với trục X, cần thêm 1 số đ.kiện mới xác định được.

Chỉnh sửa theo gia_bach

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

- thanks anh Gia_bach, nhoc vẫn chưa biết sort thằng Y cách nào, dùng hàm vl thì nhoc chưa pit, đi vòng vòng 4rum thấy thằng nào dê hiểu nhoc mót thằng đó chứ chưa học về nó nhiều, tọa độ nhoc mún lấy là góc dưới trái, với góc trên phải, nếu sort theo Y, thì có 2 điểm trên trái với trên phải Y= nhau khác X, nhoc sợ nó sếp thằng Y trên trái trước thì khổ ^^, cái tổng quát nhoc mún là dù người vẽ cái khung bắt đầu từ đâu thì cũng xác định đc thứ tự 2 điểm nhoc cần lấy mặc dù vòng vòng thì cũng chỉ có 4 điểm ^^, ý của nhoc nếu sắp sếp đc ok theo ý đồ, nhoc dùng nth để lấy 2 thằng trong đó ra tính ^^

- mấy anh rãnh xem qua lsp giúp nhoc với, nhờ anh ndtnv nhoc tóm nó gọn hơn ko dài lưa thưa nữa ^^

;hàm tao textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil))))) 
;;;;;;--------------------------------------------------------------------------------------------
;================================================================================================
(defun dtr (a)
(* (/ a 180.0) pi)
)
(prompt "LISP TAO LUOI TOA DO BAN DO VI TRI, LENH : KKL")
;;;
(defun c:kkl (/ donvi nx ny pt1 pt2 kcx kcy goc1 goc2 x1 x y  heso old ptext1 ptext2 ptext3 ptext4 str str2 goc3 htext num )
(vl-load-com)
(setq old (getvar "osmode"))
(if (null (tblsearch "STYLE" "vusaln"))
    (emk_style "vusaln" "Vaptimn.TTF"))
(if (null (tblsearch "LAYER" "A1-luoik"))
    (_layer2 "A1-luoik" 7))
  (setq tyleVT (getvalue tyleVT 1000.0 "Nhap ty le ban do VT: "))
  (setq heso (/ 1000 tyleVT))
  (setq htext (/ 2.0 heso))
;===================================*******************++++++++++++++++++++********************===================================  
(while (and (setvar "osmode" 1)
            (setq pt1 (getpoint "\nChon diem goc duoi trai khung:"))
            (setq pt2 (getpoint pt1 "\nChon diem goc tren phai khung:")))
(progn
(setvar "osmode" 0)
;======================================================================
;=======================================================================
(setq kcx (- (car pt2) (car pt1)) kcy (- (cadr pt2) (cadr pt1)))
;===============================================================================================
(cond
            ((and (>= (/ kcx 100) 2) (>= (/ kcy 100) 2))
             (setq donvi 100))
            ((and (>= (/ kcx 50) 2) (>= (/ kcy 50) 2))
             (setq donvi 50))
            ((and (>= (/ kcx 25) 2) (>= (/ kcy 25) 2))
             (setq donvi 25))
            )
(if donvi
     (progn
         (setq nx (fix (/ kcx donvi)) ny (fix (/ kcy donvi)))
 ;==============================================================================================
 (setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;===============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list donvi 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 donvi 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y donvi))
    )
;===============================================================================================
    (setq x (+ x donvi))
  )
 ;==============================================================================================
 ) ;end progn donvi
   (alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^") ; end nho hon 25
) ; end if don vi
;==============================================================================
) ; end progn while
) ; end while
(setvar "osmode" old)
(princ)
)
;==============================================================================================
;;;;;;;;;;;;;;;;;;;;
(defun lamtron (n / sodu)
  (setq sodu (rem n 100))
  (if (/= sodu 0)
    (setq n (+ (- n sodu) 100))
  )
  n
)
;=================================
(defun vediem (xx yy r / left right top bot)
  (setq top (+ yy r))
  (setq bot (- yy r))
  (setq right (+ xx r))
  (setq left (- xx r))
  (makeline (list left yy) (list right yy) "A1-luoik" nil nil nil)
  (makeline (list xx top) (list xx bot) "A1-luoik" nil nil nil)
)
;============================
;=================================================================================
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;=====================================================================================
;; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 0) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;;ham tao text 2
(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 (if textstyle textstyle (getvar "textstyle")))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun them0(chuoi)
  (setq len (strlen chuoi))
  (if (= len 1)
    (strcat "00" chuoi)
    (if (= len 2)
      (strcat "0" chuoi)
      chuoi
    )  
  )
 )

- nếu xác định sai 2 điểm, lưới tạo ra sẽ ko ở trong khung chọn ^^

(defun K:getlstp(v / l1 l2)
(setq l1 (acet-geom-vertex-list v))
(setq l2 nil)
(foreach x l1
 (if (not (member x l2)) (setq l2 (cons x l2))))
 l2
)
(defun c:xxx()
(prompt "chon doi tuong:")
(setq lstp (K:getlstp (ssname (ssget "+.:E:S" '((0 . "LWPOLYLINE"))) 0)))
(setq pt1 (nth 0 kl))
(setq pt2 (nth 2 kl))
;.............................
)
  

- nhoc mới nghĩ ra đc tới đây chưa pit sort kiểu nào ^^

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

 

- nhoc mới nghĩ ra đc tới đây chưa pit sort kiểu nào ^^

Sorry, Anh nhầm. (tưởng là lấy 2 điểm dưới bl - br)

 

nếu Rectang nằm ngang thì dùng hàm vla-getBoundingBox  lấy BottomLeft và TopRight (kiểu của obj là Vla-Object )

(vla-getBoundingBox obj 'minp 'maxp )
(setq BL (vlax-safearray->list minp)
      TR (vlax-safearray->list maxp) )
  • Vote tăng 1

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


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

- hi xử đc cái khung nhưng mất cái while rùi ^^, ai gợi ý hộ nhoc viết sao để chọn đc nhiều khung 1 lúc với, nhoc viết cũng gần ra, nhưng nếu chuột phải thoát thì báo lỗi ^^

;hàm tao textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil))))) 
;;;;;;--------------------------------------------------------------------------------------------
;================================================================================================
(defun dtr (a)
(* (/ a 180.0) pi)
)
(prompt "LISP TAO LUOI TOA DO BAN DO VI TRI, LENH : KKL")
;;;
(defun c:kkl (/ donvi nx ny pt1 pt2 kcx kcy goc1 goc2 x1 x y  heso old ptext1 ptext2 ptext3 ptext4 str str2 goc3 htext num)
(vl-load-com)
(setq old (getvar "osmode"))
(if (null (tblsearch "STYLE" "vusaln"))
    (emk_style "vusaln" "Vaptimn.TTF"))
(if (null (tblsearch "LAYER" "A1-luoik"))
    (_layer2 "A1-luoik" 7))
  (setq tyleVT (getvalue tyleVT 1000.0 "Nhap ty le ban do VT: "))
  (princ "\n")
  (setq heso (/ 1000 tyleVT))
  (setq htext (/ 2.0 heso))
(prompt "Chon Khung chay luoi, luu y khung chon phai la polyline:")
(while (/= (vla-getBoundingBox (vlax-ename->vla-object (ssname (ssget "+.:E:S" '((0 . "LWPOLYLINE"))) 0)) 'minp 'maxp))
;===================================*******************++++++++++++++++++++********************===================================  
(progn
(setvar "osmode" 0)
;======================================================================
(setq pt1 (vlax-safearray->list minp))
          (setq pt2 (vlax-safearray->list maxp))
;=======================================================================
(setq kcx (- (car pt2) (car pt1)) kcy (- (cadr pt2) (cadr pt1)))
;===============================================================================================
(cond
            ((and (>= (/ kcx 100) 2) (>= (/ kcy 100) 2))
             (setq donvi 100))
            ((and (>= (/ kcx 50) 2) (>= (/ kcy 50) 2))
             (setq donvi 50))
            ((and (>= (/ kcx 25) 2) (>= (/ kcy 25) 2))
             (setq donvi 25))
            )
(if donvi
     (progn
         (setq nx (fix (/ kcx donvi)) ny (fix (/ kcy donvi)))
 ;==============================================================================================
 (setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;===============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list donvi 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 donvi 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y donvi))
    )
;===============================================================================================
    (setq x (+ x donvi))
  )
 ;==============================================================================================
 ) ;end progn donvi
   (alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^") ; end nho hon 25
) ; end if don vi
;==============================================================================
) ; end progn while
) ; end while
(setvar "osmode" old)
(princ)
)
;==============================================================================================
;;;;;;;;;;;;;;;;;;;
(defun lamtron (n / sodu)
  (setq sodu (rem n 100))
  (if (/= sodu 0)
    (setq n (+ (- n sodu) 100))
  )
  n
)
;=================================
(defun vediem (xx yy r / left right top bot)
  (setq top (+ yy r))
  (setq bot (- yy r))
  (setq right (+ xx r))
  (setq left (- xx r))
  (makeline (list left yy) (list right yy) "A1-luoik" nil nil nil)
  (makeline (list xx top) (list xx bot) "A1-luoik" nil nil nil)
)
;============================
;=================================================================================
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;=====================================================================================
; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 0) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;ham tao text 2
(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 (if textstyle textstyle (getvar "textstyle")))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  );end mktext
;--------------------------------------
(defun them0(chuoi)
  (setq len (strlen chuoi))
  (if (= len 1)
    (strcat "00" chuoi)
    (if (= len 2)
      (strcat "0" chuoi)
      chuoi
    )  
  )
 )
;error: bad argument type: lselsetp nil

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


×