Đến nội dung


Hình ảnh
- - - - -

Listp bảng tọa độ vn2000


  • Please log in to reply
86 replies to this topic

#81 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 22 October 2014 - 10:52 AM

Nhìn video của nhoc mới nhớ ra đã viết 1 cái na ná từ lâu tặng bác thanhduan247 rồi. Ở đây này . Code vẫn luộm thuộm, nhưng được cái làm với boundary xiên vẹo đủ hình, thêm được cái toạ độ toạ đủng. K thuộc chuyên ngành nên k nhớ yêu cầu lắm, nhoclangbat thử ngó xem có lấy được gì không. Code vẫn vẽ từng thằng, nhoc thích thì cho vào vòng lặp mà quét nhé

Hê hê. Từ năm 2011 rùi. Lâu phết rùi ấy nhở?

Vậy mà em vẫn mò được Topic này. ^^

Ngày ấy có 2 cao thủ trợ giúp. Mình lúc ấy gà mờ. Chả biết viết cái gì. :)

Thanks Ketxu 1 lần nữa nhé!

P/s: Klq, cơ mà tình yêu tình báo đến đâu rồi, cưới đê, chả có nhẽ đợi anh lấy vợ trước à?  :wub:


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#82 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 October 2014 - 10:55 AM

E search mấy chữ vẽ mắt lưới thôi ^^
P/s : klq, nhưng e vẫn chưa có gì đặc sắc :)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#83 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 22 October 2014 - 10:59 AM

Thôi, ko hỏi han linh tinh nữa.

:)


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#84 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 23 October 2014 - 08:14 PM

-^^ nói đến chuyên môn thì nhoc còn phải mót nhiều, do hoàn cảnh, tính chất công việc hiện tai của nhoc , mỗi người 1 hoàn cảnh 1 lời khó mà nói hết a ah, chủ yếu là vì nhoc thích tìm tòi ^^, mỗi lần viết thấy vui, tương lai thế nào chưa rõ, cố đc đến đâu hay đến đó.

- Clip anh nhoc xem trước đó rùi ^^, cách biên tập của a nó không giống bên nhoc, bên nhoc nhoc cũng có vài công trình dạng tuyến chỉ rãi lưới đơn giản khổ giấy lớn hơn

- mục đích nhoc thử làm lsp này để hỗ trợ cho chương trình sẵn của cơ quan, nhưng có nhiều khi mình mún xử lý độc lập, còn chương trình nó hay ràng buộc theo nhiều cái khác khó xử lý tính huống nhanh^^

- nhoc ko giỏi hơn anh đâu ^^, nhoc chậm tiu lắm, chỉ cố gắng hết theo sức mình có

- nhoc có xem qua lsp tạo lưới của a, nhưng nó còn hơi cao với nhoc, nhìn lsp của nhoc đơn giản thui, nhưng mất đến 2 ngày nhoc mới làm xong kaka

;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 pt3 pt4 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))
;===================================*******************++++++++++++++++++++********************===================================  
(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 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))
;==============================================================================
(cond 
((and (>= (/ kcx 100) 2) (>= (/ kcy 100) 2))
;==========================================================
(setq nx (fix (/ kcx 100)) ny (fix (/ kcy 100)))
(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 (cdr (assoc 1 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 (cdr (assoc 1 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 (cdr (assoc 1 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 1 donvi))))
  )
;============================================================
) ;end 100


;========================================================++++++++++**************+++++++++=======================================================
((and (>= (/ kcx 50) 2) (>= (/ kcy 50) 2))
;==========================================================
(setq nx (fix (/ kcx 50)) ny (fix (/ kcy 50)))
(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 (cdr (assoc 2 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 (cdr (assoc 2 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 (cdr (assoc 2 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 2 donvi))))
  )
;============================================================
) ;end 50
;============================================================******++++++++++++++++++++****************++++++++++++++++++++========================
((and (>= (/ kcx 25) 2) (>= (/ kcy 25) 2))
;==========================================================
(setq nx (fix (/ kcx 25)) ny (fix (/ kcy 25)))
(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 (cdr (assoc 3 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 (cdr (assoc 3 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 (cdr (assoc 3 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 3 donvi))))
  )
;============================================================
) ;end  25
;==================================================*********************++++++++++++++++++++*************===========================
((and (< (/ kcx 25) 2) (< (/ kcy 25) 2))
(alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^")) ; end nho hon 25
) ;end cond
;==================================================================++++++++++**************+++++++++=======================================
) ;end progn of while pt1 pt2
) ; 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
    )  
  )
 ) 

Trong lsp kkl có thông báo

(alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^"))

vậy khung KiBo là gì vậy bạn ? Có thể cho mình một khung với.

 


  • 0

#85 nhoclangbac

nhoclangbac

    biết vẽ circle

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

Đã gửi 23 October 2014 - 08:46 PM

Hôm nay nhoc mệt trong người... Mai nhoc tỉnh táo sẽ trả lời :(


  • -1

#86 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 23 October 2014 - 09:03 PM

- @@ sao lại có vụ ngộ nhận danh tính ở đây nhỉ ^^, ôi "t" với "c"

- khung Kibi đó nghĩa là, khung nhỏ hơn khoảng cách mắt lưới tối thiểu tạo phải từ 2 mắt trở lên, ở đây nhoc set nhỏ nhất là 25, nếu kich thước khung chia cho 25 nhỏ hơn 2 thì nó ko tạo mắt lưới đc ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#87 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 24 October 2014 - 07:38 AM

Mình không hiểu sao thể hiện vẽ ra lưới khung lạ quá. không thể hiện hết theo điểm đầu và cuối vậy bạn


  • 0