Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
cdhn

vẽ đường chú thích thanh thép (đường mũi tên chỉ)

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

nhoclangbat    382

- hi anh Tot ơi bữa nhoc hỏi vụ vẽ mũi tên là làm chiện khác, còn như bạn đó y/c nhoc có xem thử rùi, nhưng vẫn chưa nghĩ ra giải thuật để làm kaka

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
hiepttr    523

Tranh thủ luyện tí ! :D

 

p/s:

Thanh thép phải là LINE hoặc PLINE được vẽ bằng layer "THEP" , nếu tên layer của bạn chưa đúng thì sửa lisp lại ^^

 

Layer và màu có lẻ là bạn chưa ưng ý, mình sẽ sửa khi bạn cho xem bản vẽ mẫu !

 

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old ss pt1 pt2 ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(cond ((not(tblsearch "block" "mui_ten"))
			(entmake (list
							'(0 . "TRACE")
							'(100 . "AcDbEntity") 
							;(cons 8 "0")
							'(100 . "AcDbTrace") 
							'(10 0 0 0) 
							'(11 0 0 0) 
							'(12 -2.5 -0.5 0) 
							'(13 -2.5 0.5 0)
							)
			)
			(command "-block" "mui_ten" '(0 0 0) (entlast) "")
			))
;=================
(prompt "\nChon cac thanh thep can ghi chu thich !")
(setq ss (ssget '((0 . "LINE,LWPOLYLINE") (8 . "THEP")))
	  pt1 (getpoint "\nXac dinh 2 diem tren duong dong ghi chu !\nChon diem goc: ")
	  pt2 (getpoint pt1 "\nChon diem phia ngon mui ten: ")
	  )
(mapcar 'setvar lst_va '(0 0 3))
(if (and ss pt1 pt2)
	(progn
		(MAKELINE pt1 pt2 nil nil "DONG" nil nil)	  
		(setq ent1 (entlast))
		(foreach elem (ss2lst ss)
			(setq lst1 (acet-geom-intersectwith ent1 elem 1)
				  pt (car (vl-sort lst1 '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
				  lst_pt (cons pt lst_pt))
			(command "-insert" "mui_ten" "S" 1 "R" (angle pt1 pt2) pt)
			)	;for
		(setq lst_pt (vl-sort lst_pt '(lambda (x y) (> (distance pt1 x) (distance pt1 y)))))
		(entmod (subst (cons 11 (car lst_pt)) (assoc 11 (setq info (entget ent1))) info))
		)
	(princ "\n*** NOTE: Cac thanh thep phai duoc ve bang layer <THEP> ***")
)	;if
(mapcar 'setvar lst_va old)
(princ)
)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)))
)
;===================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
	(setq ename (ssname ss i)
		  i (1+ i)
		  lst (cons ename lst))
)
(reverse lst)
)

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
nhoclangbat    382

- hehe nhanh hơn nhoc gấp 10 lần, sư huynh có khác te ^^, sao Hiep ko thêm cái line đuôi mủi tên ra xíu cho giống trong hình hì  :P

- ý kiến riêng của nhoc mũi tên đừng để thành block, mấy bản vẽ kỹ thuật chắc nhiều block lắm khó quản lý (nhoc đoán thui chứ hem pit ^^)

- còn lsp rãi block mà nhoc hỏi mấy a, bên nhoc ít sử dụng block nên có thêm vài block cũng ko thành vấn đề ^^

P/s: chờ gạch của sư huynh  ^_^

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
cdhn    0

em cám ơn mấy anh đã quan tâm:

anh hiepttr viết gần đúng ý của em rồi:

bản vẽ của em tên thép như thế nào là tên layer như vậy tức là rất nhiều layer.

nhưng đường chỉ thì nó là layer 1 màu đỏ.

đây là file cụ thể:

https://www.dropbox.com/s/jdhzmd0lrxuqlco/VE%20DUONG%20MUI%20TEN.dwg?dl=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
hiepttr    523

@cdhn:

- File cụ thể của bạn vẫn chưa đc cụ thể lắm :D vì nó vẫn chưacó "đường chỉ"

Tuy nhiên, mình xử lý tạm vậy >>> coi như xong.

 

- Về phần thanh thép có trường hợp là bock >>> phiền bạn explode trước khi chạy lisp (có thể quản lý đồi tượng bằng Group hoặc array)

 

- Độ lớn mũi tên, mình chỉnh vừa (tạm coi được) với bản vẽ bạn gửi lên (do ko có mẫu)

>>> nếu ko vừa ý bạn có thể chỉnh trong dòng

(command "-insert" "mui_ten_hiep" "S" 20 "R" (angle pt1 pt2) pt)

thay số 20 bằng số hợp lý !

 

@Nhóc:

- "Điểm góc" trong lisp là nơi đặt text ghi chú, Nhóc pick ra ngoài >>> "sẽ có râu" , OK !

 

- Mũi tên = block là theo trường phái của cad >>> mình bảo lưu.

 

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old pt1 pt2 ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(if (not(tblsearch "layer" "DONG_MAU_DO")) (MakeLayer "DONG_MAU_DO" 1 nil nil T))
(setq lay (getvar 'clayer))
(setvar 'clayer "DONG_MAU_DO")
;=================
(cond ((not(tblsearch "block" "mui_ten_hiep"))
			(entmake (list
							'(0 . "TRACE")
							'(100 . "AcDbEntity") 
							;(cons 8 "0")
							'(100 . "AcDbTrace") 
							'(10 0 0 0) 
							'(11 0 0 0) 
							'(12 -2.5 -0.5 0) 
							'(13 -2.5 0.5 0)
							)
			)
			(command "-block" "mui_ten_hiep" '(0 0 0) (entlast) "")
			))
;=================
(prompt "\nChon cac thanh thep can ghi chu thich !")
(setq ss (ssget '((0 . "LINE,LWPOLYLINE")))
	  pt1 (getpoint "\nXac dinh 2 diem tren duong dong ghi chu !\nChon diem goc: ")
	  pt2 (getpoint pt1 "\nChon diem phia ngon mui ten: ")
	  )
(mapcar 'setvar lst_va '(0 0 3))
(if (and ss pt1 pt2)
	(progn
		(MAKELINE pt1 pt2 nil nil nil nil nil)	  
		(setq ent1 (entlast))
		(foreach elem (ss2lst ss)
			(setq lst1 (acet-geom-intersectwith ent1 elem 1)
				  pt (car (vl-sort lst1 '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
				  lst_pt (cons pt lst_pt))
			(command "-insert" "mui_ten_hiep" "S" 20 "R" (angle pt1 pt2) pt)
			)	;for
		(setq lst_pt (vl-sort lst_pt '(lambda (x y) (> (distance pt1 x) (distance pt1 y)))))
		(entmod (subst (cons 11 (car lst_pt)) (assoc 11 (setq info (entget ent1))) info))
		)
	(princ "\n*** Dau vao chu hop ly ***")
)	;if
(mapcar 'setvar lst_va old)
(setvar 'clayer lay)
(princ)
)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)))
)
;===================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
	(setq ename (ssname ss i)
		  i (1+ i)
		  lst (cons ename lst))
)
(reverse lst)
)
;================================
(defun MakeLayer (name color linetype lineWeight plot)	
(entmakex (list '(0 . "LAYER")								 
				(cons 100 "AcDbSymbolTableRecord")								 
				(cons 100 "AcDbLayerTableRecord")								 
				(cons 2 name)								 
				(cons 70 0)								 
				(cons 62 (if color color 7))								 
				(cons 6 (if linetype linetype "Continuous"))								 
				(cons 290 (if plot 1 0))								 
				(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))))
)
  • 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
cdhn    0

thanks hiepttr nhiều, rất đúng ý mình :)

mình muốn phát triển thêm tí nữa là cho chọn 1layer rồi quét vùng chọn thì nó tự vẽ mũi tên ở  layer mà mình vừa chọn.

được vậy thì cái này quá tuyệt vời B)

(mình chạy cad 2007 thì ok sao chạy cad 2015 nó báo lỗi error: bad DXF group:(11)

error: bad DXF group: (11)
 
error: bad DXF group: (11)
 
error: bad DXF group: (11)
 
error: bad DXF group: (11)
 
error: bad DXF group: (11)
 
error: bad DXF group: (11)
 
error: bad DXF group: (11)
 
error: bad DXF group: (11)
 
error: bad DXF group: (11)
 
error: bad DXF group: (11)
 
bad DXF group: (11)
 
bad DXF group: (11)

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
hiepttr    523

Đã chỉnh sửa theo ý bạn

Song, như vậy là nếu thép nằm ở nhiều layer thì phải ghi nhiều lần, OK !

Cad 2015 mình ko cài nên ko biết, mình 2014 chạy rầm rầm :D :D :D

>>> Đây bạn:

 

P/s: Đã chỉnh sửa (khai thêm biến cục bộ cho đủ) lúc 16h26 ngày 21/10/2014_Nếu cdhn đã lỡ down thì down lại, tranh sai sót đáng tiếc !!!

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old lay lay_thep ss pt1 pt2 ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(if (not(tblsearch "layer" "DONG_MAU_DO")) (MakeLayer "DONG_MAU_DO" 1 nil nil T))
(setq lay (getvar 'clayer))
(setvar 'clayer "DONG_MAU_DO")
;=================
(cond ((not(tblsearch "block" "mui_ten_hiep"))
			(entmake (list
							'(0 . "TRACE")
							'(100 . "AcDbEntity") 
							;(cons 8 "0")
							'(100 . "AcDbTrace") 
							'(10 0 0 0) 
							'(11 0 0 0) 
							'(12 -2.5 -0.5 0) 
							'(13 -2.5 0.5 0)
							)
			)
			(command "-block" "mui_ten_hiep" '(0 0 0) (entlast) "")
			))
;=================
(setq lay_thep (assoc 8 (entget (car (entsel "\nChon thanh thep mau: ")))))
(prompt "\nChon cac thanh thep can ghi chu thich !")
(setq ss (ssget (append '((0 . "LINE,LWPOLYLINE")) (list lay_thep)))
	  pt1 (getpoint "\nXac dinh 2 diem tren duong dong ghi chu !\nChon diem goc: ")
	  pt2 (getpoint pt1 "\nChon diem phia ngon mui ten: ")
	  )
(mapcar 'setvar lst_va '(0 0 3))
(if (and ss pt1 pt2)
	(progn
		(MAKELINE pt1 pt2 nil nil nil nil nil)	  
		(setq ent1 (entlast))
		(foreach elem (ss2lst ss)
			(setq lst1 (acet-geom-intersectwith ent1 elem 1)
				  pt (car (vl-sort lst1 '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
				  lst_pt (cons pt lst_pt))
			(command "-insert" "mui_ten_hiep" "S" 20 "R" (angle pt1 pt2) pt)
			)	;for
		(setq lst_pt (vl-sort lst_pt '(lambda (x y) (> (distance pt1 x) (distance pt1 y)))))
		(entmod (subst (cons 11 (car lst_pt)) (assoc 11 (setq info (entget ent1))) info))
		)
	(princ "\n*** Dau vao chu hop ly ***")
)	;if
(mapcar 'setvar lst_va old)
(setvar 'clayer lay)
(princ)
)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)))
)
;===================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
	(setq ename (ssname ss i)
		  i (1+ i)
		  lst (cons ename lst))
)
(reverse lst)
)
;================================
(defun MakeLayer (name color linetype lineWeight plot)	
(entmakex (list '(0 . "LAYER")								 
				(cons 100 "AcDbSymbolTableRecord")								 
				(cons 100 "AcDbLayerTableRecord")								 
				(cons 2 name)								 
				(cons 70 0)								 
				(cons 62 (if color color 7))								 
				(cons 6 (if linetype linetype "Continuous"))								 
				(cons 290 (if plot 1 0))								 
				(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))))
)

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
hiepttr    523

Như thế thì phải báo lỗi unknown acet... chứ Nhóc hè ^ ^

Mặc kệ, mình text ổn là đc :D :D :D

Việc đó lần sau đủ nội lưc quay lại chiế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
cdhn    0

không chạy được trên cad 2015 là do máy em bác ak  :)

bác hiepttr có thể fix lại cho em ít nữa được không

+ đường mũi tên có thể nhân với tỷ lệ mà mình chọn

arrow size =1.5 x tỷ lệ.

- vì có nhiều khung view port có nhiều tỷ lệ khác nhau nên muốn các mũi tên nó bằng nhau thì đẹp hơn bác ak.

thanks bác nhiề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
hiepttr    523

Đây bạn:

 

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old lay lay_thep ss pt1 pt2 tl ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(if (not(tblsearch "layer" "DONG_MAU_DO")) (MakeLayer "DONG_MAU_DO" 1 nil nil T))
(setq lay (getvar 'clayer))
(setvar 'clayer "DONG_MAU_DO")
;=================
(cond ((not(tblsearch "block" "mui_ten_hiep"))
			(entmake (list
							'(0 . "TRACE")
							'(100 . "AcDbEntity") 
							;(cons 8 "0")
							'(100 . "AcDbTrace") 
							'(10 0 0 0) 
							'(11 0 0 0) 
							'(12 -2.5 -0.5 0) 
							'(13 -2.5 0.5 0)
							)
			)
			(command "-block" "mui_ten_hiep" '(0 0 0) (entlast) "")
			))
;=================
(setq lay_thep (assoc 8 (entget (car (entsel "\nChon thanh thep mau: ")))))
(prompt "\nChon cac thanh thep can ghi chu thich !")
(setq ss (ssget (append '((0 . "LINE,LWPOLYLINE")) (list lay_thep)))
	  pt1 (getpoint "\nXac dinh 2 diem tren duong dong ghi chu !\nChon diem goc: ")
	  pt2 (getpoint pt1 "\nChon diem phia ngon mui ten: ")
	  )
(mapcar 'setvar lst_va '(0 0 3))
(setq #tl# (NGT #tl# 1 getreal "Nhap ti le "))
(if (and ss pt1 pt2 #tl#)
	(progn
		(MAKELINE pt1 pt2 nil nil nil nil nil)	  
		(setq ent1 (entlast))
		(foreach elem (ss2lst ss)
			(setq lst1 (acet-geom-intersectwith ent1 elem 1)
				  pt (car (vl-sort lst1 '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
				  lst_pt (cons pt lst_pt))
			(command "-insert" "mui_ten_hiep" "S" (* 1.5 #tl#) "R" (angle pt1 pt2) pt)
			)	;for
		(setq lst_pt (vl-sort lst_pt '(lambda (x y) (> (distance pt1 x) (distance pt1 y)))))
		(entmod (subst (cons 11 (car lst_pt)) (assoc 11 (setq info (entget ent1))) info))
		)
	(princ "\n*** Dau vao chu hop ly ***")
)	;if
(mapcar 'setvar lst_va old)
(setvar 'clayer lay)
(princ)
)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)))
)
;===================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
	(setq ename (ssname ss i)
		  i (1+ i)
		  lst (cons ename lst))
)
(reverse lst)
)
;================================
(defun MakeLayer (name color linetype lineWeight plot)	
(entmakex (list '(0 . "LAYER")								 
				(cons 100 "AcDbSymbolTableRecord")								 
				(cons 100 "AcDbLayerTableRecord")								 
				(cons 2 name)								 
				(cons 70 0)								 
				(cons 62 (if color color 7))								 
				(cons 6 (if linetype linetype "Continuous"))								 
				(cons 290 (if plot 1 0))								 
				(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))))
)
;=================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)

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
ketxu    2.653

Mới đọc lisp bạn hiepttr. Bravo

Có 2 hàm có sẵn, post để bạn làm tham khảo :

(defun _insert(name p s r)
;Insert simple static block
;Ten  point scale rotation
(entmake
	(list
		'(0 . "INSERT")      
		(cons 2 name)
		(cons 10 p)
		(cons 41 s)(cons 42 s)(cons 43 s)      
		(cons 50 r)
	); list
)
)
(defun ST:Geom-Inters (obj1 obj2 mode)
    ;; Return list of intersection(s) between two objects
    ;; obj1 - first VLA-Object
    ;; obj2 - second VLA-Object
    ;; mode - intersection mode (acExtendNone acExtendThisEntity acExtendOtherEntity acExtendBoth)
	;;or 0 1 2 3 is OK    
    ((lambda (foo) (foo (vlax-invoke obj1 'IntersectWith obj2 mode)))
      (lambda (l)
        (if (cddr l)
          (cons (list (car l) (cadr l) (caddr l)) (foo (cdddr l)))
        )
      )
    )
  )
  
 

 

- Các hàm make chắc bạn lấy trong topic của a thaistreetz, phong cách code rất quen :)

 Nếu là mình các đoạn (if LTScale LTScale 1) => (cond (LTScale) (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
hiepttr    523

- Đúng là mình "tận dụng triệt để" các hàm của bác Thaistreetz ^ ^ :D

- Hai cái bảo bối Ket cho, cái trên mình hiểu

Còn cái dưới sao mà kho tiêu thế ??? Két có thể mổ xẻ đôi chút ko ?!

Thanks !

 

p/s:

(vlax-invoke obj1 'IntersectWith obj2 mode) >>> OK

(if (cddr l)
(cons (list (car l) (cadr l) (caddr l)) >>> OK

 

Còn phần khác thì bó chiếu :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
ketxu    2.653

Đây là hàm đệ quy thôi. Nếu viết như thế này chắc hiepttr sẽ dễ đọc hơn :

(defun ST:Geom-Inters(e1 e2 mode / _spit)	  
	(defun _split(l)(if (cddr l)(cons (list (car l) (cadr l) (caddr l)) (_split (cdddr l)))))
	(_split (vlax-invoke e1 'IntersectWith e2 mode))
)

Trong đó, đoạn

(lambda (l)
        (if (cddr l)
          (cons (list (car l) (cadr l) (caddr l)) (foo (cdddr l)))
        )
      )

tương đương với định nghĩa hàm _split - chia list thành cặp 3 phần tử (ở đây tên của hàm này được đặt luôn là foo nhờ khai báo ở lambda đầu tiên)

 

- Đoạn

((lambda (foo) (foo (vlax-invoke obj1 'IntersectWith obj2 mode)))  ...)

tương đương với việc thực hiện hàm foo với danh sách lấy được từ vlax-invoke.

Chú ý thủ thuật vừa định nghĩa hàm vừa thực thi hàm đó luôn. Ví dụ :

((lambda(x)(1+ x)) 2)

- Trong đoạn code trên thì vừa định nghĩa hàm _split, vừa thực thi nó luôn, và lồng vào nhau nên bạn thấy khó hơn thô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
cdhn    0

cám ơn mọi người đã quan tâm;

hiêpttr: sao mình không chạy được code vậy nhỉ. làm xong tất cả các bước nó không hiện gì hết.

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
cdhn    0

hiepttr ơi nó toàn báo "  *** Dau vao chu hop ly *** ". nhập kiểu gì cũng vậy ak.

 

Select objects:
Xac dinh 2 diem tren duong dong ghi chu !
Chon diem goc:
Chon diem phia ngon mui ten:
Nhap ti le  <1>: 30
 
 
Select objects:
Xac dinh 2 diem tren duong dong ghi chu !
Chon diem goc:
Chon diem phia ngon mui ten:
Nhap ti le  <1>: 30
 
 
Select objects:
Xac dinh 2 diem tren duong dong ghi chu !
Chon diem goc:
Chon diem phia ngon mui ten:
Nhap ti le  <1>: 30
 
 
Select objects:
Xac dinh 2 diem tren duong dong ghi chu !
Chon diem goc:
Chon diem phia ngon mui ten:
Nhap ti le  <1>: 30
 
 
Select objects:
Xac dinh 2 diem tren duong dong ghi chu !
Chon diem goc:
Chon diem phia ngon mui ten:
Nhap ti le  <1>: 30
 
 
Select objects:
Xac dinh 2 diem tren duong dong ghi chu !
Chon diem goc:
Chon diem phia ngon mui ten:
Nhap ti le  <1>: 30
 
 
Select objects:
Xac dinh 2 diem tren duong dong ghi chu !
Chon diem goc:
Chon diem phia ngon mui ten:
Nhap ti le  <1>: 30
 
 
Select objects:
Xac dinh 2 diem tren duong dong ghi chu !
Chon diem goc:
Chon diem phia ngon mui ten:
Nhap ti le  <1>: 30
 
 
Select objects:
Xac dinh 2 diem tren duong dong ghi chu !
Chon diem goc:
Chon diem phia ngon mui ten:
Nhap ti le  <1>: 30

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
hiepttr    523

Sorry cdhn !

 

Mấy hôm nay do mình phải nhảy như sóc trong công việc & việc học lisp nên không chú tâm lắm trong code

 

Nên mình bỏ sót mất trường hợp khi bản vẽ đã bị thay đổi UCS (không còn là World), hoặc khi đường dóng không cắt thanh thép

 

Dẫn đến các sai sót về tọa đọ điểm ... >>> kết quả là các lỗi mà bạn đã nêu trên.

 

Nay mình test lại, đã phát hiện lỗi & fix dưới đây:

 

p/s: Nếu bạn chạy lisp trên bản vẽ bạn đã từng chạy nó mà vẫn xảy ra lỗi (ko thấy có mũi tên - chính xác là mũi tên insert ko đúng vị trí) thì tìm và xóa hết block có tên "mui_ten_hiep" >>> dùng lệnh PU để xóa block này rồi chạy lại lisp nhé !

;lisp ve mui ten ghi chu thep
(defun c:MT( / temperr errorTrap lst_va old lay lay_thep ss pt1 pt2 tl ent1 pt lst_pt)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (if old (mapcar 'setvar lst_va old))
	(if lay (setvar 'clayer lay))
	(cond
		((tblsearch "ucs" "save_ucs") 
			(command "ucs" "na" "r" "save_ucs")
			(command "ucs" "na" "d" "save_ucs")
			)
	)
    (setq *error* temperr)
	(princ "\n*** Da set lai bien, OK ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(if (not(tblsearch "layer" "DONG_MAU_DO")) (MakeLayer "DONG_MAU_DO" 1 nil nil T))
(setq lay (getvar 'clayer))
(setvar 'clayer "DONG_MAU_DO")
;=================
(command "ucs" "na" "s" "save_ucs")
(command "ucs" "w")
(cond ((not(tblsearch "block" "mui_ten_hiep"))
			(entmake (list
							'(0 . "TRACE")
							'(100 . "AcDbEntity") 
							;(cons 8 "0")
							'(100 . "AcDbTrace") 
							'(10 0 0 0) 
							'(11 0 0 0) 
							'(12 -2.5 -0.5 0) 
							'(13 -2.5 0.5 0)
							)
			)
			(command "-block" "mui_ten_hiep" '(0 0 0) (entlast) "")
			))
;=================
(setq lay_thep (assoc 8 (entget (car (entsel "\nChon thanh thep mau: ")))))
(prompt "\nChon cac thanh thep can ghi chu thich !")
(setq ss (ssget (append '((0 . "LINE,LWPOLYLINE")) (list lay_thep)))
	  pt1 (getpoint "\nXac dinh 2 diem tren duong dong ghi chu !\nChon diem goc: ")
	  pt2 (getpoint pt1 "\nChon diem phia ngon mui ten: ")
	  )
(mapcar 'setvar lst_va '(0 0 3))
(setq #tl# (NGT #tl# 1.0 getreal "Nhap ti le "))
(if (and ss pt1 pt2 #tl#)
	(progn
		(MAKELINE pt1 pt2 nil nil nil nil nil)	  
		(setq ent1 (entlast))
		(foreach elem (ss2lst ss)
			(setq lst1 (acet-geom-intersectwith ent1 elem 3)
				  pt (car (vl-sort lst1 '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
				  lst_pt (cons pt lst_pt))
			(command "-insert" "mui_ten_hiep" "S" (* 1.5 #tl#) "R" (angle pt1 pt2) pt)
			)	;for
		(setq lst_pt (vl-sort lst_pt '(lambda (x y) (> (distance pt1 x) (distance pt1 y)))))
		(entmod (subst (cons 11 (car lst_pt)) (assoc 11 (setq info (entget ent1))) info))
		)
	(princ "\n*** Dau vao chu hop ly ***")
)	;if
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
(setq *error* temperr)
(setvar 'clayer lay)
(mapcar 'setvar lst_va old)
(princ)
)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)))
)
;===================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
	(setq ename (ssname ss i)
		  i (1+ i)
		  lst (cons ename lst))
)
(reverse lst)
)
;================================
(defun MakeLayer (name color linetype lineWeight plot)	
(entmakex (list '(0 . "LAYER")								 
				(cons 100 "AcDbSymbolTableRecord")								 
				(cons 100 "AcDbLayerTableRecord")								 
				(cons 2 name)								 
				(cons 70 0)								 
				(cons 62 (if color color 7))								 
				(cons 6 (if linetype linetype "Continuous"))								 
				(cons 290 (if plot 1 0))								 
				(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))))
)
;=================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)

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


×