Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
11 replies to this topic

#1 tqcuonguct

tqcuonguct

    biết zoom

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

Đã gửi 06 July 2012 - 01:49 PM

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ẽ

Hình đã gửi
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 06 July 2012 - 01:59 PM

Chi phí là như thế nào bạn ^^
  • 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


#3 tqcuonguct

tqcuonguct

    biết zoom

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

Đã gửi 09 July 2012 - 05:46 PM

Hi. Em nhờ mà bác ^^
  • 0

#4 nguoihung_3

nguoihung_3

    biết zoom

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

Đã gửi 13 July 2012 - 10:24 AM

ủa!không ai làm lisp này à?Mình thấy lisp này hay mà!
  • 0

#5 mathan

mathan

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 13 July 2012 - 01:28 PM

Đâ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))
)
)

  • 1
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#6 quochuyksxd

quochuyksxd

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 201 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 13 July 2012 - 02:47 PM

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

#7 tqcuonguct

tqcuonguct

    biết zoom

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

Đã gửi 13 July 2012 - 03:52 PM

Cảm ơn bác mathan nhiều nhé
  • 0

#8 tqcuonguct

tqcuonguct

    biết zoom

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

Đã gửi 13 July 2012 - 04:03 PM

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 à
  • 0

#9 quickandfine

quickandfine

    biết lệnh copy

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

Đã gửi 13 July 2012 - 04:37 PM

Đâ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 ạ.
  • 0

#10 mathan

mathan

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 13 July 2012 - 04:45 PM

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.
  • 1
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#11 mathan

mathan

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 14 July 2012 - 10:22 AM

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)))))

  • 3
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#12 tqcuonguct

tqcuonguct

    biết zoom

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

Đã gửi 16 July 2012 - 05:21 PM

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 ^^
  • 0