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.
Đăng nhập để thực hiện theo  
tqcuonguct

[Yêu cầu] Lisp cắt đường gióng của dim theo một đường thẳng cho trước

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

tqcuonguct    1

Kính chào cả nhà, đặc biệt là các bác pro trên cad viet

Em có một trường hợp như sau mong cả nhà xem xét dùm: Trước kia mọi người đã post lên diễn đàn lisp cắt dim theo 2 phương là phương thẳng đứng và phương ngang. Tuy nhiên trong quá trình sử dụng cad em rất hay gặp tình huống là phải cắt dim theo 1 đường xiên cho đẹp, mọi người xem hình vẽ minh họa hộ em nhé. Bình thường em phải cắt từng dim một rất thủ công, mong các bác viết hộ em cái lisp này để tiết kiệm thời gian nhé.

Em xin cảm ơn và chúc cho diễn đàn ngày càng phát triển mạnh mẽ

 

110388_minh_hoa_1_1.png

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
mathan    57

Đây là Lisp mình sưu tập được bạn dùng thử, mình dùng thì thấy rất đúng yêu cầu của bài rùi

;(setq thu 1)
(defun c:ckt ()
  (setq thu 1)
(while (< thu 4)
(princ "\n Chon duong giong:")
(princ "\n Chon cac duong kich thuoc:")
(setq chon2  (ssget))
(setq ktra1 (getstring "n\Lua chon: giong Duoi (D), giong Tren (T), theo duong thang (V):"))


(if  (OR (= ktra1 "G") (= ktra1 "g"))
(progn
(setq chon1 (entsel  "\n Chon duong giong:"))
(setq chon1 (car chon1))
(setq ktra (cdr(assoc 0(entget chon1))))
(if (= ktra "LINE")

 	(progn

 (setq DAU (cdr(assoc 10(entget chon1))))
 (setq CUOI (cdr(assoc 11(entget chon1))))
 (giong)
 (setq thu (+ thu 1))

		)
)   ;-----------ket thuc if 1
;  (if (= ktra "LWPOLYLINE")
 ;(progn
 ;   (setq danhsach nil)
 ;   (setq j 1)
 ;   (setq eg (entget chon1))
 ; 	(setq DAU (cdr(assoc 10(entget chon1))))
 ;   (while (/= DAU nil)
 ; 	(setq danhsach (append danhsach DAU))
 ; 	(setq j (+ j 1))
 ;; 	(setq cu (list 10 (car DAU) (cadr DAU) 0))
  ; 	(setq moi (list 11 (car DAU) (cadr DAU) 0))
 ;	(setq eg (subst moi cu eg))
  ;  )

 ;(setq i 1)
 ;(setq DAU (nth i danhsach))
 ;(setq CUOI (nth (+ i 1) danhsach))
 ;(giong)
 ;)  

  ;)

 )
) ;--------ket thuc if2

(if  (OR (= ktra1 "D") (= ktra1 "d"))
(progn
 (setq DAU (getpoint  "\n Chon diem lam moc :"))
 (setq CUOI (polar DAU 0 10))
 (giong)
 (setq thu (+ thu 1))
)
);-------Dong if
(if  (OR (= ktra1 "V") (= ktra1 "v"))
(progn
 (setq DAU (getpoint  "\n Chon diem dau :"))
 (setq CUOI (getpoint  "\n Chon diem thu hai :"))
 (giong)
 (setq thu (+ thu 1))
)
);-------Dong if
(if  (OR (= ktra1 "T") (= ktra1 "t"))
(progn
 (setq DAU (getpoint  "\n Chon diem lam moc :"))
 (setq CUOI (polar DAU 0 1))
 (setq x1 (car DAU))
 (setq y1 (cadr DAU))
 (setq x2( car CUOI))
 (setq y2 (cadr CUOI))
 (setq kq1 (/ (- y1 y2) (- x1 x2)))

 (setq k 0)
 (while (setq ENT (ssname chon2 k))  ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT))))
(setq p2 (cdr(assoc 10(entget ENT))))
(setq p3 (cdr(assoc 14(entget ENT))))
(setq p4 (cdr(assoc 13(entget ENT))))
(setq xd (car p1))
(setq yd (+ (* (- xd x1) kq1) y1))
(setq xc (car p2))
(setq yc (+ (* (- xc x1) kq1) y1))
;--------------------------giong duoi---------------------------------------------
 (setq eg2 (entget ENT))
 (setq tdcud (list 11 (car p1) (cadr p1) 0))
 (setq tdcuc (list 10 (car p2) (cadr p2) 0))
 (setq tdmoid (list 11 xd yd 0))
 (setq tdmoic (list 10 xc yc 0))

 ; (setq caodo (rtos caodo))
 ;(setq ten (cons 1  caodo))
 (setq eg2 (subst tdmoid tdcud eg2))
 (setq eg2 (subst tdmoic tdcuc eg2))
 (entmod eg2)
 (SETQ K (+ K 1))
 )
 (setq thu (+ thu 1))
)
);dong if
)
(if (>= thu 4)
(progn
 	(textscr)
 	(princ "\n Xin lien he sdt: 0987255580")
)
)

)
(defun giong ()
 (setq x1 (car DAU))
 (setq y1 (cadr DAU))
 (setq x2( car CUOI))
 (setq y2 (cadr CUOI))
 (setq kq1 (/ (- y1 y2) (- x1 x2)))

 (setq k 0)
 (while (setq ENT (ssname chon2 k))  ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT))))
(setq p2 (cdr(assoc 10(entget ENT))))
(setq p3 (cdr(assoc 14(entget ENT))))
(setq p4 (cdr(assoc 13(entget ENT))))
(setq xd (car p3))
(setq yd (+ (* (- xd x1) kq1) y1))
(setq xc (car p4))
(setq yc (+ (* (- xc x1) kq1) y1))
;--------------------------giong duoi---------------------------------------------
 (setq eg2 (entget ENT))
 (setq tdcud (list 14 (car p3) (cadr p3) 0))
 (setq tdcuc (list 13 (car p4) (cadr p4) 0))
 (setq tdmoid (list 14 xd yd 0))
 (setq tdmoic (list 13 xc yc 0))

 ; (setq caodo (rtos caodo))
 ;(setq ten (cons 1  caodo))
 (setq eg2 (subst tdmoid tdcud eg2))
 (setq eg2 (subst tdmoic tdcuc eg2))
 (entmod eg2)
 (SETQ K (+ K 1))
 )
)

  • 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
quochuyksxd    24

Rất đúng thuốc. Tuy nhiên mình có một góp ý nhỏ cho lisp của bạn Mathan là khi cắt dim theo đường thẳng thì nên tạo đường ảo để người sử dụng dễ hình dung hơn thì lisp này thật tuyệt vời! thanks

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
tqcuonguct    1

Nhưng mà em thấy lisp này chỉ cắt được dim theo phương đứng thôi, nếu là dim theo phương ngang thì sẽ không cắt được. Bác mathan có thời gian sửa lại một chút để nó cắt được theo cả 2 phương thì hay bác à

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

Đây là Lisp mình sưu tập được bạn dùng thử, mình dùng thì thấy rất đúng yêu cầu của bài rùi


(defun c:ckt ()
(princ "\n Chon duong giong:")
(princ "\n Chon cac duong kich thuoc:")
(setq chon2  (ssget))
(setq ktra1 (getstring "n\Lua chon: giong Duoi (D), giong Tren (T), theo duong thang (V):"))


(if  (OR (= ktra1 "G") (= ktra1 "g"))
(progn
(setq chon1 (entsel  "\n Chon duong giong:"))
(setq chon1 (car chon1))
(setq ktra (cdr(assoc 0(entget chon1)))) 
(if (= ktra "LINE")

  (progn

 (setq DAU (cdr(assoc 10(entget chon1))))
 (setq CUOI (cdr(assoc 11(entget chon1))))
 (giong)
     )
)   ;-----------ket thuc if 1
;  (if (= ktra "LWPOLYLINE")
 ;(progn
 ;   (setq danhsach nil)
 ;   (setq j 1)
 ;   (setq eg (entget chon1))
 ;  (setq DAU (cdr(assoc 10(entget chon1))))
 ;   (while (/= DAU nil)
 ;  (setq danhsach (append danhsach DAU))
 ;  (setq j (+ j 1))
 ;;  (setq cu (list 10 (car DAU) (cadr DAU) 0))
  ;  (setq moi (list 11 (car DAU) (cadr DAU) 0))
 ; (setq eg (subst moi cu eg))
  ;  )

 ;(setq i 1)
 ;(setq DAU (nth i danhsach))
 ;(setq CUOI (nth (+ i 1) danhsach))
 ;(giong)
 ;)  

  ;)

 )
) ;--------ket thuc if2

(if  (OR (= ktra1 "D") (= ktra1 "d"))
(progn
 (setq DAU (getpoint  "\n Chon diem lam moc :"))
 (setq CUOI (polar DAU 0 10))
 (giong)  
)
);-------Dong if
(if  (OR (= ktra1 "V") (= ktra1 "v"))
(progn
 (setq DAU (getpoint  "\n Chon diem dau :"))
 (setq CUOI (getpoint  "\n Chon diem thu hai :"))
 (giong)  
)
);-------Dong if
(if  (OR (= ktra1 "T") (= ktra1 "t"))
(progn
 (setq DAU (getpoint  "\n Chon diem lam moc :"))
 (setq CUOI (polar DAU 0 1))
 (setq x1 (car DAU))
 (setq y1 (cadr DAU))
 (setq x2( car CUOI))
 (setq y2 (cadr CUOI))
 (setq kq1 (/ (- y1 y2) (- x1 x2)))

 (setq k 0)
 (while (setq ENT (ssname chon2 k))  ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT))))
(setq p2 (cdr(assoc 10(entget ENT))))
(setq p3 (cdr(assoc 14(entget ENT))))
(setq p4 (cdr(assoc 13(entget ENT))))
(setq xd (car p1))
(setq yd (+ (* (- xd x1) kq1) y1))
(setq xc (car p2))
(setq yc (+ (* (- xc x1) kq1) y1))
;--------------------------giong duoi---------------------------------------------
 (setq eg2 (entget ENT))
 (setq tdcud (list 11 (car p1) (cadr p1) 0))
 (setq tdcuc (list 10 (car p2) (cadr p2) 0))
 (setq tdmoid (list 11 xd yd 0))
 (setq tdmoic (list 10 xc yc 0))

 ; (setq caodo (rtos caodo))
 ;(setq ten (cons 1  caodo))
 (setq eg2 (subst tdmoid tdcud eg2))
 (setq eg2 (subst tdmoic tdcuc eg2))
 (entmod eg2)
 (SETQ K (+ K 1))
 )
 )
);dong if
)   
)
(defun giong ()
 (setq x1 (car DAU))
 (setq y1 (cadr DAU))
 (setq x2( car CUOI))
 (setq y2 (cadr CUOI))
 (setq kq1 (/ (- y1 y2) (- x1 x2)))

 (setq k 0)
 (while (setq ENT (ssname chon2 k))  ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT))))
(setq p2 (cdr(assoc 10(entget ENT))))
(setq p3 (cdr(assoc 14(entget ENT))))
(setq p4 (cdr(assoc 13(entget ENT))))
(setq xd (car p3))
(setq yd (+ (* (- xd x1) kq1) y1))
(setq xc (car p4))
(setq yc (+ (* (- xc x1) kq1) y1))
;--------------------------giong duoi---------------------------------------------
 (setq eg2 (entget ENT))
 (setq tdcud (list 14 (car p3) (cadr p3) 0))
 (setq tdcuc (list 13 (car p4) (cadr p4) 0))
 (setq tdmoid (list 14 xd yd 0))
 (setq tdmoic (list 13 xc yc 0))

 ; (setq caodo (rtos caodo))
 ;(setq ten (cons 1  caodo))
 (setq eg2 (subst tdmoid tdcud eg2))
 (setq eg2 (subst tdmoic tdcuc eg2))
 (entmod eg2)
 (SETQ K (+ K 1))
 )
)

Em down về dùng thấy đoạn lisp trên chỉ cho dùng 4 lần. Em đã thử xóa các thứ liên quan đến biến "thu" và thấy dùng được nhiều lần hơn mà không bị hỏi "liên hệ với sdt..." nữa (Đoạn lisp phía trên em đã sửa ạ). Nhưng em cũng không sửa được để lisp có thể cắt được dim ngang theo ý của tqcuongutc (em chỉ mày mò tự sửa thôi chứ giờ em mới bắt đầu học lisp (hì). Có bác nào giúp chúng em với ạ.

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
mathan    57

Là Lisp mình sưu tầm nên khi đưa lên mạng mình giữ nguyên như nguyên bản và số đt đó cũng k phải là của mình luôn :D

Nhưng do số 4 bất tiện, bạn có thể copy lại, vì mình cũng đã bỏ sửa lại để không giới hạn lần sử dụng nữa.

  • 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
mathan    57

Giải quyết hết các vấn đề về cắt dim các bạn nêu ở trên

- Với dim ngang : + Cắt chân dim lệnh DX

+ Gióng ngang text lệnh XD

+ Chân dim theo đường gióng XDD

 

- Với dim dọc : + Cắt chân dim lệnh DY

+ Gióng ngang text lệnh YD

+ Chân dim theo đường gióng YDD

Lisp vừa sưu tầm vừa nhào trộn một chút.

******************************************************************************
;*************************************************************************** *
;*                                                                     	* *
;* NAME 	:    	TRIM DIMENSION                                    	* *
;*                                                                     	* *
;* FUNCTION :    	ALLOWS TOU TO REVISE POSITION OF DIMENSION EXTENSION  * *
;*               	"DEFINING POINT" ALONG ITS "X" AXIS               	* *
;*                                                                     	* *
;* WRITTEN  :    	DAM QUOC SU ACT (VIETNAM)                         	* *
;*               	1-1-2000                                          	* *
;*                                                                     	* *
;*************************************************************************** *
******************************************************************************
(defun c:ZX()
(setvar "cmdecho" 0)
(command "ZOOM" "P")
(princ)
)
(defun c:ZD()
(setvar "cmdecho" 0)
(command "ZOOM" "D")
(princ)
)(defun c:ZA()
(setvar "cmdecho" 0)
(command "ZOOM" "ALL")
(princ)
)
(DEFUN C:DY ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nChon cac duong kich thuoc can cat theo chieu doc")
(SETQ SET (SSGET))
(PROMPT"\nChon vi tri duong dong moi")
(SETQ P1 (GETPOINT))
(SETQ X3 (CAR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
 (WHILE (< INDEX QUANT)
  (IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
  	)
(PROGN
	(SETQ L13 (ASSOC 13 A))
	(SETQ M13 (CDR L13))
	(SETQ L14 (ASSOC 14 A))
	(SETQ M14 (CDR L14))
	(SETQ P13 (LIST 13 X3 (CADR M13) (CADDR M13)))
	(SETQ P14 (LIST 14 X3 (CADR M14) (CADDR M14)))
	(SETQ A (SUBST P13 L13 A))
	(SETQ A (SUBST P14 L14 A))
	(ENTMOD A)  
)
  )
 (SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(PRINC)
)
(DEFUN C:DX ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nChon cac duong kich thuoc can cat theo chieu ngang")
(SETQ SET (SSGET))
(PROMPT"\nChon vi tri duong dong moi")
(SETQ P1 (GETPOINT))
(SETQ Y3 (CADR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
 (WHILE (< INDEX QUANT)
  (IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
  	)
(PROGN
	(SETQ L13 (ASSOC 13 A))
	(SETQ M13 (CDR L13))
	(SETQ L14 (ASSOC 14 A))
	(SETQ M14 (CDR L14))
	(SETQ P13 (LIST 13 (CAR M13) Y3 (CADDR M13)))
	(SETQ T13 (CDR P13))
	(SETQ P14 (LIST 14 (CAR M14) Y3 (CADDR M14)))
	(SETQ A (SUBST P13 L13 A))
	(SETQ A (SUBST P14 L14 A))
	(ENTMOD A)  
)
  )
 (SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
******************************************************
(DEFUN INIT  ()
 (setq Blm	(getvar "BLIPMODE")
Cmd	(getvar "CMDECHO")
Os 	(getvar "OSMODE")
Olderr *ERROR*
)	;setq      
 (setvar "BLIPMODE" 0)
 (setvar "CMDECHO" 0)
 (defun *ERROR*  (Msg)
(princ "\n:")
(Princ Msg)
(setvar "blipmode" Blm)
(setvar "CMDECHO" Cmd)
(setvar "OSMODE" Os)
(setq *ERROR* Olderr)
(princ)
)) 	;init
(DEFUN REINIT  ()
 (setvar "blipmode" Blm)
 (setvar "CMDECHO" Cmd)
 (setvar "OSMODE" Os)
 (setq *ERROR* Olderr)
 (princ)
 ) 	;reinit
(defun c:nh  (/ name1 ent A b sget)
 (init)
 (setq name1 (car (entsel))
sget  (ssget)
ent   (cdr (assoc 0 (setq A (entget name1))))
)
 (if
(or (= "LINE" ent)
(= "ARC" ent))
(command "pedit" name1 "y" "j" sget "" "")
(command "pedit" name1 "j" sget "" ""))
 (reinit)
 (princ)
)
**************************************************************************
;*************************************************************************
;*                                                                   	*
;* NAME 	:    	X-ALDIM.LSP                                     	*
;*                                                                   	*
;* FUNCTION :    	ALLOWS GROUPS OF DIMENSIONS TO BE ALIGNED ALONG A   *
;*               	COMMON "X" AXIS.                                	*
;*                                                                   	*
;* WRITTEN  :    	DAM QUOC SU (VIET NAM)                          	*
;*               	1 - 1 - 2000                                    	*
;*                                                                   	*
;*************************************************************************
(DEFUN C:YD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nChon cac duong kich thuoc theo chieu doc")
(SETQ SET (SSGET))
(PROMPT"\nChon vi tri moi")
(SETQ P1 (GETPOINT))
(SETQ X3 (CAR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
 (WHILE (< INDEX QUANT)
  (IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
  	)
(PROGN
	(SETQ L10 (ASSOC 10 A))
	(SETQ M10 (CDR L10))
	(SETQ L11 (ASSOC 11 A))
	(SETQ M11 (CDR L11))
	(SETQ P10 (LIST 10 X3 (CADR M10) (CADDR M10)))
	(SETQ A (SUBST P10 L10 A))
	(ENTMOD A)  
)
  )
 (SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
;*************************************************************************
;*                                                                   	*
;* NAME 	:    	Y-ALDIM.LSP                                     	*
;*                                                                   	*
;* FUNCTION :    	ALLOWS GROUPS OF DIMENSIONS TO BE ALIGNED ALONG A   *
;*               	COMMON "Y" AXIS.                                	*
;*                                                                   	*
;* WRITTEN  :    	DAM QUOC SU  (VIET NAM)                         	*
;*               	1 - 1 - 2000                                    	*
;*                                                                   	*
;*************************************************************************
(DEFUN C:XD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nChon cac duong kich thuoc theo chieu ngang")
(SETQ SET (SSGET))
(PROMPT"\nChon vi tri moi")
(SETQ P1 (GETPOINT))
(SETQ Y3 (CADR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
 (WHILE (< INDEX QUANT)
  (IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
  	)
(PROGN
	(SETQ L10 (ASSOC 10 A))
	(SETQ M10 (CDR L10))
	(SETQ P10 (LIST 10 (CAR M10) Y3 (CADDR M10)))
	(SETQ A (SUBST P10 L10 A))
	(ENTMOD A)  
)
  )
 (SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
;*************************************************************************
;* Edit by Mathan - Cat dim ngang theo duong thang                                                                   	*
;*************************************************************************
(DEFUN C:XDD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nChon cac duong kich thuoc theo chieu ngang")
(SETQ SET (SSGET))
(setq chon2 set) ;; doi sang defun giong
(setq DAU (getpoint  "\n Chon diem dau :"))
(setq CUOI (getpoint  "\n Chon diem thu hai :"))
(command "LINE" DAU CUOI "")
(setq dungtg (getstring "  "))
(command "ERASE" "L" "")
(giong)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
;;;;;;; Defun giong - suu tam
(defun giong ()
 (setq x1 (car DAU))
 (setq y1 (cadr DAU))
 (setq x2( car CUOI))
 (setq y2 (cadr CUOI))
 (setq kq1 (/ (- y1 y2) (- x1 x2)))

 (setq k 0)
 (while (setq ENT (ssname chon2 k))  ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT))))
(setq p2 (cdr(assoc 10(entget ENT))))
(setq p3 (cdr(assoc 14(entget ENT))))
(setq p4 (cdr(assoc 13(entget ENT))))
(setq xd (car p3))
(setq yd (+ (* (- xd x1) kq1) y1))
(setq xc (car p4))
(setq yc (+ (* (- xc x1) kq1) y1))
;--------------------------giong duoi---------------------------------------------
 (setq eg2 (entget ENT))
 (setq tdcud (list 14 (car p3) (cadr p3) 0))
 (setq tdcuc (list 13 (car p4) (cadr p4) 0))
 (setq tdmoid (list 14 xd yd 0))
 (setq tdmoic (list 13 xc yc 0))

 ; (setq caodo (rtos caodo))
 ;(setq ten (cons 1  caodo))
 (setq eg2 (subst tdmoid tdcud eg2))
 (setq eg2 (subst tdmoic tdcuc eg2))
 (entmod eg2)
 (SETQ K (+ K 1))
 )
)
;*************************************************************************
;* Edit by Mathan - Cat dim doc theo duong thang                                                                   	*
;*************************************************************************
(DEFUN C:YDD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nChon cac duong kich thuoc theo chieu duoc")
(SETQ SET (SSGET))
(setq chon2 set) ;; doi sang defun giongdoc
(setq DAU (getpoint  "\n Chon diem dau :"))
(setq CUOI (getpoint  "\n Chon diem thu hai :"))
(command "LINE" DAU CUOI "")
(setq dungtg (getstring "  "))
(command "ERASE" "L" "")
(giongdoc)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
;;;;;;; Defun giong doc - edit by mathan
(defun giongdoc ()
 (setq x1 (car DAU))
 (setq y1 (cadr DAU))
 (setq x2( car CUOI))
 (setq y2 (cadr CUOI))
 (setq kq2 (/(- x2 x1) (- y2 y1) ))

 (setq k 0)
 (while (setq ENT (ssname chon2 k))  ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT)))) ;;diem giua text
(setq p2 (cdr(assoc 10(entget ENT)))) ;;diem tren
(setq p3 (cdr(assoc 14(entget ENT)))) ;;diem phai
(setq p4 (cdr(assoc 13(entget ENT)))) ;;diem trai
(setq yd (cadr p3))
(setq xd (+ (* (- yd y1) kq2) x1))
(setq yc (cadr p4))
(setq xc (+ (* (- yc y1) kq2) x1))
;--------------------------giong duoi---------------------------------------------
 (setq eg2 (entget ENT))
 (setq tdcud (list 14 (car p3) (cadr p3) 0))
 (setq tdcuc (list 13 (car p4) (cadr p4) 0))
 (setq tdmoid (list 14 xd yd 0))
 (setq tdmoic (list 13 xc yc 0))

 ; (setq caodo (rtos caodo))
 ;(setq ten (cons 1  caodo))
 (setq eg2 (subst tdmoid tdcud eg2))
 (setq eg2 (subst tdmoic tdcuc eg2))
 (entmod eg2)
 (SETQ K (+ K 1))
 )
)
;;;;
;;(setq p1 (cdr(assoc 11(entget (ssname (ssget) 0)))))

  • Vote tăng 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
tqcuonguct    1

Cài này thì trị đúng bệnh 100% rồi bác mathan à. Cảm ơn bác nhiều nha, rất vui được mọi người giúp đỡ thế này.

Chúc diễn đàn vui ^^

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

Đăng nhập để thực hiện theo  

×