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

nhoclangbat

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    1.306

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    35

Bài đăng được đăng bởi nhoclangbat

  1. Đã đăng · Trả lời báo cáo 

    (defun c:TU ( / ob str p1 h style)
(setq ob (vlax-ename->vla-object (car (entsel "\n Chon dim:"))))
(setq str (rtos (vla-get-Measurement ob) 2 0)
style (vla-get-TextStyle ob)
h (* (vla-get-TextHeight ob) (vla-get-ScaleFactor ob) 0.75)
p1 (getpoint "\nDiem dat text:"))
(command "_txt2mtxt" (entmakex (list (cons 0 "text") (cons 10 p1) (cons 7 style) (cons 40 h) (cons 1 str))) "")
)

    -  mình sửa lại cho ra thẳng mtext 

    • Like 1

  2. Đã đăng · Trả lời báo cáo

    - Ấy quên angbase, angdir trong cad anh @duy782006 nó khác quy ước đo đạc ^^, phải qua trái, goc đầu là 0, cad là 90 nên mình phải lấy góc đo + 90, nhóc quỡn cũng viết thử, hàm thì mót chủ yếu, bỏ nghề lâu rùi nên tư duy giải thuật yếu rùi ^^ 

    (defun LM:roundto ( n p )
    (LM:roundm n (expt 10.0 (- p)))
)
(defun LM:roundm ( n m )
    (* m (atoi (rtos (/ n (float m)) 2 0)))
)
;;ham tao text 3
(defun K_text (pt height string justify layer textstyle mau ang xdata / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 pt)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 50 (if ang ang 0))
							  (cons 8 (if layer layer (getvar 'clayer)))
							  (cons 7 (if textstyle textstyle (getvar 'textstyle)))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
			(if xdata (setq lst (append lst xdata)))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
				)
	(entmakex Lst)
  )	;end K:text
;;-------------------------
;-----------------------------------------------------------------
(defun s2d (str / ret)

  (setq ret

  (vl-list->string

	(vl-remove-if

  	'(lambda (x) (or (< x 48) (> x 57)))

  	(reverse (vl-string->list str))

	)

  )

  )

  (angtof

	(vl-list->string

			(reverse

					(vl-string->list

						(strcat "\"" (substr ret 1 2) "'" (substr ret 3 2) "d" (substr ret 5))

					)

			)

	)

  )

)
;=======================================================================
(defun K_readtxt ( txt del / des lst str )
    (if (setq des (open txt "r"))
        (progn
             (while (setq str (read-line des))
                (setq lst (cons (LM:txt->lst str del 0) lst))
            )
            (close des)
        )
    )
    (reverse lst)
)
;====================
(defun LM:txt->lst ( str sep pos / s )
    (cond
        (   (not (setq pos (vl-string-search sep str pos)))
            (if (wcmatch str "\"*\"")
                (list (LM:txt-replacequotes (substr str 2 (- (strlen str) 2))))
                (list str)
            )
        )
        (   (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
                (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
            )
            (LM:txt->lst str sep (+ pos 2))
        )
        (   (wcmatch s "\"*\"")
            (cons
                (LM:txt-replacequotes (substr str 2 (- pos 2)))
                (LM:txt->lst (substr str (+ pos 2)) sep 0)
            )
        )
        (   (cons s (LM:txt->lst (substr str (+ pos 2)) sep 0)))
    )
)

(defun LM:txt-replacequotes ( str / pos )
    (setq pos 0)
    (while (setq pos (vl-string-search  "\"\"" str pos))
        (setq str (vl-string-subst "\"" "\"\"" str pos)
              pos (1+ pos)
        )
    )
    str
)
;---------------
(defun MakePoint (point layer color)
(entmakex (list '(0 . "POINT")'(100 . "AcDbEntity")
								(cons 8 (if Layer Layer (getvar "Clayer")))
								(cons 62 (if Color Color 256))
								'(100 . "AcDbPoint")(cons 10 point))))
;=======================================================================================================
(defun c:k5 (/ base dir xdau ydau file S_data cdo_ngam ds_chitiet leng_chitiet phut k_phut canh goc x_k y_k cdo i)
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq dir (getvar 'angdir))
(setvar 'angdir 1)
(setq xdau 0 ydau 0)
(if (setq file (getfiled "Select TXT File" "" "txt" 16))
	(progn
		(setq S_data (cdr (K_readtxt file "\t")))
		(setq cdo_ngam  (atoi (nth 5 (nth 0 S_data))))
		(setq ds_chitiet (cdr S_data))
		(setq leng_chitiet (length ds_chitiet))
		(setq i 1)
		(foreach k ds_chitiet
			(setq phut (nth 1 k))
			(if (= (strlen phut) 1)
				(setq k_phut (strcat "0" phut))
				(setq k_phut phut)
			)	
			(setq goc (+ (/ pi 2) (s2d (strcat (nth 0 k) "." k_phut "00"))))
			(setq canh (* 200 (- (atoi (nth 2 k)) (atoi (nth 3 k)))))
			(setq cdo (LM:roundto (/ (- cdo_ngam (atoi (nth 2 k))) 10.0) 0))	
			(setq x_k (+ xdau (* canh (cos goc))))
			(setq y_k (+ ydau (* canh (sin goc))))
			
			(MakePoint (list x_k y_k cdo) "point" 2)
			(K_text (list x_k y_k) 200 (itoa i) "L" "stt" nil 3 nil nil)
			(K_text (mapcar '+ (list x_k y_k) '(0 -250.0 0)) 200 (rtos cdo 2 0) "L" "cdo" nil 4 nil nil)
			(setq i (1+ i))
		)
		(MakePoint (list xdau ydau 3067) "point" 2)
		(K_text (list xdau ydau) 200 "Tram" "L" "tram" nil 1 nil nil)
	)
)
(setvar 'angdir dir)
(setvar 'cmdecho 1)
(princ)
)

     

    • Vote tăng 1

  3. Đã đăng · Trả lời báo cáo

    -mảng cao độ  em chỉ làm đc đơn giản ah, dẫn chuyền từ cao độ góc tới điểm cần gửi, em ko rành lắm các loại máy và kiểu mia,  mia bên em số đọc 4 số là tính theo (mm) thấp nhất là 0, cái 3067 em hiểu là 3.067 m; chỉ trên và dưới cũng vậy; nếu mia cơ bản khoảng cách = ( trên - dưới)/10 (m) , còn vì sao số liệu anh trên đưa mẫu và file mẫu xuất ra toàn lấy số nguyên thì em chịu, theo file cad thì khoảng cách trạm đầu tới diem đầu tiên là 12600 units, bên địa chính bên em quy ước thì 1 unit trong cad = 1 m ngoài thực địa, ở đây tới 12600 = 12km => máy này đo xa dữ ^^, còn nếu hiểu theo xây dựng thì chỉ 1 unit=1mm => 12.6 m (có vẽ hợp lý hơn)

    • Like 1

  6. Đã đăng · Trả lời báo cáo

    * em nghiệm ra rồi anh @duy782006 ^^

    - Trạm máy A (xA=0, yA=0)

    - điểm B: góc 30đô 30 phút, chỉ trên :1473; dưới 1410.

           + góc B chuyển sang radian hàm này chắc anh  viết được, ở đây góc bằng : 0.5236 (rad)

           + cạnh A-B = (1473-1410)* hằng số máy : theo file hướng dẫn là 200, em so sánh với file cad gửi lên tương đối khớp 

           + cao độ = 3067-1410

           + => xB= xA + S[ab]cosB <=> xB= 0 + (12600x(cos B)) ; yB tương tự mà là sin(B)

    - điểm C, D, ... tương tự

    • Like 1

  7. Đã đăng · Trả lời báo cáo

    - nhoc hiểu sơ sơ nhưng số liệu thô có vấn đề or v...v, không tính ra được cạnh ^^, điểm A tương ứng trạm tọa độ (0,0)

    -vd: góc của điểm đầu tiên cho là điễm B : 33 độ 30 phút => radian

           => xB= xA + S[ab]cosB ; yB= yA + S[ab]sinB : cái chưa hiểu S[ab] tính thế nào ^^, zB = 3067-1473(chỉ dưới B)=159, công thức nhoc biết: chỉ trên - dưới = khoảng cách mà thiếu chỉ trên điểm B, các điểm sau C,...,F cũng lấy gốc là điểm A tính ra theo cú pháp đó

    p/s: không biết có dịch sai số liệu không ^^

  8. Đã đăng · Trả lời báo cáo

    - vuông góc thì được, song song mình chưa nghĩ ra ^^ 

    (defun c:KKK(/ ent ss ds_ip ds_text ss2 ds_li ss3 en)
(setvar 'osmode 0)
(setvar 'cmdecho 0)
(setq ent (car (entsel "\nChon pline cho truoc: ")))
(alert "chon point")
(setq ss (ssget '((0 . "POINT"))))
(if (and ss ent)
	(progn
		(setq ds_text (ss2ent ss))
		(setq ds_ip (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ds_text))
		(foreach k ds_ip (lpp2c k ent "duong_giong"))
		;-----------------------------------------------------
		(setq ss2 (ssget "X" '((8 . "duong_giong"))))
		(if ss2 
			(progn
				(setq ds_li (ss2ent ss2))
				(foreach k ds_li
					(setq dx10 (cdr (assoc 10 (entget k))) dx11 (cdr (assoc 11 (entget k))))
					(setq ss3 (ssget "F" (list dx10 dx11) '((8 . "Level 10"))))
					(setq en (ssname ss3 0))
					(lpp2c dx10 en "chi_giong")
					(vl-cmdf ".extend" ent "" (entlast) "")
					(vl-cmdf ".erase" k "")
				)
				(vl-cmdf "-purge" "layer" "duong_giong" "n")
			)
		);end if ss2		
	)
)
(setvar 'cmdecho 1)
(princ)
)	

(defun LPP2C (p1 c lay / p2);;;Line from Point p1 Perpendicular To Curve c
(vl-load-com)
(setq p2 (vlax-curve-getClosestPointTo c p1 T))
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 (if lay lay)) ))
)
;==================
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;===================

     

    • Like 1

  9. Đã đăng · Trả lời báo cáo

    - lâu rùi có mót đc anh nào cái hàm phù hợp mong mún của bạn, bạn test thử, line vẽ theo layer hiện hành nha ^^, cuối giờ làm biếng hihi 

    (defun c:KKK(/ ent ss ds_ip ds_text )
(setq ent (car (entsel "\nChon pline cho truoc: ")))
(alert "chon text")
(setq ss (ssget '((0 . "*text"))))
(if (and ss ent)
	(progn
		(setq ds_text (ss2ent ss))
		(setq ds_ip (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ds_text))
		(foreach k ds_ip (lpp2c k ent))
	)
)
(princ)
)	

(defun LPP2C (p1 c / p2);;;Line from Point p1 Perpendicular To Curve c
(vl-load-com)
(setq p2 (vlax-curve-getClosestPointTo c p1 T))
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)
;==================
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;===================

     

    • Like 1

  10. Đã đăng · Trả lời báo cáo

    -theo cách hiểu dân dã của mình thì 3 trường của bạn có thể gôm làm 1, chủ yếu thằng mẫu đầu tiên nó mang màu đang hiển thị là gì thì vùng chọn sẽ lọc tất cả đối tượng có màu đó ko quan tâm bylayer hay tùy chọn chỉ cần màu nó đang hiển thị giống màu mẫu ban đầu chọn ^^, code thử vội đi ngoại nghiệp 

    (defun c:ha ( / lst1 lst2 clr cly ss2 ds_ent ds_ent2 ds_ent3 mau mau2 mau_lay_goc ds_ent2_1 ds_ent5 ds_ent4)
(setq ds_layer (K:dsbg "layer"))
(setq ent (car (entsel "\nDoi tuong mau :")))
(if ent
	(progn
		(setq clr (cdr (assoc 62 (entget ent))))
		(setq cly (cdr (assoc 8 (entget ent))))
		(if clr
			(progn
			    (prompt "chon vung: ")
				(setq lst1 (acet-ss-to-list (ssget "x" (list (cons 62 clr)))))
				(setq lst2 (ssadd))
				(foreach name lst1 (ssadd name lst2))
				(sssetfirst nil lst2)
			)
			(progn
				(setq mau_lay_goc (vla-get-color (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) cly)))
			;----------------------------------------------------------------------------------------------------------------------
				(prompt "chon vung: ")
				(setq ss2 (ssget))
				(if ss2 
						(progn
							(setq ds_ent (ss2ent ss2)) 
							;(setq ds_lay_chon (mapcar '(lambda (x) (cdr (assoc 8 (entget x)))) ds_ent))
							(foreach k ds_ent
								(setq mau (cdr (assoc 62 (entget k ))))
								(if (= mau nil) (setq ds_ent2 (append (list k) ds_ent2))   (setq ds_ent2_1 (append (list k) ds_ent2_1))  ) 
							)
							;--------------------
							(foreach k ds_ent2 
								(setq mau2 (vla-get-color (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 8 (entget k )))  )))
								(if (= mau2  mau_lay_goc) (setq ds_ent3 (append (list k) ds_ent3)))
							)
							;---------------------------------------------------------------
							(foreach k ds_ent2_1 (setq mau4 (cdr (assoc 62 (entget k ))))
								(if (= mau4 mau_lay_goc) (setq ds_ent4 (append (list k) ds_ent4)))
							)
							;----------------------------------------------------------
							(setq ds_ent5 (append ds_ent3 ds_ent4))	
							;------------------------------------------------------------
							(setq lst2 (ssadd))
							(foreach name ds_ent5 (ssadd name lst2))
							(sssetfirst nil lst2)
						)
				)			
			);end progn clr
		); end if clr
	);end progn ent
)	
(princ)
			
)

 
;1- ham lay ten cac phan tu trong 1 tab
(defun K:dsbg (table / lst phu)
(tblnext table t)
(while (setq phu (tblnext table nil))
(setq lst (cons (cdr (assoc 2 phu)) lst))
)
)
;=========================================
;==================
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;=====================================================================================================================
(defun c:ha2 ( / lst1 lst2 clr cly ss2 ds_ent ds_ent2 ds_ent3 mau mau2 mau_lay_goc ds_ent2_1 ds_ent5 ds_ent4 ds_ss_new clr_ex lay_k ds_ss clr_k)
(setq ent (car (entsel "\nDoi tuong mau :")))
(if ent
(progn
	(setq cly (cdr (assoc 8 (entget ent))))
	(setq clr_ex (if (= (setq clr (cdr (assoc 62 (entget ent)))) nil) 
					(vla-get-color (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) cly)) clr)) 
;---------------------------------------------------------------------------
	(prompt "chon vung: ")
	(setq ss2 (ssget))
	(if ss2 
		(progn
			(setq ds_ss (ss2ent ss2))
			(foreach k ds_ss
				(setq lay_k (cdr (assoc 8 (entget k))))
				(setq clr_k (if (= (setq clr1 (cdr (assoc 62 (entget k)))) nil) 
					(vla-get-color (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) lay_k)) clr1))
			;-------------------------------------------------------------------------------
				(if (= clr_k clr_ex)
					(setq ds_ss_new (append (list k) ds_ss_new))
				)
			)
			(setq lst2 (ssadd))
			(foreach name ds_ss_new (ssadd name lst2))
			(sssetfirst nil lst2)
		)
	);end if ss2
);end pron
);end if ent
(princ)
)

    lệnh ha2

    • Vote tăng 1

  12. Đã đăng · Chỉnh sửa theo nhoclangbat
    thiếu chút hihi     · Trả lời báo cáo

    -ý chọn theo bylayer của bạn nó hơi rộng mình hiểu vậy, bạn nên đặt trường hợp hay ví dụ củ thể để dễ hình dung, theo ý của anh Mod trình bày mình hiểu nôm na là dựa trên màu của đối tượng đc chọn  làm mẫu đầu tiên không cần biết có đúng màu chính chủ không, sau đó quét vùng đối tượng rồi lọc ra highlight các đối tượng có màu giống đối tượng mẫu, bạn chạy thử, lâu rùi ko viết code nên  biến đặt nó hơi lung tung ^^ 

    (defun c:ha ( / lst1 lst2 clr cly ss2 ds_ent ds_ent2 ds_ent3 mau mau2 mau_lay_goc ds_ent2_1 ds_ent5 ds_ent4)
(setq ent (car (entsel "\nDoi tuong mau :")))
(if ent
	(progn
		(setq clr (cdr (assoc 62 (entget ent))))
		(setq cly (cdr (assoc 8 (entget ent))))
		(if clr
			(progn
				(setq lst1 (acet-ss-to-list (ssget "x" (list (cons 62 clr)))))
				(setq lst2 (ssadd))
				(foreach name lst1 (ssadd name lst2))
				(sssetfirst nil lst2)
			)
			(progn
				(setq mau_lay_goc (vla-get-color (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) cly)))
			;----------------------------------------------------------------------------------------------------------------------
				(prompt "chon vung: ")
				(setq ss2 (ssget))
				(if ss2 
						(progn
							(setq ds_ent (ss2ent ss2)) 
							;(setq ds_lay_chon (mapcar '(lambda (x) (cdr (assoc 8 (entget x)))) ds_ent))
							(foreach k ds_ent
								(setq mau (cdr (assoc 62 (entget k ))))
								(if (= mau nil) (setq ds_ent2 (append (list k) ds_ent2))   (setq ds_ent2_1 (append (list k) ds_ent2_1))  ) 
							)
							;--------------------
							(foreach k ds_ent2 
								(setq mau2 (vla-get-color (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 8 (entget k )))  )))
								(if (= mau2  mau_lay_goc) (setq ds_ent3 (append (list k) ds_ent3)))
							)
							;---------------------------------------------------------------
							(foreach k ds_ent2_1 (setq mau4 (cdr (assoc 62 (entget k ))))
								(if (= mau4 mau_lay_goc) (setq ds_ent4 (append (list k) ds_ent4)))
							)
							;----------------------------------------------------------
							(setq ds_ent5 (append ds_ent3 ds_ent4))	
							;------------------------------------------------------------
							(setq lst2 (ssadd))
							(foreach name ds_ent5 (ssadd name lst2))
							(sssetfirst nil lst2)
						)
				)			
			);end progn clr
		); end if clr
	);end progn ent
)	
(princ)
			
)
    (defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;===============

    -bạn copy them code phần dưới vô code trên mình copy thiếu ^^

    • Vote tăng 1

  13. Đã đăng · Trả lời báo cáo

    lâu rùi ko vọc vạch lsp, bạn xem thử ^^ 

    (defun c:ha ( / lst1 lst2 clr cly)
(setq ent (car (entsel "\nDoi tuong mau :")))
(if ent
	(progn
		(setq clr (cdr (assoc 62 (entget ent))))
		(setq cly (cdr (assoc 8 (entget ent))))
		(if clr
			(progn
				(setq lst1 (acet-ss-to-list (ssget "x" (list (cons 62 clr)))))
				(setq lst2 (ssadd))
				(foreach name lst1 (ssadd name lst2))
				(sssetfirst nil lst2)
			)
			(progn	
				(setq lst1 (acet-ss-to-list (ssget "x" (list (cons 8 cly)))))
				(setq lst2 (ssadd))
				(foreach name lst1 (ssadd name lst2))
				(sssetfirst nil lst2)
			)
		)
	)
)	
(princ)
			
)

     

  14. Đã đăng · Trả lời báo cáo

    chắc bạn muốn đỗ file vào phần mềm xuất bảng biểu, theo mình cái này nên xử lý trước ở phần tạo nhãn bên micro, làm nhãn nhỏ thui để chạy, 1 file nhãn lớn để trình bày, mình mẹo 1 tý dựa trên lisp bạn trên, tuy nhiên chắc không triệt để đc vì khi text nó lớn hơi khó kiểm soát chưa kể nhãn nằm ngoài vùng thửa 

    (defun c:scc (/ ss_30 ds_30 ss_text tam ds-33 ds_30  ss_33 mid1 ip2 ip3 ip4 ip1) 
(setvar 'cmdecho 0)	
;---------------------------------------------
(setq ss_33 (ssget '((0 . "*text") (8 . "Level 33"))))
(if ss_33
	(progn	
		(setq ds-33 (ss2ent ss_33))
		(foreach k ds-33
			(setq s1 (ssadd k))
			(setq mid1 (mapcar '(lambda (x y) (* (+ x y) 0.5)) (car (LM:ssboundingbox s1))(cadr (LM:ssboundingbox s1))))
			(setq ip1 (mapcar '+ mid1 '(-10 3.5 0)) ip4 (mapcar '+ mid1 '(10 3.5 0)))
			(setq ip2 (mapcar '+ mid1 '(10 -35 0)))
			(setq ip3 (mapcar '+ mid1 '(-10 -35 0)))
			(setq ss_text (ssget "_CP" (list  ip1 ip4 ip2 ip3) '((0 . "*text"))))
			(vl-cmdf "_.scale" ss_text "" mid1 0.1)
			(setq s1 nil)
		)
	)
)
(princ)
)
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;========================================		
(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
                  ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
            )
        )
    )
    (if (and ls1 ls2) (list ls1 ls2))
)

     

    • Like 1

  15. Đã đăng · Trả lời báo cáo

    - Góp ý thử cho zui ^^, nếu bạn dùng lsp tính diện tích bằng cách BO còn tùy phương thức xử lý trong lsp, kết quả trả về của lsp như thế nào và cách bạn sử dụng nên có nhiều trường hợp xảy ra

    + lsp còn giữ lại bo đã tạo nằm trên 1 lớp nhất định do lsp tạo ra thì có thể bắt lỗi bằng cách khi pick lần nửa nếu có 2 bo cùng lớp thì "alert", còn bo ngẫu nhiên theo layer hiện hành thì cũng có khả năng lọc nếu còn đang trong quá trình sử dụng lsp pick rùi pick lại, còn sau khi kết thúc lệnh rùi chạy lại pick đúng hình đó nhưng lúc này đã chuyển qua lớp khác hay trường hợp khác lsp bo xong tính xong xóa luôn bo đó thì nhóc cũng chịu ^^.

    + lsp bo xong xuất text diện tích 1 lớp do lsp quy định thì khi pick lại dò trong vùng còn text đó thì "alert", áp dụng đc khi text xuất trưc tiếp trong vùng ko có lựa chọn điểm đặt text, lúc này ko cần quan tâm thằng bo như thế nào, chạy lsp 1 lần hay nhiều lần ^^.

    - Tốt nhất bạn cần đưa ra phương thức sử dụng cụ thể, kết quả trả về bạn muốn như thế nào mới có phương án code để lọc vùng diện tích đã tính ^^

  25. Đã đăng · Trả lời báo cáo

    - hi công nhận viết mấy lsp dạng xử lý danh sách nhức đầu thật, nhoc còn yếu khoảng này ^^, nhìn vô thì thêm có mấy dòng mà mất cả sáng mới nghĩ ra ^^, bạn test thử xem hen ^^

    (defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)     
(setq e (ssname ss i)        
Le (append Le (list e))        
i (1+ i)    ))
Le)
;=================================================================================
(defun Length1(e) 
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;=======================================================================
(defun c:kko (/ ss ds_ent ds_laydis layer dis info ds_tk ten_layer sl ds_new ko ds_tkk k1 k2 k3 K_join_ds)
;============================
(defun K_join_ds ( lst1 lst2 / tam  i ds_moi)
(setq i 0)
(foreach m lst1
(setq tam (append (nth i lst2) (list m)))
(setq ds_moi (append ds_moi (list tam)))
(setq i (1+ i))
)
ds_moi)
;================================================
(prompt "Quet chon cac Multiline ")
(setq ss (ssget '( (0 . "MLINE"))))
(if ss 
	(progn 
		(setq ds_ent (ss2ent ss))
			(foreach k ds_ent
				(setq info (entget k))
				(setq layer (acet-dxf 8 info))
				(setq dis (add_mline info))
				(setq ds_laydis (append ds_laydis (list (list  layer dis))))
			)
		(setq ds_new (LM:_UniqueFuzz ds_laydis 0.00001))
		(setq sl (mapcar '(lambda (z) (apply '+ (mapcar '(lambda (j) (if (equal j z 0.00001) 1 0)) ds_laydis))) ds_new))
		(setq ds_tk (K_join_ds sl ds_new))
	  (foreach u ds_tk
	  (setq k1 (LM:InsertNth "\t" 1 u) k2 (LM:InsertNth "\t" 2 k1) k3 (LM:InsertNth "\t" 4 k2))
	  (setq ds_tkk (append ds_tkk (list k3)))
	  )
	)
)
(xls ds_tkk '("LAYER" "\t" "\t" "CHIEU DAI" "\t" "SO LUONG") nil "Thong ke")
(princ)
)
;============================================================================================================================
(defun LM:InsertNth ( x n l )
  (
    (lambda ( i )
      (apply 'append
        (mapcar '(lambda ( a ) (if (= n (setq i (1+ i))) (list x a) (list a))) l)
      )
    )
    -1
  )
)
;============================================================================================================================================
(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
        )
      )
    )
)
;==============================================================================================================================================
(vl-load-com)
(defun xls (Data-list	   header	  Colhide	 Name_list
	    /		   *aplexcel*	  *books-colection*
	    Currsep	   *excell-cells* *new-book*	 *sheet#1*
	    *sheet-collection*		  col		 iz_listo
	    row		   cell		  cols
	   )
  (defun Letter	(N / Res TMP)
    (setq Res "")
    (while (> N 0)
      (setq TMP	(rem N 26)
	    TMP	(if (zerop TMP)
		  (setq	N   (1- N)
			TMP 26
		  )
		  TMP
		)
	    Res	(strcat (chr (+ 64 TMP)) Res)
	    N	(/ N 26)
      )
    )
    Res
  )
  (if (null Name_list)
    (setq Name_list "")
  )
  (setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-invoke-method *Sheet-Collection* "Add")
    )
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
	  *New-Book*	     (vlax-invoke-method *Books-Colection* "Add")
	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
	  *Sheet#1*	     (vlax-get-property *Sheet-Collection* "Item" 1)
    )
  )
  (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
  (setq	Name_list (if (= Name_list "")
		    (vl-filename-base (getvar "DWGNAME"))
		    (strcat (vl-filename-base (getvar "DWGNAME"))
			    "&"
			    Name_list
		    )
		  )
	col	  0
	cols	  nil
  )
  (if (> (strlen Name_list) 26)
    (setq Name_list
	   (strcat (substr Name_list 1 10)
		   "..."
		   (substr Name_list (- (strlen Name_list) 13) 14)
	   )
    )
  )
  (vlax-for sh *Sheet-Collection*
    (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols))
  )
  (setq row Name_list)
  (while (member (strcase row) cols)
    (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")"))
  )
  (setq Name_list row)
  (vlax-put-property *Sheet#1* 'Name Name_list)
  (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
  (vlax-put-property
    *AplExcel*
    "UseSystemSeparators"
    :vlax-false
  ) ;_?? ???????????? ????????? ?????????
  (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_??????????? ??????? ? ????? ?????
  (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_??????????? ???¤???
  (vla-put-visible *AplExcel* :vlax-true)
  (setq	row 1
	col 1
  )
  (if (null header)
    (setq header '("X" "Y" "Z"))
  )
  (repeat (length header)
    (vlax-put-property
      *excell-cells*
      "Item"
      row
      col
      (vl-princ-to-string (nth (1- col) header))
    )
    (setq col (1+ col))
  )
  (setq	row 2
	col 1
  )
  (repeat (length Data-list)
    (setq iz_listo (car Data-list))
    (repeat (length iz_listo)
      (vlax-put-property
	*excell-cells*
	"Item"
	row
	col
	(vl-princ-to-string (car iz_listo))
      )
      (setq iz_listo (cdr iz_listo)
	    col	     (1+ col)
      )
    )
    (setq Data-list (cdr Data-list))
    (setq col 1
	  row (1+ row)
    )
  )
  (setq	col (1+ (length header))
	row (1+ row)
  )
  (setq	cell (vlax-variant-value
	       (vlax-invoke-method
		 *Sheet#1*
		 "Evaluate"
		 (strcat "A1:" (letter col) (itoa row))
	       )
	     )
  ) ;_ end of setq
  (setq cols (vlax-get-property cell 'Columns))
  (vlax-invoke-method cols 'Autofit)
  (vlax-release-object cols)
  (vlax-release-object cell)
  (foreach item	ColHide
    (if	(numberp item)
      (setq item (letter item))
    )
    (setq cell (vlax-variant-value
		 (vlax-invoke-method
		   *Sheet#1*
		   "Evaluate"
		   (strcat item "1:" item "1")
		 )
	       )
    )
    (setq cols (vlax-get-property cell 'Columns))
    (vlax-put-property cols 'hidden 1)
    (vlax-release-object cols)
    (vlax-release-object cell)
  )
  (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
  (mapcar 'vlax-release-object
	  (list	*excell-cells*	    *Sheet#1*
		*Sheet-Collection*  *New-Book*
		*Books-Colection*   *AplExcel*
	       )
  )
  (setq *AplExcel* nil)
  (gc)
  (gc)
  (princ)
)
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;http://www.cadviet.com/forum/topic/763-routine-tinh-tong-chieu-dai-cac-doi-tuong/
(defun add_mline ( elist / pt1 mline_len pt2 tot_len)
(setq tot_len 0.0)
  (foreach k	elist
    (cond ((= 10 (car k))
	   (setq pt1	   (cdr k)
		 mline_len 0.0
	   )
	  )
	  ((= 11 (car k))
	   (setq pt2	   (cdr k)
		 mline_len (+ mline_len (distance pt2 pt1))
		 pt1	   pt2
	   )
	  )
    )
  )
  (setq tot_len (+ tot_len mline_len))
 )
    • Vote tăng 1
×