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

Viết Lisp theo yêu cầu

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

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!

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

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

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

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

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

  • 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

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 :

 

nn2iu0.th.jpg

 

-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

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

 

nn2iu0.th.jpg

 

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

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

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

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

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 đỡ!

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

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
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 :"))
(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)
)

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

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
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ẻ!

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

Các bác giúp em viết cái lisp này với.nội dung nó là. khi mình load lisp này nó sẽ hỏi chọn đối tượng(dạng số).sau đó sẽ yêu cầu nhập số để nhân với số mình đã chọn.kết quả nhân sẽ thay thế luôn số mình chọn ban đầu.các bác giúp 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
Các bác giúp em viết cái lisp này với.nội dung nó là. khi mình load lisp này nó sẽ hỏi chọn đối tượng(dạng số).sau đó sẽ yêu cầu nhập số để nhân với số mình đã chọn.kết quả nhân sẽ thay thế luôn số mình chọn ban đầu.các bác giúp em với!

cái này để tôi giúp cho

chờ chút nhé

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
cái này để tôi giúp cho

chờ chút nhé

;=======================================================================

(defun c:nhan (/ ss1 enam eget en eg count chontext pheptinh ghd ght sogia sothapphan)

 

(prompt "\n Thay doi tri so text theo so gia - 02/2006")

(prompt "\n Cac text da thuc hien se doi mau theo mau doi tuong chon")

 

 

(princ "\nChange layer ...\nSelect entities to change:")

(setq ss1 (ssget))

 

(setq chontext "txet")

 

(while

(null (setq enam (car (entsel "\nPick an entity on the target color:"))))

(princ "\nYou missed.")

)

 

(setq pheptinh (getstring "\n Phep tinh <cong>/Tru/Nhan/Chia:"))

(setq ghd (getreal "\n Cao trinh gioi han duoi <lon hon>: "))

(setq ght (getreal "\n Cao trinh gioi han tren <nho hon hoac bang>: "))

(setq sogia (getreal "\n So gia dieu chinh: "))

(setq sothapphan (getint "\n So so thap phan: "))

 

;====

 

(setq eget (entget enam))

(setq count 0)

(repeat (sslength ss1) ;bat dau lap===========

(setq en (ssname ss1 count))

(setq chontext (cdr (assoc 0 (entget en))))

(if (= chontext "TEXT")

(progn

(setq es (cdr (assoc 1 (entget en))))

(setq es (atof es))

(if (and (> es ghd) (<= es ght)) ;neu trong

(progn

(if (= pheptinh "n")

(setq es (* es sogia))

(if (= pheptinh "c")

(setq es (/ es sogia))

(if (= pheptinh "t")

(setq es (- es sogia))

(setq es (+ es sogia))

)

)

)

(setq es (rtos es 2 sothapphan)

eg (entget en)

eg (subst (cons 1 es) (assoc 1 eg) eg)

eg (subst (assoc 62 eget) (assoc 62 eg) eg)

)

)

) ;dong neu trong

)

)

(setq count (1+ count))

(entmod eg)

 

 

) ;dong lap

 

 

 

(prompt "\n Chuc mot buoi lam viec vui ve - dnhqs.\n")

(princ)

)

 

 

;============================

  • 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
Bạn có thể post yêu cầu về autolisp ở topic này.

 

Chào bác, em muốn hỏi bác một cái lisp:

 

Làm thế nào để chuyển tất cả các leader ko nằm trong mặt phằng XY của world ucs.

(defun c:test ()

(setq lst nil)

(setq ss (ssget))

(setq n 0)

(repeat (sslength ss)

(if (= (cdr (assoc 0 (entget (ssname ss n)))) "LEADER")

(progn

(setq lst (entget (ssname ss n)))

(foreach x lst

(if (= (car x) 10)

(progn

(setq pt (list (car (cadr x)) (cadr (cadr x)) 0.0))

)

)

)

)

)

)

)

Em chỉ viết sơ sơ đc đến đây, pác sửa dùm e cá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

Các bạn ơi cho mình hỏi, mình tạo ra 1 region bằng boundary nhưng nó không thể offset được , có thể tạo ra lisp offset đối tượng region không , nếu được thì cho mình xin , mình cám ơn nhiều!

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

Nhờ Anh giúp em viết chức năng cắt ra tất cả đối tượng trong 1 vùng được chọn(có thể vẽ chọn bằng nhiều cách: hình chữ nhật, polygon, hình tròn, ...). Em vẽ minh họa sơ nội dung Anh xem thử ha:

http://www.cadviet.com/upfiles/ban_ve_nho_viet_Lisp_1.dwg

Em xin cám ơn Anh nhiều nhé! :)

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
Nhờ Anh giúp em viết chức năng cắt ra tất cả đối tượng trong 1 vùng được chọn(có thể vẽ chọn bằng nhiều cách: hình chữ nhật, polygon, hình tròn, ...). Em vẽ minh họa sơ nội dung Anh xem thử ha:

http://www.cadviet.com/upfiles/ban_ve_nho_viet_Lisp_1.dwg

Em xin cám ơn Anh nhiều nhé! :)

Bạn hãy sử dụng lệnh Extrim.

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

các bác cho em hỏi có lệnh nào có thể copy giống như copym nhưng lại có thể bám tuyến cong như lệnh measure không, (tức là

copy các đối tượng bình thường chứ không phải block)

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×