Thấy đề tài cũng hay hay nên làm thử cái lisp. Nếu số lượng ít thì có thể dùng lệnh (ít tức là thí dụ chỉ có từ 1->10 chẳng hạn), nhưng nếu nhiều thì find & replace 2,3 chục chữ khác nhau cũng hơi oải.

  Tôi chỉ mới test từ 1 tới 20 thôi, bạn có file nào ghi số la mã đủ loại thì post lên tôi sửa lisp tiếp, chứ viết sô la mã nhiều quá cũng lười.  ^_^  ^_^ ...

  Thấy đề tài cũng hay hay nên làm thử cái lisp. Nếu số lượng ít thì có thể dùng lệnh (ít tức là thí dụ chỉ có từ 1->10 chẳng hạn), nhưng nếu nhiều thì find & replace 2,3 chục chữ khác nhau cũng hơi oải.

  Tôi chỉ mới test từ 1 tới 20 thôi, bạn có file nào ghi số la mã đủ loại thì post lên tôi sửa lisp tiếp, chứ viết sô la mã nhiều quá cũng lười.  ^_^  ^_^  ^_^

(defun c:slm()
  (defun demsolama(dt)
    (setq tong 0 n -1
 txt (vl-string->list (cdr (assoc 1 (entget dt))))
 as '((73 . 1) (86 . 5) (88 . 10)))
    (foreach v txt
      (setq n (1+ n)) 
      (cond ((and (> n 0) (/= (nth (1- n) txt) 73) (= v 86)) (setq tong (+ tong 5)))
   ((and (> n 0) (= (nth (1- n) txt) 73) (= v 86)) (setq tong (+ tong 3)))
   ((and (> n 0) (/= (nth (1- n) txt) 73) (= v 88)) (setq tong (+ tong 10)))
   ((and (> n 0) (= (nth (1- n) txt) 73) (= v 88)) (setq tong (+ tong 8)))
   (t (setq tong (+ tong (cdr (assoc v as))))) )      
      )
    (entmod (subst (cons 1 (itoa tong)) (assoc 1 (entget dt)) (entget dt))) 
  )
  
  (setq ssl (vl-remove-if-not  '(lambda(x)
       (vl-remove nil (mapcar '(lambda(y) (vl-string-search y (cdr (assoc 1 (entget x))))) '("I" "V" "X"))))
     (acet-ss-to-list (ssget '((0 . "TEXT"))))))
  (mapcar 'demsolama ssl)
  (princ)
)

một khó khăn hơn nhờ các bác giúp

Lisp Vẽ đường PLINE nối tọa độ đầu các đường dóng LINE tăng dần theo trục X file dinh kem

http://www.cadviet.com/upfiles/3/132623_pline_3.dwg

Hề hề hề,

Code nháp để bạn test thử,...

một khó khăn hơn nhờ các bác giúp

Lisp Vẽ đường PLINE nối tọa độ đầu các đường dóng LINE tăng dần theo trục X file dinh kem

http://www.cadviet.com/upfiles/3/132623_pline_3.dwg

Hề hề hề,

Code nháp để bạn test thử, nếu Ok sẽ hoàn thiện sau.

(defun c:vpl ()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(alert "\n Chon cac line can moi")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "line")))))
(setq plst (list))
(foreach e ssl
(setq elst (entget e)
          p1 (cdr (assoc 10 elst))
          p2 (cdr (assoc 11 elst)) )
(if (< (cadr p1) (cadr p2)) 
    (setq plst (append plst (list p1)))
    (setq plst (append plst (list p2)))
)
)
(setq plst (vl-sort plst '(lambda (x y) (< (car x) (car y)))))
(command "pline")
(foreach p plst
     (command p)
)
(command "")
(setvar "osmode" oldos)
(princ)
)

 ;;Ham ve mc cac thanh thep
(defun mcthep (pd pc d n)
 (setq old (getvar "osmode"))
 (setvar "osmode" 0)
 (setq kc (/ (- (distance pd pc) d) (- n 1)))
 (command ".line" pd pc "")
 
 (setq  a (angle pd pc)
  pd (list (+ (car pd) (/ d 2)) (+ (cadr pd) (/ d 2)))
 )
 
 (repeat n
  (command ".donut" 0 d pd c^)
  (setq pd(polar pd a kc))
 )
 ;;(command ".donut" 0 d (polar pc (+ a (* pi 0.75)) d) c^)
 (setvar "osmode" old)
)
;;Ham ve thep dai va thep chiu luc cua dam...
>>

 ;;Ham ve mc cac thanh thep
(defun mcthep (pd pc d n)
 (setq old (getvar "osmode"))
 (setvar "osmode" 0)
 (setq kc (/ (- (distance pd pc) d) (- n 1)))
 (command ".line" pd pc "")
 
 (setq  a (angle pd pc)
  pd (list (+ (car pd) (/ d 2)) (+ (cadr pd) (/ d 2)))
 )
 
 (repeat n
  (command ".donut" 0 d pd c^)
  (setq pd(polar pd a kc))
 )
 ;;(command ".donut" 0 d (polar pc (+ a (* pi 0.75)) d) c^)
 (setvar "osmode" old)
)
;;Ham ve thep dai va thep chiu luc cua dam mong
(defun vdai (p1 a b n1 n2 d)
 (setq old (getvar "osmode"))
 (setvar "osmode" 0)
 (command ".rectangle" p1 (list (+ (car p1) a) (+ (cadr p1) b)))
 (setq  kc (/ (- a d) (- n1 1))
  p1 (list (+ (car p1) (/ d 2)) (+ (cadr p1) (/ d 2)))
 )
 ;(princ n1)
 (setq p p1)
 (repeat n1
  (command ".donut" 0 d p c^)
  (setq p (polar p 0 kc))
 );end of repeat1
 (setq p (polar p1 (/ pi 2) (- b d)))
 (repeat n1
  (command ".donut" 0 d p c^)
  (setq p (polar p 0 kc))
 );end of repeat2
 (setq  kc (/ (- b d) (- n2 1)))
 (setq p (polar p1 (/ pi 2) kc))
 (repeat (- n2 1)
  (command ".donut" 0 d p c^)
  (setq p (polar p (/ pi 2) kc))
 );end of repeat3
 (setq p (polar p1 0 (- a d)))
 (setq p (polar p (/ pi 2) kc))
 (repeat ( - n2 1)
  (command ".donut" 0 d p c^)
  (setq p (polar p (/ pi 2) kc))
 );end of repeat4
 
 (setvar "osmode" old)
)
;; Chuong trinh chinhs vex mc mongs
(defun c:mcm ()
	(initget 1 "MC MB")
   (setq res (getkword "\n<M.BANG/M.COT><MB/MC>:"))
 (setq   p1 (getpoint "\nDiem chen:")
  l1 (getreal "\nBe rong mong:")
  l2 (getreal "\nBe rong co mong:")
  l3 (/ (- l1 l2) 2)
  h1 (getreal "\nChieu cao ben mong:")
  h2 (getreal "\nChieu cao phan nghieng:")
  h3 (getreal "\nChieu cao co mong:")
  bv (getreal "\nBe day lop bao ve:")
  d (getreal "\nDuong kinh thep:")
  n (getint "\nS.luong thep day mong:")
 l (getreal "\nLop Be tong lot:")
 )
 (setq old (getvar "osmode"))
 (setvar "osmode" 0)
 (setq p (polar p1 pi l))
 (setq p (polar p (/ (- 0 pi) 2) l))
 (command  ".rectangle" p (list (+ (car p) ( * 2 l) l1) (+ (cadr p) l)))
 (command  ".pline" p1 "W" 0 0 (setq p (polar p1 (/ pi 2) h1)) (setq p (list (+ (car p) l3) (+ (cadr p) h2))) (setq p (polar p (/ pi 2) h3)) ""
 )
 (command ".mirror" "l" "" (setq p (polar p1 0 (/ l1 2))) (setq p (polar p (/ pi 2) (/ l1 2))) "")
 
 (IF (= res "MB")
  (progn
   (setq pd (list (+ (car p1) bv) (+ (cadr p1) bv))
   	pc (polar pd 0 (* (- l1 (* 4 bv) l2) 0.5))
 )
  (mcthep pd pc d (fix (* n 0.5)))
 
  (command ".line" pc (setq pc (polar pc 0 (+ l2 (* 2 bv))))  "")
  (setq pd (polar pd 0 (- l1 (* 2 bv))))
 
 (mcthep pc pd d (fix (* n 0.5)))
   (setq  p (list (+ (car p1) l3 bv) (+ (cadr p1) d bv))
	a (- l2 (* 2 bv))
	b (- (+ h1 h2 h3) (* 2 bv) d)
	n1 (getint "\nS.luong thep ngang dam mong:")
	n2 (getint "\nS.luong thep doc dam mong:")
   )
   (vdai p a b n1 n2 d)
  );end of progn1
  (progn
 	(setq pd (list (+ (car p1) bv) (+ (cadr p1) bv))
  pc (polar pd 0 (- l1 (* 2 bv)))
 )
 (mcthep pd pc d n)
   (setq p (list (+ (car p1) l3 bv (- 0 (* 10 d))) (+ (cadr p1) (* 2 d) bv))); end of setq
   (command ".pline" p "W" 0 0  (setq p (polar p 0 (* 10 d)))
	(setq p (polar p (/ pi 2) (+ h1 h2 h3 (* 20 d) (- 0 (* 2 d)  bv))))
	(setq p (polar p (/ (- 0 pi) 4) (* 2 d))) ""
   ); end of co
   (command ".mirror" "l" "" (setq p (polar p1 0 (/ l1 2))) (setq p (polar p (/ pi 2) (/ l1 2))) ""  ); end of co
  );end of progn2
 
 ); end of if
 (setvar "osmode" old)
)

Việc này cũng có thể giải quyết bằng lisp. Tôi không rành lắm về lệnh của cad, có thể có lệnh nào đó giải quyết vấn đề này nhưng tạm thời bạn dùng cái lisp dưới đây.

Tuy nhiên có vài vấn đề cần đặt ra là :

1. Trong ô ngày tháng (02/07/2014) và scale của bản vẽ (1:20) trong file excel bạn phải cho format của nó là text (thêm dấu ' đằng trước) , nếu không cad sẽ hiểu đó là...

Việc này cũng có thể giải quyết bằng lisp. Tôi không rành lắm về lệnh của cad, có thể có lệnh nào đó giải quyết vấn đề này nhưng tạm thời bạn dùng cái lisp dưới đây.

Tuy nhiên có vài vấn đề cần đặt ra là :

1. Trong ô ngày tháng (02/07/2014) và scale của bản vẽ (1:20) trong file excel bạn phải cho format của nó là text (thêm dấu ' đằng trước) , nếu không cad sẽ hiểu đó là số chứ không phải text.

2. File dwg và xls ở cùng thư mục và file excel tên là Link.xlsx. Nếu bạn làm 100 cái khung thì nên copy 100 cái khung đó trong cùng bản vẽ, đồng thời ghi 100 dòng trong file excel tương ứng. Tức là khi làm việc chỉ có 1 file cad và 1 excel thôi.

3. Còn 1 vấn đề tôi chưa giải quyết được là font chữ, tức là chữ tiếng việt có dấu không hiển thị được, cái này tính sau.

Lisp sẽ hỏi số dòng trong file excel (ở ví dụ này là 2), sau đó nhấp vào cái Attribute Block, nó sẽ điền thông tin từ excel vào cad.

Cái này có thể làm hàng loạt nếu trong Dynamic Block của bạn có thêm 1 cái att ghi số dòng (từ 2 -> 101 chẳng hạn), hoặc bạn dùng att có sẵn sửa số cũng được.

(defun c:tmp()
 (setq l0 (list "$DWGNAME1" "$R_DAY0" "$R_DESCR0" "$R_DWR0" "$R_CHK0" "$R_APP0"  "$SCALES"  "$FORMAT"
"$R_DAY0_1" "$TITLE_1" "$TITLE_2" "$TITLE_3"  "$TITLE_4" "$DWGNAME1" "$NR1")
       row (getint "\nChon dong trong file Excel:")
       col 0)
 
 (setq excel (vlax-create-object "Excel.Application")  
       currworkbook (vlax-invoke-method (vlax-get-property excel 'Workbooks)
'Open (strcat (getvar 'dwgprefix) "Link.xlsx"))
       cells (vlax-get-property (vlax-get-property excel 'ActiveSheet) 'Cells))
 (setq l1 (mapcar '(lambda(x) (cons x
(vlax-variant-value (vlax-get-property (vlax-variant-value (vlax-get-property cells 'ITem row (setq col (1+ col)))) 'Value)))) l0))
 
 (setq en (car (entsel "\nChon dynamic Block:")))
 (while (and (setq en (entnext en))
    (/= (cdr (assoc 0 (entget en))) "SEQEND"))
    (if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object en)) 'TagString)
    (setq tm (assoc (vla-get-TagString obj) l1)))
      (vla-put-TextString obj (cdr tm)))
 )
)
 
 

Vậy bạn thử cái lisp dưới đây. Vì các ống phân phối tuy nhiều layer khác nhau nhưng đều có màu cyan nên tôi chọn màu này để làm.

Khi chạy ct thì không nên quét toàn bộ bản vẽ , vì do bản vẽ lớn khó kiểm tra kết quả có đúng ý mình không, chỉ nên quét một khoảng nhỏ (tuỳ theo mắt mình nhìn).

(defun c:tnt(/ os mau tt10 tt11 tm tm1 ent it gd n kc)
 ...
>>

Vậy bạn thử cái lisp dưới đây. Vì các ống phân phối tuy nhiều layer khác nhau nhưng đều có màu cyan nên tôi chọn màu này để làm.

Khi chạy ct thì không nên quét toàn bộ bản vẽ , vì do bản vẽ lớn khó kiểm tra kết quả có đúng ý mình không, chỉ nên quét một khoảng nhỏ (tuỳ theo mắt mình nhìn).

(defun c:tnt(/ os mau tt10 tt11 tm tm1 ent it gd n kc)
  (defun dxf(id v) (cdr (assoc id (entget v))))
  (defun ints (o1 o2 mo / l0 l)
    (setq l (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo)
l0 nil)
    (while l
      (setq l0 (append l0 (list (list (car l) (cadr l) (caddr l))))
 l (cdddr l)))
    l0
  )
  (defun mau(/ l1 l0 ent)
    (command "-layer" "on" "*" "")
    (setq l0 '((0 . "LWPOLYLINE") (-4 . "<or")))
    (setq l1 (if (= 4 (cdr (assoc 62 (tblnext "LAYER" t))))
      (append nil (list (cons 8 (cdr (assoc 2 (tblnext "LAYER" t)))))) nil))
    (while (setq ent (tblnext "LAYER"))
      (if (= 4 (cdr (assoc 62 ent))) (setq l1 (append l1 (list (cons 8 (cdr (assoc 2 ent))))))))
    (append l0 (append l1 (list '(-4 . "or>"))))
  )
  ;;;
  (setq os (getvar 'osmode)
mau (mau))
  (setvar 'osmode 0)    
  (foreach x (acet-ss-to-list (ssget '((0 . "LINE") (8 . "DN ONG NGANH PE"))))
    (setq  tt10 (dxf 10 x)  tt11 (dxf 11 x))
    (if (setq tm (ssget "F" (list tt10 tt11) mau))
      (progn
        (setq ent (ssname tm 0))
        (if (setq it (ints x ent acextendnone))
 (setq gd (if (< (distance (car it) tt10) (distance (car it) tt11)) tt10 tt11)
tm (command "trim" ent "" (list x gd) ""))))
      (progn
        (setq n 1 kc 1 tm nil tm1 nil)
(while (not (or (setq tm (ssget "F" (list tt10 (polar tt10 (angle tt11 tt10) kc)) mau))
(setq tm1 (ssget "F" (list tt11 (polar tt11 (angle tt10 tt11) kc)) mau))))
 (setq kc (* (setq n (1+ n)) kc)))
(if tm (command "extend" (ssname tm 0) "" (list x tt10) ""))
(if tm1 (command "extend" (ssname tm1 0) "" (list x tt11) "")))
    )
  )
  (setvar 'osmode os)
  (princ)  
)
 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/2490-da-xong-tinh-tong-dien-tich-cac-hinh-tren-ban-ve-ed-vao-text-san-co/page-3
(defun c:udt(/ ss tong ham tmp tt hstl oldim toe frome cur dt)
(prompt "\n Kich thuoc cua chuong trinh tinh theo don vi mm ")
(if (not hstlo) (setq hstlo 0.001))
(setq hstl (getreal (strcat "\n Nhap ti le chuyen doi don vi <" (rtos hstlo 2 3) "> :")))
(if (not hstl) (setq hstl...
>>

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/2490-da-xong-tinh-tong-dien-tich-cac-hinh-tren-ban-ve-ed-vao-text-san-co/page-3
(defun c:udt(/ ss tong ham tmp tt hstl oldim toe frome cur dt)
(prompt "\n Kich thuoc cua chuong trinh tinh theo don vi mm ")
(if (not hstlo) (setq hstlo 0.001))
(setq hstl (getreal (strcat "\n Nhap ti le chuyen doi don vi <" (rtos hstlo 2 3) "> :")))
(if (not hstl) (setq hstl hstlo) (setq hstlo hstl))
(if (not tpo) (setq tpo 2))
(setq tp (getint (strcat "\n Nhap So chu so thap phan <" (itoa tpo) "> :")))
(if (not tp) (setq tp tpo) (setq tpo tp))
(setq oldim (getvar "Dimzin"))
(setvar "Dimzin" 0) 
(prompt "\n Chon doi tuong de tinh dien tich hay Enter de tinh dien tich theo Pick diem ")
(setq
ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>"))) 
tong 0.0
ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
tmp (mapcar 'ham (ss2ent ss)) 
)

(if (not ss) (progn
(setq tong 0.0 ss (ssadd))
(while (setq p (getpoint "\n Pick vao vung tinh dien tich :"))
(setq frome (entlast))
(command ".boundary" p "")
(setq toe (entlast))

(setq cur frome)
(while (not (eq cur toe))
(setq
cur (entnext cur)
ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq dt (getvar "area"))
(setq tong (+ tong dt))
)
(command "area" "A" "O" "L" "" "")
(setq dt (getvar "area"))
(setq tong (+ tong (* dt 2))) 
(sssetfirst ss ss)
)
(command "erase" ss "")
))


(setq tt (entget (car (entsel "\nChon text ket qua: ")))
tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
)
(entmod (subst (cons 1 (rtos (* (atof tong) hstl hstl) 2 tp)) (assoc 1 tt) tt))

(setvar "Dimzin" oldim)


(princ)
)
;
(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)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com) 

Mấy anh em giúp mình cái này với, chuyện là thế này, mình thấy trên diễn đàn có cái lisp tính tổng diện hay mà mình đang cần dùng nhưng nó không ghi ra TEXT trực tiếp mà phải chọn TEXT rồi chuyển TEXT chọn sang diện tích.

Anh e nào có thể giúp mình điều chỉnh lại khi pick xong diện tích chỉ cần ENTER rồi pick tiếp cái nữa là nhập chiều cao chữ rồi điền diện tích tại điểm pick được không, có mình đang cần.

file dinh kèm bên trên nhé !!!!!!!!!!!!!!!

Bạn thử lisp sau, chọn dimstyle nguồn qua 1 đối tượng của nó, sửa thông số, rồi chọn đối tượng thuộc dimstyle đích.

(defun c:ddi(/ a entg0 entg1 li tm name)
  (setq a (car (entsel "\nChon doi tuong thuoc dimstyle nguon:"))
entg0 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget a)))))
  (command "-dimstyle" "R" (cdr (assoc 3 (entget a))))
  (command "ddim")
  (setq entg1 (tblsearch "DIMSTYLE" (cdr (assoc 3...
>>

Bạn thử lisp sau, chọn dimstyle nguồn qua 1 đối tượng của nó, sửa thông số, rồi chọn đối tượng thuộc dimstyle đích.

(defun c:ddi(/ a entg0 entg1 li tm name)
  (setq a (car (entsel "\nChon doi tuong thuoc dimstyle nguon:"))
entg0 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget a)))))
  (command "-dimstyle" "R" (cdr (assoc 3 (entget a))))
  (command "ddim")
  (setq entg1 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget a))))
li (vl-remove nil (mapcar '(lambda(x y)
(if (not (equal x y)) y nil)) entg0 entg1)))
  
  (prompt "\nChon doi tuong thuoc dimstyle dich can doi:")
  (mapcar '(lambda(x)
    (setq name (cdr (assoc 3 (entget x)))
  tm (tblobjname "DIMSTYLE" name))
    (foreach y li
      (entmod (if (assoc (car y) (entget tm))
      (subst y (assoc (car y) (entget tm)) (entget tm))
      (append (entget tm) (list y)))))
    (command "-dimstyle" "R" name)
    (command "-dimstyle" "A" (ssget "X" (list '(0 . "DIMENSION") (cons 3 name))) ""))
 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "DIMENSION")))))))
  
  (princ)
)

Ủa bạn xài lisp nào vậy? cái của tôi đâu có hỏi vuông góc gì đâu!!

Thôi gửi lại cho chắc ăn. Lisp này có thể dùng với spline nhưng với cung tròn thì có thể sai vì trên cung tròn không có điểm đầu điểm cuối gì cả. Nếu cung tron thì bạn dùng lệnh array của cad cũng được rồi.

(defun c:rvx(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
  (defun thgoc (ent pt...
>>

Ủa bạn xài lisp nào vậy? cái của tôi đâu có hỏi vuông góc gì đâu!!

Thôi gửi lại cho chắc ăn. Lisp này có thể dùng với spline nhưng với cung tròn thì có thể sai vì trên cung tròn không có điểm đầu điểm cuối gì cả. Nếu cung tron thì bạn dùng lệnh array của cad cũng được rồi.

(defun c:rvx(/ pl ss dd dc cd tm sl el en ang dd1 ang1 os)
  (defun thgoc (ent pt / param)
    (if (setq param (vlax-curve-getParamAtPoint ent pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv ent param)) (/ pi 2))
      nil)
  )
  (command "ucs" "W")
  (setq pl (car (entsel "\nChon duong dan:")))
  (prompt "\nChon doi tuong can rai:")
  (setq ss (ssget)
dd (getpoint "\nDiem bat dau rai (nam tren duong dan) :")
dc (getpoint "\nDiem cuoi cung rai (nam tren duong dan) :")
cd (getreal "\nNhap buoc rai <Enter neu nhap so khoang rai>:")
tm (- (vlax-curve-getDistAtPoint pl dc) (vlax-curve-getDistAtPoint pl dd)))
  (if (< tm 0) (setq lenh -) (setq lenh +))
  (if (not cd)
    (setq sl (getint "\nNhap so khoang rai:")
 cd (/ (abs tm) sl))
    (setq sl (fix (/ (abs tm) cd))))
  
  (setq os (getvar "OSMODE"))  
  (setvar "OSMODE" 0)
  (repeat sl
    (setq el (entlast)
 ang (thgoc pl dd))
    (command "copy" ss "" dd (setq dd1 (vlax-curve-getPointAtDist pl
(lenh (vlax-curve-getDistAtPoint pl dd) cd))))
    (setq ss (ssadd)
 dd dd1
 ang1 (thgoc pl dd))
    (while (setq en (entnext el))
      (ssadd en ss)
      (setq el en))
    (command "rotate" ss "" dd "r" dd (polar dd ang 1) (polar dd ang1 1))
    )  
  (setvar "OSMODE" os) (command "ucs" "p")
  (princ)
)
 
 
 
 

Thuật toán trên không đúng trong trường hợp tổng quát là 2 line bất kỳ. Nếu 2 line // mà có phương // trục x hoặc y và ngược chiều nhau (VD explode 1 HCN) kết quả cũng sai.
Với 2 line AB và CD cần so sánh tổng AC+BD và AD+BC để quyết định

>>

Thuật toán trên không đúng trong trường hợp tổng quát là 2 line bất kỳ. Nếu 2 line // mà có phương // trục x hoặc y và ngược chiều nhau (VD explode 1 HCN) kết quả cũng sai.
Với 2 line AB và CD cần so sánh tổng AC+BD và AD+BC để quyết định

không quan tâm 2 line co song song hay không, chỉ cần vẽ đường giữa là đủ.

Thêm osmode kẻo nguy hiểm.

(defun c:test(/ n ss l1 l2 cl)
....
(setq n 0)
(while (/= 2 n)
....

Trước khi xem Germany và Brasil đá bán kết, mời các bạn cùng thư giản với câu đố vui sau:

Trong mặt phẳng cho 4 điểm bất kỳ p1, p2, p3, p4.

Hãy thiết lập hàm kiểm tra xem 4 điểm đó có tạo thành 1 hình chữ nhật hay không? Hàm trả về T nếu nó tạo thành HCN, nil nếu không.

Điều kiện: càng ít...

>>

Trước khi xem Germany và Brasil đá bán kết, mời các bạn cùng thư giản với câu đố vui sau:

Trong mặt phẳng cho 4 điểm bất kỳ p1, p2, p3, p4.

Hãy thiết lập hàm kiểm tra xem 4 điểm đó có tạo thành 1 hình chữ nhật hay không? Hàm trả về T nếu nó tạo thành HCN, nil nếu không.

Điều kiện: càng ít cặp () càng có giá trị.

Hề hề hề,

Thử tài tí chơi.

(defun c:chk (/ p1 p2 p3 p4)
 (and (= (distance p1 p2) (distance p3 p4)) (= (distance p1 p3) (distance p2 p4)) (= (distance p1 p4) (distance p2 p3)))
)

Em tìm được lisp Flat trên diễn đàn để chuyển Z=0 rồi ạ.:D
Cảm ơn các bác, các anh em.:D

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/54646-yeu-cau-chuyen-cao-do-z-cua-cac-loai-doi-tuong-ve-z-0/
(defun c:flat ( / acsel elv ) (vl-load-com)
  (if (ssget "_X" (list (cons 410 (getvar 'CTAB))))
	(progn
  	(vlax-for obj
    	(setq acsel
      	(vla-get-ActiveSelectionSet
     ...
>>

Em tìm được lisp Flat trên diễn đàn để chuyển Z=0 rồi ạ.:D
Cảm ơn các bác, các anh em.:D

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/54646-yeu-cau-chuyen-cao-do-z-cua-cac-loai-doi-tuong-ve-z-0/
(defun c:flat ( / acsel elv ) (vl-load-com)
  (if (ssget "_X" (list (cons 410 (getvar 'CTAB))))
	(progn
  	(vlax-for obj
    	(setq acsel
      	(vla-get-ActiveSelectionSet
        	(vla-get-ActiveDocument (vlax-get-acad-object))
      	)
    	)
    	(foreach elv '(1e99 -1e99)
      	(vl-catch-all-apply 'vla-move
        	(list obj (vlax-3D-point '(0. 0. 0.)) (vlax-3D-point (list 0. 0. elv)))
      	)
    	)
  	)
  	(vla-delete acsel)
	)
  )
  (princ)
)

Bạn thử cái này. Khi nó hỏi "Phep tinh:" thì bạn gõ vào, thí dụ "+2" hay "-3" , "*4", "/5" thì nó sẽ đổi.

Cái này chỉ dùng với text, không dùng cho mtext và nếu trong chữ có nhiều số thì chỉ đổi số đầu tiên.

(defun C:ctnc(/ tg obj nd so nd1)
  (setvar 'dimzin 8)
  (setq tg (getstring "\nPhep tinh:" ))  
  (foreach v (vl-remove-if 'listp (mapcar 'cadr (ssnamex  (ssget (list...
>>

Bạn thử cái này. Khi nó hỏi "Phep tinh:" thì bạn gõ vào, thí dụ "+2" hay "-3" , "*4", "/5" thì nó sẽ đổi.

Cái này chỉ dùng với text, không dùng cho mtext và nếu trong chữ có nhiều số thì chỉ đổi số đầu tiên.

(defun C:ctnc(/ tg obj nd so nd1)
  (setvar 'dimzin 8)
  (setq tg (getstring "\nPhep tinh:" ))  
  (foreach v (vl-remove-if 'listp (mapcar 'cadr (ssnamex  (ssget (list '(0 . "TEXT") )))))
    (setq nd (vla-get-TextString (setq obj (vlax-ename->vla-object v)))
 so (rtos (atof (vl-list->string (mapcar '(lambda(x) (if (or (= 46 x) (<= 48 x 57)) x 32)) (vl-string->list nd)))))
 nd1 (rtos (cal (strcat so tg)))
 nd (vl-string-subst nd1 so nd)
    )
    (vla-put-TextString obj nd)
   )
)

Em có file CaD và em cần xuất cạnh của 1 cạnh như sau ạ

http://www.cadviet.com/upfiles/3/37777_nghiapeo.lsp

http://www.cadviet.com/upfiles/3/37777_thac_mac.dwg

Đây là file lisp và file CAD em thắc mắc ạ.

Em có file CaD và em cần xuất cạnh của 1 cạnh như sau ạ

http://www.cadviet.com/upfiles/3/37777_nghiapeo.lsp

http://www.cadviet.com/upfiles/3/37777_thac_mac.dwg

Đây là file lisp và file CAD em thắc mắc ạ.

Sẽ chẳng vấn đề gì khi như mọi file khác em dùng lisp trên xuất từng cạnh mình cần

Nhưng khi em xuất cạnh ở file CAD trên bằng Lisp ở trên luôn thì no hiện là hiện 3D length (Mục 3) = 2.58

Hay khi em dùng lệnh DI ( Distance ) thì nó hiện kết quả là 1.47

Nhưng chiều dài thực tế của line này là 0.37 (Mục 2 ) ạ. 

Bác nào giải thích giúp em với.

Em dùng máy Toàn đạc điện tử Gowin xuất ra tọa độ rồi triển điểm lên CAD ạ. @@

Nhiều file bị chứ k riêng file em ví dụ này.   =>> Các máy toàn đạc khác thì em chưa thử. @@

// Mong các bác giải thích cho em với. :(

Đây là nội dung lisp ạ.@@

(defun c:dd ( )
(command "undo" "be")
  (command "-style" "ktdt" "VNI-HELVE" "0" "1" "0" "n" "n")
  (if (null dolora)(setq dolora "1"))
(Setq temp T)
(While temp
(setq a (strcat "\nD lon text hien hanh la (" dolora ") /<Diem dau tien>: "))
(Initget "d D")
(setq str (getpoint a))
(Cond
  ((= str "d") (setq dolora (getstring (strcat"\nDo lon text <" dolora "> :"))))
  ((= str "D") (setq dolora (getstring (strcat"\nDo lon text <" dolora "> :"))))
   (Progn
  (Setq a str)
   (setq temp nil)
  )
)
)
 
(setq b (getpoint a"\nChon diem tiep theo: "))
(setq luubatdiem (getvar "osmode"))
  (setvar "osmode" 0)
	(setq doclora (atof dolora))
	(setq gocxeo(angle a B))
	(setq daiab (Distance a B))
	(setq c (polar a gocxeo (/ daiab 2)))
	(setq d (polar c (+ gocxeo (/ pi 2)) (/ doclora 4)))
 z
(command ".line" a b "")
(command "text" "j" "c" c doclora b (rtos daiab 2 2) "")
(command ".move" "last" "" c d)
(cond
((> gocxeo (/ pi 2)) (command ".rotate" "last" "" c 0))
)
(setvar "osmode" luubatdiem)
(command "undo" "end")
	(Princ)
)