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

tientracdia

Thành viên
  • Số lượng nội dung

    145
  • Đã tham gia

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

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


  1. Hề hề hề,

    Dùng thử cái này coi sao. Nếu chưa ưng ý thì hãy so sánh nó với cái lisp lần trước mình sửa để thấy được những sự khác sau giữa 2 lisp. Từ đó suy luận ra cách sửa để làm cho nó phù hợp với yêu cầu của bạn, Trong quá trình tự sửa nếu có gì trục trặc thì post lên mình sẽ hướng dẫn . 

    Chúc thành công.

    http://www.4shared.com/file/CU6lwHnnce/kh__1_.htmlch

     

    Nhờ bạn chỉnh giúp vẽ khung trong và ngoài cách nhau 10 theo các tỷ lệ.


  2.  

    Thêm STT đây!

    (defun c:pt (/ p lst fn pw n)
     (while (setq p (getpoint "\nPick Point: "))
      (setq lst (cons p lst)))
     (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
     (setq pw (open fn "w"))
     (setq n 1)
     (write-line "STT,Y,X" pw)
     (foreach p (reverse lst)
      (write-line (strcat (itoa n) "," (rtos (cadr p) 2 2) "," (rtos (car p) 2 2)) pw)
      (setq n (1+ n)))
     (close pw)
     (princ))
    

    Nhờ anh chỉnh thêm kí hiệu nút tại điểm chọn, ghi số Thứ tự, xuất ra bảng trên cad va excel. Cám ơn


  3. Mình có liisp sưu tầm được mục đích chọn vào vùng tâm thửa chỉ ra điểm chèn, mình muốn thêm tên cạch vào bảng

    (defun c:HSKT2( / ss lst fn fid lstEn)
    (vl-load-com)
    (command "-purge" "a" "" "N")
    (command "attdisp" "ON")
      (styf)
      (Setq Tlebd (LM:GetXWithDefault getreal "\n Nhap ty le ban do: " '*Tlebd* (atof "1000")))
      (setq TLE (/ Tlebd 1000))
      (progn
    	(setvar "hpgaptol" 0.5)
    	(setq Olmode (getvar "OSMODE"))
    	(setvar "OSMODE" 0)
    	
    	(setq Clor (getvar "CECOLOR"))
    	(setq pt (getpoint "\n Pick diem trong vung can trich thua :"))
    	(vl-cmdf  "-boundary" pt "")
            (setq Elast1 (entlast))
        	(dch (entget Elast1))
        	(setq Elast (entlast))
      	(setq en Elast
          	      ob (vlax-ename->vla-object  en)
                   n (vlax-curve-getEndParam ob)
                   i 0
            )
      	(setq Pd (vlax-curve-getPointAtParam ob 0)
    	      Pc (vlax-curve-getPointAtParam ob n)
    	     KCC (rtos (distance Pd Pc) 2 2)
    	)
      	(setq P1dau (vlax-curve-getPointAtParam ob 0))
    	(setq Xdau (rtos (car P1dau) 2 2))
      	(setq Ydau (rtos (cadr P1dau) 2 2))
      
      	(setq P_ddat (getpoint "\n Chon diem dat: "))
      	(setq P_a1 (polar P_ddat 0 (* TLE 207.0)))		; chieu dai rong khung
      	(setq P1 (polar P_a1 (/ pi 2) (* TLE 124.3)))
    
        
      	(command "insert" "HSKT" P_ddat TLE TLE  0 (rtos (Area Elast)  2 2) (rtos Tlebd  2 0)) ;; chen khung, dtich, ti le
      	(setq P2  (polar P1 0 (* TLE 20.0)))
      	(setq P3  (polar P1 0 (* Tle 43.0)))
      	(setq P4a (polar P1 0 (* TLE 62.0)))
      	(setq P4 (polar P4a (DTR 270) (* TLE 2.5)))
    	;;
    	(setq P5a (polar P1 0 (* TLE 82.0)))
      	(setq P5 (polar P5a (DTR 270) (* TLE 2.5)))
    	;;
      	(setq P1DD (polar P1 (DTR 270) (* n (* TLE 5.0))))
      	(setq P2DD (polar P2 (DTR 270) (* n (* TLE 5.0))))
      	(setq P3DD (polar P3 (DTR 270) (* n (* TLE 5.0))))
      
      	(MakeText P1DD (rtos 1 2 0) (* TLE 2.5) 0 "C")
      	(MakeText P2DD Xdau         (* TLE 2.5) 0 "C")
      	(MakeText P3DD Ydau         (* TLE 2.5) 0 "C")
      	
    	(while (< i n)
    		(setq p (vlax-curve-getPointAtParam ob i))
    	  	(setq p_2 (vlax-curve-getPointAtParam ob (+ i 1)))
    		(setq X (rtos (car P) 2 2))
    	  	(setq Y (rtos (cadr P) 2 2))
    		
    		;(setq TE ((vlax-curve-getPointAtParam ob i) "  -  " (vlax-curve-getPointAtParam ob (+ i 1))));;
    	  	(setq KC (rtos (distance P P_2) 2 2))
    		;;
    		
    		;;
    	  	(setq P1_i (Polar P1 (DTR 270) (* i (* TLE 5.0))))
    	  	(setq P2_i (Polar P2 (DTR 270) (* i (* TLE 5.0))))
    	  	(setq P3_i (Polar P3 (DTR 270) (* i (* TLE 5.0))))
    	  	(setq P4_i (Polar P4 (DTR 270) (* i (* TLE 5.0))))
    	  	;;
    		(setq P5_i (Polar P5 (DTR 270) (* i (* TLE 5.0))));;
    		;;
    	  	(MakeText P1_i (rtos (+ i 1) 2 0) (* TLE 2.5) 0 "C")	; viet stt
    	  	(MakeText P2_i X (* TLE 2.5) 0 "C")						; viet tdo x
    	  	(MakeText P3_i Y (* TLE 2.5) 0 "C")						; viet tdo y
    		(MakeText P4_i (rtos (+ i 1) 2 0) (* TLE 2.5) 0 "C")	; viet stt
    		(MakeText P5_i KC (* TLE 2.5) 0 "C")					; viet khoang cach
    		
    		(setq i (1+ i))											; lap lai cac diem
    	)
    )
    ;(setq P_a2 (polar P_ddat 0 (* TLE 138.3)))
    (setq P_a2 (polar P_ddat 0 (* TLE 138.3)))				;; vi tri cat thua
    (setq Pnt1 (polar P_a2 (/ pi 2) (* TLE 94.5)))
    (command "copy" Elast "" (mid Elast) Pnt1 "")
    (GKT Pnt1 TLE )
    
    
    (setvar "OSMODE" Olmode)
    (princ)
    )
    ;;--------------------------------------------------------
    (defun GKT (Pt TLE / lst fn fid lstEn);Ghi kich thuoc
    (vl-load-com)
    	(setvar "hpgaptol" 0.5)
    	(setq Olmode (getvar "OSMODE"))
    	(setvar "OSMODE" 0)
    	(setq Clor (getvar "CECOLOR"))
    	(vl-cmdf  "-boundary" Pt "")
            (setq Elast (entlast))
      	(dch (entget Elast))
      	(setq en Elast
          	      ob (vlax-ename->vla-object  en)
                   n (vlax-curve-getEndParam ob)
                   i 0
            )
      	
    	(while (< i n)
    		(setq P (vlax-curve-getPointAtParam ob i))
    	  	(command "insert" "tron" p TLE TLE 0)			; chen diem vong tron
    	  	(setq P_2 (vlax-curve-getPointAtParam ob (+ i 1)))
    	  	(setq goc (angle P P_2))
    	  	(setq KC_i  (distance P P_2) )
    	  	(setq DG_i (polar P goc (/ KC_i 2)))
    	  	(setq Pii (polar P (/ pi 2) (* TLE 2)))
    	  	(MakeText Pii (rtos (+ i 1) 2 0) (* TLE 2.5) 0 "C")
    	  	(setq PVi (Atan2 P P_2))
    	  	(if (< (Rad_to_Do PVi) 180)
    		  (progn
    		    (setq PG_ia (polar DG_i (+ (/ pi 2) goc) 1.0))
    	  	    (MakeText PG_ia (rtos KC_i 2 2) (* TLE 2.5) goc "C")
    		  )
    		  (progn
    		    (setq PG_ib (polar DG_i (+ (/ pi 2) (angle P_2 P)) 1.0))
    		    (MakeText PG_ib (rtos KC_i 2 2) (* TLE 2.5)  (angle P_2 P) "C")
    		  )
    		)
    		(setq i (1+ i))
    	)
    (MakeText (mid Elast) (rtos (Area Elast)  2 2)  (* TLE 2.5)  0 "C")	; viet dtich tren thua cat
    (entdel Elast)
    (setvar "OSMODE" Olmode)
    ;;;(princ )
    )
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (defun Area (ent)
    (setvar "hpgaptol" 0.1)
    (vla-get-area (vlax-ename->vla-object ent))
    )
    ;;-----------
    (defun mid (ent / p1 p2)
    	(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
    	(setq p1 (vlax-safearray->list p1)
    				p2 (vlax-safearray->list p2)
    				pt (mapcar '+ p1 p2)
    				pt (mapcar '* pt '(0.5 0.5 0.5))
    	)
    	pt
    )
    ;;--------
    (defun wtxt_l(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
    (setq    sty (getvar "textstyle")    
    d (tblsearch "style" sty)    
    h1 (cdr (assoc 40 d))    
    h2 (cdr (assoc 42 d))    
    wf (cdr (assoc 41 d)))
    (if (> h1 0) (setq h h1) (setq h h2))
    (entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p)(cons 62 4) (cons 1 txt) (cons 10 p)))
    )
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    
    (defun TD:Text-Base (ent)
      (setq Ma10  (cdr (assoc 10 (entget ent))))
      (setq Ma11  (cdr (assoc 11 (entget ent))))
      (setq X11 (car Ma11))
      (setq Ma71  (cdr (assoc 71 (entget ent))))
      (setq Ma72  (cdr (assoc 72 (entget ent))))
      (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
    	  (and (= Ma71 0) (= Ma72 3) )
    	  (and (= Ma71 0) (= Ma72 5) )
          )
        Ma10
        Ma11
       )
    )
    
    (defun DTR (Do / radian)
       (setq radian  (/ (* Do pi ) 180))
    )
    (defun LM:GetXWithDefault ( _function _prompt _symbol _default / _toString )
    	(setq _toString
    		(lambda ( x )
    			(cond
    				( (eq getangle _function) (angtos x) )
    				( (eq 'REAL (type x)) (rtos x) )
    				( (eq 'INT (type x)) (itoa x) )
    				( x )
    			)
    		)
    	)
    
    	(set _symbol
    	(
    	(lambda ( input ) (if (or (not input) (eq "" input)) (eval _symbol) input))
    	(_function (strcat _prompt "<" (_toString (set _symbol (cond ( (eval _symbol) ) ( _default )))) "> : "))
    	)
    	)
    )
    
    (defun MakeText (point string Height Ang justify     / Lst); Ang: Radial
    	(setq Lst (list '(0 . "TEXT")
    			(cons 8 (if Layer Layer (getvar "Clayer")))
    			(cons 62 (if Color Color 256))
    			(cons 10 point)
    			(cons 40 Height)
    			(cons 1 string)
    			(cons 50 Ang)
    		)
    	justify (strcase justify)
          )
          (cond ((= 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)))))
    			((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
    			((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
    			((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))	
    			((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
    			((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
    			((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
    			((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
    			((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
    			((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
          )
         (entmakex Lst)
     )
    
    
    ;revlwpl
    (defun dch (ent / eo el len)
    (vl-load-com)
    (setq eo ent)
    (setq el (list(assoc 210 ent)))
    (while (member (assoc 10 ent) ent)
      (if (= 0.0 (assoc 42 ent))
    (setq el (cons (assoc 42 ent) el))
    (setq el (cons (cons 42 (- (cdr (assoc 42 ent)))) el))
      )
      (setq el (cons (assoc 41 ent) el))
      (setq el (cons (assoc 40 ent) el))
      (setq el (cons (assoc 10 ent) el))
      (setq ent (member (assoc 10 ent) ent))
      (setq ent (cdr ent))
    )
    (setq len(- (LENGTH eo) (LENGTH (member (assoc 10 eo) eo)) 1))
    (while (>= len 0)
      (setq el (cons (nth len eo) el))
      (setq len (- len 1))
    )
    (setq ent el)
    (entmod ent)
    (princ)
    )
    
    (defun Rad_to_Do(radian / Do)
       (setq Do (/ (* radian 180) pi))
    )
    (defun Do_to_Radian (Do / radian)
       (setq radian  (/ (* Do pi ) 180))
    )
    (defun R2DPG (gocR / DPG Toando Do Phut1 Phut Giay DPG)
      (setq DPG (list))
      (setq Toando (Rad_to_Do gocR))
      (setq Do (fix Toando))
      (setq Phut1  (* (- Toando Do) 60))
      (setq Phut (fix Phut1))
      (setq Giay   (atof (rtos (* (- phut1 phut) 60) 2 3)))
      (setq DPG (list Do  Phut giay))
      DPG
    )
    (defun DPG_to_DO (Goc)
    (setq DD (nth 0 Goc))
    (setq PP (/ (nth 1 Goc) 60))
    (setq GG (/ (nth 2 Goc) 3600))
    (setq DDD (+ DD PP GG))
    DDD
    )
    (defun Dogoc2diem (P1 P2 /)
      (setq gocP12 (angle P1 P2))
      (setq gocP12_DPG (R2DPG gocP12))
      (setq Goc_12 (DPG_to_DO gocP12_DPG))
      Goc_12
    )
    (defun Do_to_DPG (Toando /)
      (setq Do (fix Toando))
      (setq Phut1 (* (- Toando Do) 60))
      (setq Phut (fix Phut1))
      (setq Giay   (atof (rtos (* (- phut1 phut) 60) 2 3)))
      (setq DPG (list Do  Phut giay))
      DPG
    )
    
    (defun Atan2 (P1 P2 / gocAtan b)
      (setq dx ( - (car P2) (car P1)))
      (setq dy ( - (cadr P2) (cadr P1)))
      (setq gocAtan (list))
      (cond
        ((and (= dx 0) (> dy 0) )
          (setq gocAtan 0)
        )
        ((and (= dx 0) (< dy 0) )
          (setq gocAtan pi)
        )
        ((and  (< dx 0) (= dy 0) )
          (setq gocAtan (/ (* 3 pi) 2))
        )
        ((and  (> dx 0) (= dy 0) )
          (setq gocAtan pi)
        )
        ((and  (= dx 0) (= dy 0) )
          (setq gocAtan 0)
        )
        ((/= dx 0)
         (progn
    	(setq b (atan (/ dx dy)))
    	(cond
    	    ((and (> dx 0) (>= dy 0))
    		  (setq gocAtan b)
    	    )
    	    ((and (< dx 0) (> dy 0))
    		  (setq gocAtan (+ (* pi 2) b))
    	    )
    	    ((and (< dx 0) (< dy 0))
    		  (setq gocAtan (+ pi b))
    	    )
    	    ((and (> dx 0) (< dy 0))
    	          (setq gocAtan (+ pi b))
    	    )
    	)
          )
        )  
      )
      gocAtan
    )
    (defun styf (/ Oldtstyle Sttxt Userfont *error*)
      (defun *error* (s)
        (setvar "textstyle" oldtstyle)
      )
      (setq oldtstyle (getvar "textstyle"))
      (setq userfont "Times New Roman") 
      (setvar "textstyle" (cdr (assoc 2 (tblnext "style" T))))
      (command "._Style" "" userfont 2 1 0 "N" "N")
      (while
        (setq sttxt (cdr (assoc 2 (tblnext "style"))))
         (setvar "textstyle" sttxt)
         (command "._Style" "" userfont 2 1 0 "N" "N")
      )
      (setvar "textstyle" oldtstyle)
    )
    
    
    (defun daochieu (ss / count lwp ent obj oname sss revlwpl revln)
      (vl-load-com)
      (defun revlwpl(/ eo el len)
    	(setq eo ent)
    	(setq el (list(assoc 210 ent)))
    	(while (member (assoc 10 ent) ent)
    	  (if (= 0.0 (assoc 42 ent))
       (setq el (cons (assoc 42 ent) el))
       (setq el (cons (cons 42 (- (cdr (assoc 42 ent)))) el))
    	  )
    	  (setq el (cons (assoc 41 ent) el))
    	  (setq el (cons (assoc 40 ent) el))
    	  (setq el (cons (assoc 10 ent) el))
    	  (setq ent (member (assoc 10 ent) ent))
    	  (setq ent (cdr ent))
    	)
    	(setq len(- (LENGTH eo) (LENGTH (member (assoc 10 eo) eo)) 1))
    	(while (>= len 0)
    	  (setq el (cons (nth len eo) el))
    	  (setq len (- len 1))
    	)
    	(setq ent el)
    	(entmod ent)
      )
      (defun revln (/ pt1 pt2)
    	(setq pt1 (cons 10 (cdr (assoc 11 ent))))
    	(setq pt2 (cons 11 (cdr (assoc 10 ent))))
    	(setq ent (subst pt1 (assoc 10 ent) ent))
    	(setq ent (subst pt2 (assoc 11 ent) ent))
    	(entmod ent)
      )
    	 
    ;;;  (princ "\nSelect Lines & Polylines to reverse direction of:   ")
    ;;;  (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE,LINE"))))
      (setvar "CMDECHO" 0)
      (command "._UNDO" "_BEgin")
      (if ss
    	(progn
    	  (setq count 0 lwp 0)
    	  (while (> (sslength ss) count)
    		(setq ent (ENTGET (ssname ss count))
    				  obj (vlax-ename->vla-object (ssname ss count))
    				  oname (vlax-get-property obj 'ObjectName)
    		)
    		(cond
    		  ((= oname "AcDb3dPolyline")(setq lwp(+ 1 lwp)))
    		  ((= (cdadr ent) "LWPOLYLINE")(revlwpl))
    		  ((= (cdadr ent) "POLYLINE")
    			(progn
    			  (setq sss (ssadd (ssname ss count)))
    			  (vl-cmdf "convertpoly" "Light" sss "")
    			  (setq ent (ENTGET (ssname sss 0)))
    			  (revlwpl)
    			)
    		  )
    		  ((= (cdadr ent) "LINE")(revln))
    		)
    		(setq count (+ count 1))
    	  )
    	)
      )
      (command "._UNDO" "_End")
      (if(> lwp 0)
    	(if(> lwp 1)
    	  (princ(strcat "\nCould not reverse " (itoa lwp) " 3dPolylines."))
    	  (princ"\nCould not reverse the 3dPolyline.")
    	)
      )
      (princ)
    )
    

    Nhưng xuất ra chỉ có một số thứ tụ, mình có file cad yêu cầu theo đó.

    Mong được các bạn giúp

    http://www.cadviet.com/upfiles/4/114381_hskt.rar


  4.  

    -^^ 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.

     


  5. À cái này hay quá. Cám ơn Bạn đã nhiệt tình giúp. diện tích lấy theo đơn vị m đi bạn. Số diện tich bạn giúp xuất ra ở cột số 9 trên eccxel giúp mình, nếu các số đỉnh không đủ thì kệ nó.

    Có giải pháp nào mình chọn một lần hết các ô không bạn ?? Liisp  Nhận biết đa giác đó, Xuất tên ô trong khung và số từng đỉnh ra hàng sang ecxel.

    Mong bạn giúp


  6. Ô hay, vậy thì có giải pháp rồi.

    về nguyên tắc mình muốn tìm các số gần đỉnh của các đa giác ( nằm trong ngoài tùy ý ) của ô đó xuất ra hàng ngang theo tên ô, có thể các ô có cùng số tại điểm tiếp giáp.

    xuất ra:  o-1 102 3.2 150 2.66  250 ( và diện tích ô đó )

    http://www.cadviet.com/upfiles/3/114381_sn_excel_1.dwg


  7. liisp XBC KHÔNG VẼ cạnh trên thửa đất, yêu cầu phải ghi điểm và cạnh trên thửa đất bạn chỉnh giúp mình với.

    Mình muốn lắm việc liisp tạo tọa độ và cạnh thửa đất như file này:

    http://www.cadviet.com/upfiles/3/114381_bang_td_1.dwg

     Nhưng trình độ hạn chế, chỉnh hoài không được. Xin nhờ bạn hường dẫn và chỉnh giúp ,

    http://www.cadviet.com/upfiles/3/114381_tonghopxtd_sss.lsp

    Cám ơn


  8. - thực sự y/c này đối với khả năng hiện tại của nhoc hơi khó ^^, việc xuất 2 loại bảng trong cùng 1 lsp hix hix, thực ra như bạn cũng thấy nhoc cũng chỉ dựa vào cái lõi của lsp gốc binh lại nên việc chỉnh sữa hơi phức tạp, có gì bạn thông cảm.

    - hiện tại khả năng hiện giờ nếu có thể thì nhoc chỉ có thể tách ra 2 lsp riêng, 1 lsp xuất bảng tọa độ, 1 lsp cho phép bạn xuất bảng cạnh thửa thui, nhoc chưa ghép nỗi 2 bảng vào 1 lsp

    - ah còn 1 cái nữa cái bảng cạnh có các line ngăn cách giữa 1 cặp cạnh, nhoc có thể bỏ qua các line đó không, nếu bạn đồng ý, nhoc sẽ cố gắng chỉnh thử sẽ làm lsp thứ 2 để xuất bảng cạnh, lsp xuất tọa độ đã có rùi hen

    P/s: sức nhoc chỉ tới đó, nhoc ko hứa sẽ có, nhưng sẽ cố gắng làm thử, nếu làm ko đc nhoc sẽ báo bạn hay, bạn đừng bùn, bạn có thể nhờ các anh khác chỉnh hộ ^^ 

    Bạn cứ tách ra làm phần đi, 1 lsp  xuất bảng cạnh thửa  và các line ngăn cách giữa 1 cặp cạnh bỏ qua luôn


  9. Đúng rồi đó bạn, Mình sợ rắc rối cho bạn. Nếu được bạn giúp như sau :

    1_ chọn thửa,  ghi điểm , tên điểm vả chiểu dài trên thửa, xuất ra bảng chọn tùy  vị trí đặt bảng, xuất bảng do yêu cầu có 2 loại bảng . bảng thể hiện tên đỉnh - tọa độ X - Tọa độ Y - tên cạnh ( là đỉnh D - D+1 ) - chiều dài. Loại bản thứ 2 chỉ ghi Tên cạnh - chiều dài.

    2_Vấn đề 2 : chọn thửa và xuất như nội dung trên như thể hiên ra cả khung luôn.

    Mong được bạn giúp

×