Đến nội dung


Hình ảnh
* * * - - 2 Bình chọn

Viết Lisp theo yêu cầu


  • Chủ đề bị khóa Chủ đề bị khóa
2780 replies to this topic

#421 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 15 January 2008 - 12:35 AM

Gửi Bác Hòanh file mẫu theo gợi ý của Bác. Xin nêu một chút cho cụ thể là điểm chèn text của tên điểm (M1, M2...) và code (jM1, jM2...) trùng vơí tọa độ điểm mia, chỉ có khác là tên điểm ở TL, code ở BL, chiều cao text bây giờ không quan tâm nưã bác ạ! Cám ơn Bác Hoành nhiều
http://www.cadviet.com/upfiles/mau.rar


Lệnh là JD (Joint các Điểm).

Chương trình yêu cầu bạn nhập các đối tượng vào (lẫn lộn cả point và text). Chương trình tự phân biệt đâu là point, đâu là tên điểm và đâu là code rồi thực thi như yêu cầu của bạn.

Text không cần trùng điểm chèn với point mà chỉ cần gần point là chương trình nhận biết được.

(defun c:jd ()
(setq
ss (ssget
'((-4 . "< OR")
(-4 . "< AND")(0 . "POINT") (8 . "DIEM")(-4 . "AND>")
(-4 . "< AND")(0 . "TEXT") (8 . "TENDIEM")(-4 . "AND>")
(-4 . "< AND")(0 . "TEXT") (8 . "CODE")(-4 . "AND>")
(-4 . "OR>")
)
)
lstent (ss2ent ss)

lsttendiem (mapcar '(lambda (e)
(cons (cdr (assoc 10 (entget e)))
(cdr (assoc 1 (entget e)))
)
)
(filter lstent "TEXT" "TENDIEM")
)
lstcode (mapcar '(lambda (e)
(cons (cdr (assoc 10 (entget e)))
(cdr (assoc 1 (entget e)))
)
)
(filter lstent "TEXT" "CODE")
)
lstpoint (mapcar '(lambda (e) (cdr (assoc 10 (entget e))))
(filter lstent "POINT" "DIEM")
)
lstpoint (mapcar '(lambda (p)
(cons (timgan p lsttendiem) p)
)
lstpoint
)
)
(foreach pp lstcode
(setq
pc (car pp)
tendiem (timgan pc lsttendiem)
code (cdr pp)
p (cdr (assoc tendiem lstpoint))
lstc (explode (substr code 2) "-")
)

(foreach cc lstc
(setq f (assoc cc lstpoint))
(if f
(progn
(setq p0 (cdr f))
(makeline p0 p)
)
)
)
)

(princ)
)
(defun timgan (p lst / dmin ppluu)
(foreach pp lst
(setq d (distance p (car pp)))
(if (or (not dmin) (> dmin d))
(setq
dmin d
ppluu pp
)
)
)
(cdr ppluu)
)

(defun filter(lstent otype olayer / kq)
(foreach pp lstent
(setq tt (entget pp))
(if (and
(member (cons 0 otype) tt)
(member (cons 8 olayer) tt)
)
(setq kq (append kq (list pp)))
)
)
kq
)

(defun pos (sub st / l1 l2 index)
(setq index 1
l1 (strlen sub)
l2 (strlen st)
)
(while
(and (<= (+ index l1 -1) l2) (/= sub (substr st index l1)))
(setq index (1+ index))
)
(if (= sub (substr st index l1))
index
nil
)
)

(defun explode (str sep / kq)
(setq kq nil)
(while (setq vt (pos sep str))
(setq
kq (append kq (list (substr str 1 (1- vt))))
str (substr str (1+ vt))
)
)
(setq kq (append kq (list str)))
kq
)

(defun makeline (p1 p2)
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)

(defun ss2ent(ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

  • 2

#422 thanhlamct

thanhlamct

    biết lệnh offset

  • Members
  • PipPipPip
  • 176 Bài viết
Điểm đánh giá: 70 (tàm tạm)

Đã gửi 15 January 2008 - 12:35 PM

ôi kô có bác nào giúp em àh?????????

Bạn nên xem lệnh ME, lệnh này rất hay khi muốn chèn Block theo tuyến đấy.
  • 0

#423 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 15 January 2008 - 12:47 PM

Lệnh là JD (Joint các Điểm).

Chương trình yêu cầu bạn nhập các đối tượng vào (lẫn lộn cả point và text). Chương trình tự phân biệt đâu là point, đâu là tên điểm và đâu là code rồi thực thi như yêu cầu của bạn.

Text không cần trùng điểm chèn với point mà chỉ cần gần point là chương trình nhận biết được.

(defun c:jd ()
(setq
ss (ssget
'((-4 . "<OR")
(-4 . "<AND")(0 . "POINT") (8 . "DIEM")(-4 . "AND>")
(-4 . "<AND")(0 . "TEXT") (8 . "TENDIEM")(-4 . "AND>")
(-4 . "<AND")(0 . "TEXT") (8 . "CODE")(-4 . "AND>")
(-4 . "OR>")
)
)
lstent (ss2ent ss)

lsttendiem (mapcar '(lambda (e)
(cons (cdr (assoc 10 (entget e)))
(cdr (assoc 1 (entget e)))
)
)
(filter lstent "TEXT" "TENDIEM")
)
lstcode (mapcar '(lambda (e)
(cons (cdr (assoc 10 (entget e)))
(cdr (assoc 1 (entget e)))
)
)
(filter lstent "TEXT" "CODE")
)
lstpoint (mapcar '(lambda (e) (cdr (assoc 10 (entget e))))
(filter lstent "POINT" "DIEM")
)
lstpoint (mapcar '(lambda (p)
(cons (timgan p lsttendiem) p)
)
lstpoint
)
)
(foreach pp lstcode
(setq
pc (car pp)
tendiem (timgan pc lsttendiem)
code (cdr pp)
p (cdr (assoc tendiem lstpoint))
lstc (explode (substr code 2) "-")
)

(foreach cc lstc
(setq f (assoc cc lstpoint))
(if f
(progn
(setq p0 (cdr f))
(makeline p0 p)
)
)
)
)

(princ)
)
(defun timgan (p lst / dmin ppluu)
(foreach pp lst
(setq d (distance p (car pp)))
(if (or (not dmin) (> dmin d))
(setq
dmin d
ppluu pp
)
)
)
(cdr ppluu)
)

(defun filter(lstent otype olayer / kq)
(foreach pp lstent
(setq tt (entget pp))
(if (and
(member (cons 0 otype) tt)
(member (cons 8 olayer) tt)
)
(setq kq (append kq (list pp)))
)
)
kq
)

(defun pos (sub st / l1 l2 index)
(setq index 1
l1 (strlen sub)
l2 (strlen st)
)
(while
(and (<= (+ index l1 -1) l2) (/= sub (substr st index l1)))
(setq index (1+ index))
)
(if (= sub (substr st index l1))
index
nil
)
)

(defun explode (str sep / kq)
(setq kq nil)
(while (setq vt (pos sep str))
(setq
kq (append kq (list (substr str 1 (1- vt))))
str (substr str (1+ vt))
)
)
(setq kq (append kq (list str)))
kq
)

(defun makeline (p1 p2)
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)

(defun ss2ent(ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

Bác Hoành xem lại giúp, tôi thực hiện trên file mẫu, sau khi nhập lệnh, chọn đôí tượng, chương trình báo lỗi:
error: null function
(POS SEP STR)
(SETQ VT (POS SEP STR))
(WHILE (SETQ VT (POS SEP STR)) (SETQ KQ (APPEND KQ (LIST (SUBSTR STR 1 (1-
VT)))) STR (SUBSTR STR (1+ VT))))
(EXPLODE (SUBSTR CODE 2) "-")
(SETQ PC (CAR PP) TENDIEM (TIMGAN PC LSTTENDIEM) CODE (CDR PP) P (CDR (ASSOC
TENDIEM LSTPOINT)) LSTC (EXPLODE (SUBSTR CODE 2) "-"))
(FOREACH PP LSTCODE (SETQ PC (CAR PP) TENDIEM (TIMGAN PC LSTTENDIEM) CODE (CDR
PP) P (CDR (ASSOC TENDIEM LSTPOINT)) LSTC (EXPLODE (SUBSTR CODE 2) "-"))
(FOREACH CC LSTC (SETQ F (ASSOC CC LSTPOINT)) (IF F (PROGN (SETQ P0 (CDR F))
(MAKELINE P0 P)))))
(C:JD)
*Cancel*
Không thấy line nào xuất hiện cả bác ạ!
  • 0

#424 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 15 January 2008 - 03:07 PM

Bác Hoành xem lại giúp, tôi thực hiện trên file mẫu, sau khi nhập lệnh, chọn đôí tượng, chương trình báo lỗi:
...
Không thấy line nào xuất hiện cả bác ạ!

Mình chạy thử trên file mẫu của bạn, kết quả: OK! Bạn thử lại xem sao.
Lưu ý:
1) Vô hiệu hóa tất cả các trình lisp khác đang chạy (nếu có) của bạn. Bạn có dùng trình lisp nào đặt ở chế độ autoload không?
2) Sau khi load file, bấm F2 xem nó có báo gì khác ngoài dòng "...successfully loaded" không? Nếu có tức là không ổn, bạn đã thao tác sai cái gì đó không biết!
  • 1

#425 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 15 January 2008 - 03:13 PM

Mình chạy thử trên file mẫu của bạn, kết quả: OK! Bạn thử lại xem sao.
Lưu ý:
1) Vô hiệu hóa tất cả các trình lisp khác đang chạy (nếu có) của bạn. Bạn có dùng trình lisp nào đặt ở chế độ autoload không?
2) Sau khi load file, bấm F2 xem nó có báo gì khác ngoài dòng "...successfully loaded" không? Nếu có tức là không ổn, bạn đã thao tác sai cái gì đó không biết!

Mình sẽ xem lại, nhưng mình vẫn load file bình thường, không có gì lạ xảy ra cả, gõ lệnh, nhắc chọn đối tượng, chọn xong, Enter, báo lỗi như trên
  • 0

#426 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 15 January 2008 - 03:29 PM

Mình chạy thử trên file mẫu của bạn, kết quả: OK! Bạn thử lại xem sao.
Lưu ý:
1) Vô hiệu hóa tất cả các trình lisp khác đang chạy (nếu có) của bạn. Bạn có dùng trình lisp nào đặt ở chế độ autoload không?
2) Sau khi load file, bấm F2 xem nó có báo gì khác ngoài dòng "...successfully loaded" không? Nếu có tức là không ổn, bạn đã thao tác sai cái gì đó không biết!

cám ơn Bác SSG nhiều, có lẽ chương trình Cad ở nhà bị lỗi hay sao bác ạ(Cad 14), vừa rồi chạy thử máy trên cơ quan (Cad 2004), đúng là OK!
  • 0

#427 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 15 January 2008 - 08:22 PM

Lệnh là JD (Joint các Điểm).

Chương trình yêu cầu bạn nhập các đối tượng vào (lẫn lộn cả point và text). Chương trình tự phân biệt đâu là point, đâu là tên điểm và đâu là code rồi thực thi như yêu cầu của bạn.

Text không cần trùng điểm chèn với point mà chỉ cần gần point là chương trình nhận biết được.

(defun c:jd ()
(setq
ss (ssget
'((-4 . "<OR")
(-4 . "<AND")(0 . "POINT") (8 . "DIEM")(-4 . "AND>")
(-4 . "<AND")(0 . "TEXT") (8 . "TENDIEM")(-4 . "AND>")
(-4 . "<AND")(0 . "TEXT") (8 . "CODE")(-4 . "AND>")
(-4 . "OR>")
)
)
lstent (ss2ent ss)

lsttendiem (mapcar '(lambda (e)
(cons (cdr (assoc 10 (entget e)))
(cdr (assoc 1 (entget e)))
)
)
(filter lstent "TEXT" "TENDIEM")
)
lstcode (mapcar '(lambda (e)
(cons (cdr (assoc 10 (entget e)))
(cdr (assoc 1 (entget e)))
)
)
(filter lstent "TEXT" "CODE")
)
lstpoint (mapcar '(lambda (e) (cdr (assoc 10 (entget e))))
(filter lstent "POINT" "DIEM")
)
lstpoint (mapcar '(lambda (p)
(cons (timgan p lsttendiem) p)
)
lstpoint
)
)
(foreach pp lstcode
(setq
pc (car pp)
tendiem (timgan pc lsttendiem)
code (cdr pp)
p (cdr (assoc tendiem lstpoint))
lstc (explode (substr code 2) "-")
)

(foreach cc lstc
(setq f (assoc cc lstpoint))
(if f
(progn
(setq p0 (cdr f))
(makeline p0 p)
)
)
)
)

(princ)
)
(defun timgan (p lst / dmin ppluu)
(foreach pp lst
(setq d (distance p (car pp)))
(if (or (not dmin) (> dmin d))
(setq
dmin d
ppluu pp
)
)
)
(cdr ppluu)
)

(defun filter(lstent otype olayer / kq)
(foreach pp lstent
(setq tt (entget pp))
(if (and
(member (cons 0 otype) tt)
(member (cons 8 olayer) tt)
)
(setq kq (append kq (list pp)))
)
)
kq
)

(defun pos (sub st / l1 l2 index)
(setq index 1
l1 (strlen sub)
l2 (strlen st)
)
(while
(and (<= (+ index l1 -1) l2) (/= sub (substr st index l1)))
(setq index (1+ index))
)
(if (= sub (substr st index l1))
index
nil
)
)

(defun explode (str sep / kq)
(setq kq nil)
(while (setq vt (pos sep str))
(setq
kq (append kq (list (substr str 1 (1- vt))))
str (substr str (1+ vt))
)
)
(setq kq (append kq (list str)))
kq
)

(defun makeline (p1 p2)
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)

(defun ss2ent(ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

Xin phép Bác Hoành cho tôi được thêm đọan mã sau vào cái lisp Bác đã viết: (command "layer" "M" "lines" nill)
để đối tượng lines tạo ra luôn nằm trên Layer "LINES", cho nó đâu ra đấy, anh em sử dụng lisp này đỡ vất vả
Bác Hòanh cho hỏi thêm chút nhé! Có khi nào các điểm nằm gần nhau bị nối nhầm không Bác ? Nếu Point là 3D có thực hiện được không ?
Hình như cái Lisp này nó không chịu chơi vơí thằng Cad R14 Bác a! Khổ nỗi máy mình xưa quá, mấy Thằng Cad đời hậu sinh nó không hạp
  • 0

#428 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 15 January 2008 - 08:41 PM

Xin phép Bác Hoành cho tôi được thêm đọan mã sau vào cái lisp Bác đã viết: (command "layer" "M" "lines" nill)
để đối tượng lines tạo ra luôn nằm trên Layer "LINES", cho nó đâu ra đấy, anh em sử dụng lisp này đỡ vất vả
Bác Hòanh cho hỏi thêm chút nhé! Có khi nào các điểm nằm gần nhau bị nối nhầm không Bác ? Nếu Point là 3D có thực hiện được không ?
Hình như cái Lisp này nó không chịu chơi vơí thằng Cad R14 Bác a! Khổ nỗi máy mình xưa quá, mấy Thằng Cad đời hậu sinh nó không hạp

- Nếu muốn nằm ở layer line, bạn thêm mã lệnh (cons 8 "lines") sau mã (cons 0 "LINE") là được.
- Lisp này mình chủ định viết bạn, là cho R14 (vì mở file của bạn ra thấy version file của bạn là R14). Tất cả các lệnh của lisp đều sử dụng mã cơ bản. Bạn thử lại lần nữa xem.
  • 1

#429 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 16 January 2008 - 12:31 PM

- Nếu muốn nằm ở layer line, bạn thêm mã lệnh (cons 8 "lines") sau mã (cons 0 "LINE") là được.
- Lisp này mình chủ định viết bạn, là cho R14 (vì mở file của bạn ra thấy version file của bạn là R14). Tất cả các lệnh của lisp đều sử dụng mã cơ bản. Bạn thử lại lần nữa xem.

Bảo đảm vơí Bác Hòanh là không chạy được trên Cad 14, vì đã thử trên 4 máy tính khác sử dụng Cad14 vẫn báo lỗi, coppy nguyên nội dung text Bác xem nhé
Command: _appload
Loading E:\soft\autolisp\cadviet\noidiemtheocode.lsp ...

Command: jd

Select objects: Other corner: 26 found

Select objects:
error: null function
(POS SEP STR)
(SETQ VT (POS SEP STR))
(WHILE (SETQ VT (POS SEP STR)) (SETQ KQ (APPEND KQ (LIST (SUBSTR STR 1 (1-
VT)))) STR (SUBSTR STR (1+ VT))))
(EXPLODE (SUBSTR CODE 2) "-")
(SETQ PC (CAR PP) TENDIEM (TIMGAN PC LSTTENDIEM) CODE (CDR PP) P (CDR (ASSOC
TENDIEM LSTPOINT)) LSTC (EXPLODE (SUBSTR CODE 2) "-"))
(FOREACH PP LSTCODE (SETQ PC (CAR PP) TENDIEM (TIMGAN PC LSTTENDIEM) CODE (CDR
PP) P (CDR (ASSOC TENDIEM LSTPOINT)) LSTC (EXPLODE (SUBSTR CODE 2) "-"))
(FOREACH CC LSTC (SETQ F (ASSOC CC LSTPOINT)) (IF F (PROGN (SETQ P0 (CDR F))
(MAKELINE P0 P)))))
(C:JD)
*Cancel*
  • 0

#430 ngayve324

ngayve324

    biết lệnh xref

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

Đã gửi 16 January 2008 - 02:39 PM

Bạn có thể post yêu cầu về autolisp ở topic này.

Nhờ các Pro xem sửa giúp em cái líp này với. đây là 1 đoạn lisp mình copy trong chương trình Fascad




;VE LUOI COT
(defun c:LC ()
(setq om (getvar "osmode"))
(setvar "osmode" 0)
(setq tile (getreal "\nCho biet Ti Le ve 1/x, x="))
(setq p0 (getpoint "\n Chon Basic Point:"))
(setq nc (getreal "\n Nhap chieu ngang cua cot : "))
(setq dc (getreal "\n Nhap chieu doc cua cot : "))
(setq p1 (polar (polar p0 pi (/ (* nc hstl) 2 tile) ) (* pi 1.5) (/ (* dc hstl) 2 tile) ) )
(setq p2 (polar (polar p0 0 (/ (* nc hstl) 2 tile) ) (* pi 0.5) (/ (* dc hstl) 2 tile) ) )
(command "rectang" p1 p2)
(command "hatch" "solid" "l" "")
(setq bcn (getreal "\n Buoc cot theo phuong ngang : "))
(setq nn (getint "\n So buoc cot phuong ngang : "))
(setq w1 (polar (polar p1 pi (/ (* nc hstl) 2 tile) ) (* pi 1.5) (/ (* dc hstl) 2 tile) ) )
(setq w2 (polar (polar p2 0 (/ (* nc hstl) 2 tile) ) (* pi 0.5) (/ (* dc hstl) 2 tile) ) )
(command "select" "w" w1 w2 "")
(command "array" "p" "" "r" "1" (+ nn 1) (/ (* bcn hstl) tile) )
(command "line" (polar p0 pi (/ (* 1000 hstl) tile)) (polar p0 0 (/ (* (+ (* bcn nn) 1000) hstl) tile) ) "")
(setq w1 (polar (polar p0 pi (/ (* hstl 2000) tile)) (* pi 1.5) (/ (* hstl 2000) tile) ))
(setq w2 (polar (polar p0 0 (/ (* (+ (* bcn nn) 2000) hstl) tile) ) (* pi 0.5) (/ (* hstl 2000) tile) ))
(command "zoom" "w" w1 w2)
(command "select" "w" w1 w2 "")
(setq bcd (getreal "\n Buoc cot theo phuong doc : "))
(setq nd (getint "\n So buoc cot phuong doc : "))
(command "array" "p" "" "r" (+ nd 1) "1" (/ (* hstl bcd) tile) )
(command "line" (polar p0 (* pi 1.5) (/ (* hstl 1000) tile)) (polar p0 (* pi 0.5) (/ (* (+ (* bcd nd) 1000) hstl) tile)) "")
(command "array" "l" "" "r" "1" (+ nn 1) (/ (* hstl bcn) tile) )
(setq w2 (polar w2 (* pi 0.5) (/ (* (+ (* bcd nd) 2000) hstl) tile)) )
(command "zoom" "w" w1 w2)
(setvar "osmode" om)
)


Cám ơn các bác nhièu. chúc năm mới sức khõ dồi dào, tiền vô như nước........... :)
  • 0

#431 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 16 January 2008 - 03:34 PM

Nhờ các Pro xem sửa giúp em cái líp này với. đây là 1 đoạn lisp mình copy trong chương trình Fascad

;VE LUOI COT
(defun c:LC ()
(setq hstl 1)
(setq om (getvar "osmode"))
...

Bạn thêm vào 1 dòng (setq hstl 1) sau dòng (defun c:LC() như trên.
  • 1

#432 Ar_Chanwoo

Ar_Chanwoo

    biết lệnh break

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

Đã gửi 18 January 2008 - 12:41 PM

Bác NN viết Lisp kinh thật đấy, e muốn nhờ bác viết cho e một Lisp kiểu như sau :
-Lisp để vẽ cửa đi 1C,2C,4C,cửa sổ bình thuờng và cửa sổ có bậu ở mặt bằng.
-Sau khi gõ lệnh gì đó mà tuỳ bác đặt sẽ hiện ra 1 hộp thoại (dialog) với cấu trúc như sau :

Hình đã gửi

-các chức năng vẽ cửa sổ,cửa đi,thống kê được bố trí trên 1 hộp thoại dưới dạng các TAB như là IE7 ấy cho tiện sử dụng
  • 0

#433 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 18 January 2008 - 01:07 PM

Bác NN viết Lisp kinh thật đấy, e muốn nhờ bác viết cho e một Lisp kiểu như sau :
-Lisp để vẽ cửa đi 1C,2C,4C,cửa sổ bình thuờng và cửa sổ có bậu ở mặt bằng.
-Sau khi gõ lệnh gì đó mà tuỳ bác đặt sẽ hiện ra 1 hộp thoại (dialog) với cấu trúc như sau :

Hình đã gửi

-các chức năng vẽ cửa sổ,cửa đi,thống kê được bố trí trên 1 hộp thoại dưới dạng các TAB như là IE7 ấy cho tiện sử dụng

Bạn hãy cài AutoDesk Desktop Architectural hoặc Revit, bạn sẽ có nhiều hơn cả cái bạn muốn.
  • 0

#434 Ar_Chanwoo

Ar_Chanwoo

    biết lệnh break

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

Đã gửi 18 January 2008 - 03:32 PM

Bạn hãy cài AutoDesk Desktop Architectural hoặc Revit, bạn sẽ có nhiều hơn cả cái bạn muốn.

Chuyển sang dùng Revit hay ADT là cả 1 vấn đề lớn bạn ah
  • 0

#435 thoclep

thoclep

    biết lệnh offset

  • Members
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 19 January 2008 - 10:10 AM

Bạn có thể post yêu cầu về autolisp ở topic này.

Nhờ bác giúp em! Em có 1 cái lisp để vẽ thép móc khi bố trí thép cho sàn, nay em muốn nhờ bác viết thêm giúp cho em lệnh vẽ thép mũ (thép trên của sàn).


;*******************************************************************************

(defun myerror (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)
;*******************************************************************************

(DEFUN C:TD (/ OLDERR CMD OSM DK PT1 PT2 PT3 PT4 PT5 PT6 STR PRPT GOCX GOCY
PTD PTC)
(SETQ OLDERR *error*
*error* myerror)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ DK (GETVAR "USERR3"))
(IF (= DK 0)
(PROGN
(SETQ STR "1")
(SETVAR "USERR3" 1)
)
(SETQ STR (RTOS DK))
)
(SETQ PRPT (STRCAT "Duong kinh moc tron <" STR ">:"))
(SETQ DK (GETREAL PRPT))
(IF (= DK NIL)
(SETQ DK (GETVAR "USERR3"))
(SETVAR "USERR3" DK)
)
(INITGET 7)
(SETQ PTD (GETPOINT "\nFrom point:"))
(INITGET 7)
(SETQ PTC (GETPOINT PTD "\nTo point:"))
(SETVAR "OSMODE" 0)
(SETQ GOCX (ANGLE PTD PTC))
(SETQ GOCY (+ GOCX (/ PI 2)))
(SETQ PT1 (POLAR PTD GOCX (/ DK 2)))
(SETQ PT2 (POLAR PTC (+ GOCX PI) (/ DK 2)))
(SETQ PT3 (POLAR PT1 GOCY DK))
(SETQ PT4 (POLAR PT2 GOCY DK))
(SETQ PT5 (POLAR PT3 GOCX DK))
(SETQ PT6 (POLAR PT4 (+ GOCX PI) DK))
(COMMAND "PLINE" PT5 PT3 "A" PT1 "L" PT2 "A" PT4 "L" PT6 "")
(SETVAR "OSMODE" OSM)
(SETVAR "CMDECHO" CMD)
(PRINC)
)

  • 0

#436 congtrinh5

congtrinh5

    biết vẽ line

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

Đã gửi 19 January 2008 - 05:29 PM

Xin lisp chọn đối tượng rồi lấy ra làm lớp hiện thời cụ thể như sau:
VD : chạy lisp nó hỏi chọn 1 đối tượng trên màn hình, đối tượng đó đang nằm ở lớp thép, lập tức ở bảng layer lớp hiện thời sẽ là lớp thép.
mong các anh giúp đỡ!
  • 0

#437 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 19 January 2008 - 08:39 PM

Xin lisp chọn đối tượng rồi lấy ra làm lớp hiện thời cụ thể như sau:
VD : chạy lisp nó hỏi chọn 1 đối tượng trên màn hình, đối tượng đó đang nằm ở lớp thép, lập tức ở bảng layer lớp hiện thời sẽ là lớp thép.
mong các anh giúp đỡ!

Lệnh là LH
(defun c:lh()
(setvar "clayer" (cdr (assoc 8 (entget (car (entsel "\nHay pick vao 1 doi tuong: "))))))
)

  • 0

#438 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 19 January 2008 - 08:45 PM

Nhờ bác giúp em! Em có 1 cái lisp để vẽ thép móc khi bố trí thép cho sàn, nay em muốn nhờ bác viết thêm giúp cho em lệnh vẽ thép mũ (thép trên của sàn).


Bạn chỉ cần xoá tất cả các ký tự liên quan đến PT5, PT6 và xoá hết các chữ "A" trong đoạn mã trên là chương trình sẽ trở thành như bạn muốn. Và đây là đoạn mã sau khi xoá:

;*******************************************************************************

(defun myerror (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)
;*******************************************************************************

(DEFUN C:TD (/ OLDERR CMD OSM DK PT1 PT2 PT3 PT4 PT5 PT6 STR PRPT GOCX GOCY
PTD PTC)
(SETQ OLDERR *error*
*error* myerror)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ DK (GETVAR "USERR3"))
(IF (= DK 0)
(PROGN
(SETQ STR "1")
(SETVAR "USERR3" 1)
)
(SETQ STR (RTOS DK))
)
(SETQ PRPT (STRCAT "khoang cach moc <" STR ">:"))
(SETQ DK (GETREAL PRPT))
(IF (= DK NIL)
(SETQ DK (GETVAR "USERR3"))
(SETVAR "USERR3" DK)
)
(INITGET 7)
(SETQ PTD (GETPOINT "\nFrom point:"))
(INITGET 7)
(SETQ PTC (GETPOINT PTD "\nTo point:"))
(SETVAR "OSMODE" 0)
(SETQ GOCX (ANGLE PTD PTC))
(SETQ GOCY (+ GOCX (/ PI 2)))
(SETQ PT1 (POLAR PTD GOCX (/ DK 2)))
(SETQ PT2 (POLAR PTC (+ GOCX PI) (/ DK 2)))
(SETQ PT3 (POLAR PT1 GOCY DK))
(SETQ PT4 (POLAR PT2 GOCY DK))
(COMMAND "PLINE" PT3 PT1 PT2 PT4 "")
(SETVAR "OSMODE" OSM)
(SETVAR "CMDECHO" CMD)
(PRINC)
)

  • 1

#439 thoclep

thoclep

    biết lệnh offset

  • Members
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 20 January 2008 - 12:07 AM

Xin lisp chọn đối tượng rồi lấy ra làm lớp hiện thời cụ thể như sau:
VD : chạy lisp nó hỏi chọn 1 đối tượng trên màn hình, đối tượng đó đang nằm ở lớp thép, lập tức ở bảng layer lớp hiện thời sẽ là lớp thép.
mong các anh giúp đỡ!

Trong cad có lệnh AI_MOLC có tác dụng như yêu cầu của bạn, bạn đã thử chưa?
  • 0

#440 thoclep

thoclep

    biết lệnh offset

  • Members
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 20 January 2008 - 12:12 AM

Bạn chỉ cần xoá tất cả các ký tự liên quan đến PT5, PT6 và xoá hết các chữ "A" trong đoạn mã trên là chương trình sẽ trở thành như bạn muốn. Và đây là đoạn mã sau khi xoá:


;*******************************************************************************

(defun myerror (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)
;*******************************************************************************

(DEFUN C:TD (/ OLDERR CMD OSM DK PT1 PT2 PT3 PT4 PT5 PT6 STR PRPT GOCX GOCY
PTD PTC)
(SETQ OLDERR *error*
*error* myerror)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ DK (GETVAR "USERR3"))
(IF (= DK 0)
(PROGN
(SETQ STR "1")
(SETVAR "USERR3" 1)
)
(SETQ STR (RTOS DK))
)
(SETQ PRPT (STRCAT "khoang cach moc <" STR ">:"))
(SETQ DK (GETREAL PRPT))
(IF (= DK NIL)
(SETQ DK (GETVAR "USERR3"))
(SETVAR "USERR3" DK)
)
(INITGET 7)
(SETQ PTD (GETPOINT "\nFrom point:"))
(INITGET 7)
(SETQ PTC (GETPOINT PTD "\nTo point:"))
(SETVAR "OSMODE" 0)
(SETQ GOCX (ANGLE PTD PTC))
(SETQ GOCY (+ GOCX (/ PI 2)))
(SETQ PT1 (POLAR PTD GOCX (/ DK 2)))
(SETQ PT2 (POLAR PTC (+ GOCX PI) (/ DK 2)))
(SETQ PT3 (POLAR PT1 GOCY DK))
(SETQ PT4 (POLAR PT2 GOCY DK))
(COMMAND "PLINE" PT3 PT1 PT2 PT4 "")
(SETVAR "OSMODE" OSM)
(SETVAR "CMDECHO" CMD)
(PRINC)
)

Lisp trên em chưa thử được nhưng cũng xin cảm ơn bác rất nhiều! Thanks bác 1 cái mà vẫn chưa thấy đủ. Chúc bác một năm mới may mắn, mạnh khoẻ!
  • 0