Jump to content
InfoFile
Tác giả: Nguyen Hoanh
Bài viết gốc: 1347
Tên lệnh: %3Cspan+class%3Dsearchlite%3Eunanon%3C%2Fspan%3Eall %3Cspan+class%3Dsearchlite%3Eunanon%3C%2Fspan%3E
convert anonymous block to normal block
hôm nay gặp một bài toán khó, là hiệu chỉnh một block anonymous. Ví dụ trong file này: http://www.cadviet.com/upfiles/new_block3.zip

AutoCAD không cho chỉnh sửa block anonymous (là block có tên đầu bằng *, vd *U123).
May thay, tìm kiếm được lisp đổi block anonymous sang block bình thường tại trang http://www.draftsperson.net
dùng lệnh UnAnon hoặc UnAnonAll để biến một hoặc tất cả các block anonymous.
>>
hôm nay gặp một bài toán khó, là hiệu chỉnh một block anonymous. Ví dụ trong file này: http://www.cadviet.com/upfiles/new_block3.zip

AutoCAD không cho chỉnh sửa block anonymous (là block có tên đầu bằng *, vd *U123).
May thay, tìm kiếm được lisp đổi block anonymous sang block bình thường tại trang http://www.draftsperson.net
dùng lệnh UnAnon hoặc UnAnonAll để biến một hoặc tất cả các block anonymous.

Và sau đó dùng lệnh bedit hoặc refedit để hiệu chỉnh nó.
<<

Filename: 1347_%3Cspan+class%3Dsearchlite%3Eunanon%3C%2Fspan%3Eall_%3Cspan+class%3Dsearchlite%3Eunanon%3C%2Fspan%3E.lsp
Tác giả: lenhatanh
Bài viết gốc: 218566
Tên lệnh: cot
Cùng một lisp, hai bản vẽ hai định dạng khác nhau ?

(defun C:Cot (/ solan step che caotext daitext tiledo msso mss cdo pp p1)
(command "undo" "be")
(if (not tiled) (setq tiled 100.0))
(setq tiledo (getreal (strcat "\n TiLe Dung Ve <" (rtos tiled 2 0) ">...: ")))
(if tiledo (setq tiled tiledo))

(if (not mss) (setq mss 0.0))
(setq msso (getreal (strcat "\n Muc So Sanh Cua M.Cat <" (rtos mss 2 2) ">...: ")))
...
>>

(defun C:Cot (/ solan step che caotext daitext tiledo msso mss cdo pp p1)
(command "undo" "be")
(if (not tiled) (setq tiled 100.0))
(setq tiledo (getreal (strcat "\n TiLe Dung Ve <" (rtos tiled 2 0) ">...: ")))
(if tiledo (setq tiled tiledo))

(if (not mss) (setq mss 0.0))
(setq msso (getreal (strcat "\n Muc So Sanh Cua M.Cat <" (rtos mss 2 2) ">...: ")))
(if msso (setq mss msso))
(setq cdo (getreal "\n Cao Do Max Cua Duong D.Hinh...: "))
(setq di1 (getpoint "\n Diem Dat Thuoc...: "))

(setq step (/ tiled 100)
che (- cdo mss)
solan (+ (fix (/ (* che 100) tiled)) 1) sl nil)
(command "Osmode" 0)
(setq p1 (polar di1 (/ pi 2) 1))
;;------------------------------ Ghi Text Truc --------------------
(command "_text" "J" "C" di1 "0" (strcat "mss: " (rtos mss 2 2)))
(repeat solan
(setq pp (polar p1 (- pi) 0.4) mss (+ mss step))
(command "color" 7 ".TEXT" "MR" pp "0" (rtos mss 2 2))
(setq p1 (polar p1 (/ pi 2) 1))
)
;;-----------------------------------------------------------------
(setq mss nil)
(command "Osmode" 33 "color" "Bylayer" "ortho" "on" "redraw")
(command "undo" "e")
(princ)
)


Tôi có lập một Lisp để ghi cột text so sánh cho mặt cắt như trên,
- Khi mở một bản vẽ mới thì Lisp ghi ra các text có hai số sau dấu phẩy kể cả số 0
(ví dụ: MSS: 70.00; 70.50; 71.00...) - Xem chi tiết trong B.vẽ No1.dwg.
- Nhưng khi sử dụng lisp cho một số bản vẽ cũ và đơn vị khác gửi đến thì Lisp ghi ra các text có định dạng khác,
không còn số 0 sau dấu phẩy (ví dụ: MSS: 70; 70.5; 71...) - Xem chi tiết trong B.vẽ No2.dwg.
Nhờ các Bạn chỉ dùm tại sao kết quả lại có sự khác nhau giữa hai bản vẽ khi dùng lisp...
Link đến file CAD: http://www.mediafire.com/download.php?hpyjeh9rdu2n3pe
<<

Filename: 218566_cot.lsp
Tác giả: ndtnv
Bài viết gốc: 240539
Tên lệnh: test
làm thế nào để nối hatch???

Bác Hoành có thể sửa được lỗi này không: khi các hatch giao nhau, ta dùng lệnh merge hatch thì tại các khoảng giao nhau đó sẽ thành khoảng trắng. (ý em là phải union hach kia chứ không phải merge hatch undecided.gif...

>>

Bác Hoành có thể sửa được lỗi này không: khi các hatch giao nhau, ta dùng lệnh merge hatch thì tại các khoảng giao nhau đó sẽ thành khoảng trắng. (ý em là phải union hach kia chứ không phải merge hatch undecided.gif )

Bạn dùng thử MergeHatch sau của hmsilva

http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Hatch-merge-split/td-p/3823971

(defun c:test (/ ss zer ss1 hpb olde itm ent bou ss2)
  (alert
    "\n            Select hatch to Merge.\n\nFirst one will be the Properties Source."
  )
  (if (setq ss (ssget ":L" '((0 . "HATCH"))))
    (progn
      (command "_.undo" "_BE")
      (setq olde (getvar 'cmdecho)
	    hpb	 (getvar 'hpbound)
	    itm	 -1
	    ss1	 (ssadd)
	    zer	 (entlast)
      )
      (ssadd zer ss1)
      (setvar 'hpbound 0)
      (setvar 'cmdecho 0)
      (while
	(setq ent (ssname ss (setq itm (1+ itm))))
	 (command ".-hatchedit" ent "b" "r" "y")
      );; while
      (while
	(setq zer (entnext zer))
	 (ssadd zer ss1)
      );; while
      (ssdel (ssname ss1 0) ss1)
      (command "_.union" ss1 "")
      (setq bou (entlast))
      (command "_.hatch" "solid" "l" "")
      (setq ss2 (ssget "_L"))
      (command "_.copy"
	       (ssname ss 0)
	       ""
	       "0,0,0"
	       "0,0,0"
	       "_.erase"
	       "p"
	       ""
	       "_.matchprop"
	       "L"
	       ss2
	       ""
	       "_.draworder"
	       ss2
	       ""
	       "b"
	       "_.erase"
	       "L"
	       bou
	       ss
	       ""
      )
    );; progn
  );; if
  (command "_.undo" "_E")
  (setvar 'hpbound hpb)
  (setvar 'cmdecho olde)
  (princ)
);; test

<<

Filename: 240539_test.lsp
Tác giả: TaiNguyen79
Bài viết gốc: 240666
Tên lệnh: dimvg
Lisp dim góc vát
Có lẽ đây là thứ bạn cần :
(Chịu kho pick điểm 1 tý cho lành. còn chọn hàng loạt pline rất không ổn vì hay phát sinh những điểm rất xa)
 
(defun c:dimvg (/ osm p1 p2 p3 p4 pt1 pt2 intp d1 d2 a1 a2 di1 di2 ai1 ai2 goc1 goc2 canh1 canh2)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 1)
  (setq p1 (getpoint "\nPick diem 1 :") p2 (getpoint "\nPick diem 2 :") p3 (getpoint "\nPick diem 3 :") p4 (getpoint "\nPick diem 4 :"))
  (setq...
>>
Có lẽ đây là thứ bạn cần :
(Chịu kho pick điểm 1 tý cho lành. còn chọn hàng loạt pline rất không ổn vì hay phát sinh những điểm rất xa)
 
(defun c:dimvg (/ osm p1 p2 p3 p4 pt1 pt2 intp d1 d2 a1 a2 di1 di2 ai1 ai2 goc1 goc2 canh1 canh2)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 1)
  (setq p1 (getpoint "\nPick diem 1 :") p2 (getpoint "\nPick diem 2 :") p3 (getpoint "\nPick diem 3 :") p4 (getpoint "\nPick diem 4 :"))
  (setq pt1 nil pt2 nil)
  (setvar "osmode" 0)
  (if (setq intp (inters p1 p2 p3 p4 nil))
    (progn
      (setq d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p3 p4))
      (setq di1 (distance p1 intp) di2 (distance p3 intp) ai1 (angle p1 intp) ai2 (angle p3 intp))
      (cond
        ((and (and (equal ai1 a1 0.00001) (> di1 d1)) (and (equal ai2 a2 0.00001)(> di2 d2))) (setq pt1 p2 pt2 p4))
        ((and (and (equal ai1 a1 0.00001) (> di1 d1)) (/= ai2 a2)) (setq pt1 p2 pt2 p3))
        ((and (/= ai1 a1) (and (equal ai2 a2 0.00001)(> di2 d2))) (setq pt1 p1 pt2 p4))
        ((and (/= ai1 a1) (/= ai2 a2)) (setq pt1 p1 pt2 p3))
        (T (setq pt1 nil pt2 nil))
        );cond
      (if (and pt1 pt2)
        (progn
          (setq goc1 (angle pt1 intp) goc2 (angle pt2 intp) canh1 (distance pt1 intp) canh2 (distance pt2 intp))
          (command "donut" "0.0" 0.25 intp "") (command "donut" "0.0" 0.25 pt1 "") (command "donut" "0.0" 0.25 pt2 "")
          (entmod (entmake (list (cons 0 "LINE")  (cons 100 "AcDbLine") (list 10 (nth 0 pt1) (nth 1 pt1) (nth 2 pt1)) (list 11 (nth 0 intp) (nth 1 intp) (nth 2 intp)))))
          (entmod (entmake (list (cons 0 "LINE")  (cons 100 "AcDbLine") (list 10 (nth 0 intp) (nth 1 intp) (nth 2 intp)) (list 11 (nth 0 pt2) (nth 1 pt2) (nth 2 pt2)))))
          (if (or (<= (* (/ goc1 pi) 180) 90) (>= (* (/ goc1 pi) 180) 270))
            (command ".text" "M" (polar (polar pt1 goc1 (/ canh1 2.0)) (+ goc1 (/ Pi 2.0)) 1.0) 1.0 (* (/ goc1 pi) 180) (rtos canh1 2 2) "")
            (command ".text" "M" (polar (polar pt1 goc1 (/ canh1 2.0)) (- goc1 (/ Pi 2.0)) 1.0) 1.0 (- (* (/ goc1 pi) 180) 180) (rtos canh1 2 2) "")
            )
          (if (or (<= (* (/ goc2 pi) 180) 90) (>= (* (/ goc2 pi) 180) 270))
            (command ".text" "M" (polar (polar pt2 goc2 (/ canh2 2.0)) (+ goc2 (/ Pi 2.0)) 1.0) 1.0 (* (/ goc2 pi) 180) (rtos canh2 2 2) "")
            (command ".text" "M" (polar (polar pt2 goc2 (/ canh2 2.0)) (- goc2 (/ Pi 2.0)) 1.0) 1.0 (- (* (/ goc2 pi) 180) 180) (rtos canh2 2 2) "")
            )
          )
        (princ "\nGoc vat khong hop le !"))
      );prgn
    (princ "\nHai doan thang song song !"));if
  (setvar "osmode" osm))
<<

Filename: 240666_dimvg.lsp
Tác giả: longduonghoang
Bài viết gốc: 10170
Tên lệnh: ss
phần mềm xem TV online cực đỉnh!!!!!

em ko hiểu tại sao nhưng pác thử cài lại xem sao
vì em dùng thì chưa có vấn đề gì nhưng thằng bạn em đôi khi vẫn gặp 1 chút rắc rối với JLC's internet

Filename: 10170_ss.lsp
Tác giả: nhoclangbat
Bài viết gốc: 214903
Tên lệnh: bt2-1 bt2-2
Chữa bài tập chương 2

anh ketxu xem giup em lai lan nua với, đúng là học này khó thật


còn đây là lsp

; baitap2-1
(defun c:bt2-1 (/ x y z e)
(setq x (+ 2 7))
(setq y (- 3 1.25))
(setq z 5.0)
(setq e (+ (* (- x y) 0.4) z))
(tong x y z e)
)
(defun tong ( x y z e)
(+ x y z e)
)
;baitap 2-2
;tinh dien tich tam giac
(defun c:bt2-2 (/ a b c)
(setq a 1000)
(setq b 2000)
(setq c (*...
>>
anh ketxu xem giup em lai lan nua với, đúng là học này khó thật


còn đây là lsp

; baitap2-1
(defun c:bt2-1 (/ x y z e)
(setq x (+ 2 7))
(setq y (- 3 1.25))
(setq z 5.0)
(setq e (+ (* (- x y) 0.4) z))
(tong x y z e)
)
(defun tong ( x y z e)
(+ x y z e)
)
;baitap 2-2
;tinh dien tich tam giac
(defun c:bt2-2 (/ a b c)
(setq a 1000)
(setq b 2000)
(setq c (* (* a B) 0.5)
)
(defun tbcongbaso ( a b c)
(/ (+ a b c) 3.0)
)
(defun zientich ( a B)
(* (* a B) 0.5)
)
;tich cua 4 so
(defun tich ( a b c d)
(* a b c d)
)
;tinh lap phuong 1 so
(defun lapphuong ( a)
(* a a a)
)
)

<<

Filename: 214903_bt2-1_bt2-2.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 240790
Tên lệnh: ha
Lisp tinh toan momen quan tinh xoan(J) cua tiet dien bat ky

Tôi nhớ đã post cái này 1 lần, nhưng giờ quên link nên đành post lại. Hy vọng đúng ý bạn. Và nếu đúng thì xin nhận hậu tạ bằng LIKE cho gọn.

;Doan Van Ha - CADViet.com
;Tinh cac dac trung hinh hoc cua Polyline kin hoac Region.
(defun C:HA() 
 (setq obj (vlax-ename->vla-object (car (entsel "\Chon doi tuong kin (Polyline hoac Region): "))))
 (VxGetMassProps Obj))
(defun VxGetMassProps (Obj /...
>>

Tôi nhớ đã post cái này 1 lần, nhưng giờ quên link nên đành post lại. Hy vọng đúng ý bạn. Và nếu đúng thì xin nhận hậu tạ bằng LIKE cho gọn.

;Doan Van Ha - CADViet.com
;Tinh cac dac trung hinh hoc cua Polyline kin hoac Region.
(defun C:HA() 
 (setq obj (vlax-ename->vla-object (car (entsel "\Chon doi tuong kin (Polyline hoac Region): "))))
 (VxGetMassProps Obj))
(defun VxGetMassProps (Obj / DelFlg ResLst TmpObj)
 (or Gb:AcO (setq Gb:AcO (vlax-get-acad-object)))
 (or Gb:AcD (setq Gb:AcD (vla-get-activedocument Gb:AcO)))
 (if (member (vla-get-ObjectName Obj) '("AcDb2dPolyline" "AcDbPolyline"))
  (setq DelFlg T
        TmpObj (vlax-safearray-get-element  (vlax-variant-value (vla-AddRegion (vla-get-ModelSpace Gb:AcD) (VxListToArray (list Obj) vlax-vbObject))) 0))
  (setq TmpObj Obj))
 (setq ResLst (append
               (list
                (vlax-get TmpObj 'Centroid)
                (vlax-get TmpObj 'RadiiOfGyration)
                (setq a (vlax-get TmpObj 'PrincipalDirections))
                (vlax-get TmpObj 'PrincipalMoments)
                (vlax-get TmpObj 'MomentOfInertia))
               (if (= (vla-get-ObjectName TmpObj) "AcDbRegion")
                (list
                 (vla-get-ProductOfInertia TmpObj)
                 (vla-get-Area TmpObj)
                 (vla-get-Perimeter TmpObj))
                (list
                 (vlax-get TmpObj 'ProductOfInertia)
                 (vla-get-Volume TmpObj)
                 nil))))
 (if DelFlg (vla-delete TmpObj))
 (princ "\n\nKET QUA TINH: ")
 (princ "\n1). Centroid: ")
 (princ "\n X: ") (princ (car (nth 0 Reslst)))
 (princ "\n Y: ") (princ (cadr (nth 0 Reslst)))
 (princ "\n2). Radii Of Gyration: ")
 (princ "\n X: ") (princ (car (nth 1 Reslst)))
 (princ "\n Y: ") (princ (cadr (nth 1 Reslst)))
 (princ "\n3). Principal Directions: ")
 (princ "\n ") (princ (car (nth 2 Reslst)))
 (princ "\n ") (princ (cadr (nth 2 Reslst)))
 (princ "\n ") (princ (caddr (nth 2 Reslst)))
 (princ "\n ") (princ (nth 3 (nth 2 Reslst)))
 (princ "\n4). Principal Moments: ")
 (princ "\n I: ") (princ (car (nth 3 Reslst)))
 (princ "\n J: ") (princ (cadr (nth 3 Reslst)))
 (princ "\n5). Moment Of Inertia: ")
 (princ "\n X: ") (princ (car (nth 4 Reslst)))
 (princ "\n Y: ") (princ (cadr (nth 4 Reslst)))
 (princ "\n6). Product Of Inertia: ")
 (princ (nth 5 Reslst))
 (princ "\n7). Area: ")
 (princ (nth 6 Reslst))
 (princ "\n8). Perimeter: ")
 (princ (nth 7 Reslst))
 (textpage))
; (princ))
; ResLst=((70.5309 25.7049) (25.7963 70.5906) (0.966567 0.256415 -0.256415 0.966567) (285.635 561.65) (42933.0 321491.0) 116901.0 64.5172 37.4259)
;-----
(defun VxListToArray (Lst Typ)
 (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray Typ (cons 0 (1- (length Lst)))) Lst)))
 

<<

Filename: 240790_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 240912
Tên lệnh: ha
Lisp thống kê đoạn thẳng

Sửa cho bạn đây. Lisp có thể dùng cho Line, Polyline, Lwpolyline, Spline.

;Doan Van Ha - CADViet.com - Ngay 16/5/2012. Edit 11/7/2013
;Muc dich: nhom cac doi tuong *Line cung Length va cung Layer, sau do xuat ra file.
(defun C:HA( / entlst lst fn pw)
(princ "\nChon cac doi tuong de lay chieu dai can xuat ra file...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "*LINE")))))))
(foreach ent...
>>

Sửa cho bạn đây. Lisp có thể dùng cho Line, Polyline, Lwpolyline, Spline.

;Doan Van Ha - CADViet.com - Ngay 16/5/2012. Edit 11/7/2013
;Muc dich: nhom cac doi tuong *Line cung Length va cung Layer, sau do xuat ra file.
(defun C:HA( / entlst lst fn pw)
(princ "\nChon cac doi tuong de lay chieu dai can xuat ra file...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "*LINE")))))))
(foreach ent entlst
 (setq lst (cons (list (cdr (assoc 8 (entget ent))) (atof (rtos (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) 2 4))) lst)))
(setq lst (LM:ListOccurrences lst))
(setq fn (getfiled "Chon file de xuat ket qua" "" "xls" 1))
(setq pw (open fn "w"))
(write-line (strcat "Chieu dai" "\t" "So luong" "\t" "Layer") pw)
(foreach n lst
  (write-line (strcat (vl-prin1-to-string (cadr (car n))) "\t" (itoa (cdr n)) "\t" (car (car n))) pw))
(close pw) )
(defun LM:ListOccurrences (lst) ;Thank Lee Mac
(if lst
  (cons
   (cons (car lst) (- (length lst) (length (vl-remove (car lst) (cdr lst)))))
   (LM:ListOccurrences (vl-remove (car lst) (cdr lst))))))
 

<<

Filename: 240912_ha.lsp
Tác giả: Thaistreetz
Bài viết gốc: 109486
Tên lệnh: edtn
Viết lisp theo yêu cầu [phần 2]

EDTN : Edit trắc ngang. Code này mình viết khá lâu rồi nên rác, một vài truờng hợp có thể sảy ra lỗi khi chay nếu truớc khi chạy tuyến trong nova bạn không chạy lệnh NS - "Cài đặt các thông số ban đầu"
(Không hiểu sao Hài Hoà không thiết lập lệnh này tự chạy khi thiết lập bản vẽ, trong nhiều truờng hợp, việc chạy lệnh này truớc khi chạy tuyến là bắt buộc, nếu không thì toàn...
>>

EDTN : Edit trắc ngang. Code này mình viết khá lâu rồi nên rác, một vài truờng hợp có thể sảy ra lỗi khi chay nếu truớc khi chạy tuyến trong nova bạn không chạy lệnh NS - "Cài đặt các thông số ban đầu"
(Không hiểu sao Hài Hoà không thiết lập lệnh này tự chạy khi thiết lập bản vẽ, trong nhiều truờng hợp, việc chạy lệnh này truớc khi chạy tuyến là bắt buộc, nếu không thì toàn bộ quá trình thiết kế sau đó sẽ tạo ra rất nhiều lỗi và buộc fải xoá toàn bộ tuyến rồi chạy lại)
Khi chạy lệnh, tại dòng nhắc : "Quét chọn trắc ngang cần sửa", bạn kéo chuột từ trái qua fải như hình vẽ để chọn đủ đối tuợng.

<<

Filename: 109486_edtn.lsp
Tác giả: hochoaivandot
Bài viết gốc: 240972
Tên lệnh: ttt
Nhờ viết lisp explode các đường polyline.

Ri được không?

(defun C:ttt()

(command "explode" (ssget "X" (list (cons 0 "*POLYLINE"))))

)


Filename: 240972_ttt.lsp
Tác giả: duy267
Bài viết gốc: 240974
Tên lệnh: ep
Nhờ viết lisp explode các đường polyline.

Bạn thử lisp này.

(defun c:EP (/ ss index n ent)
  (command ".undo" "BE")
  (setvar "CMDECHO" 0)
  (setq ss (ssget "X" '((0 . "*POLYLINE"))))
  (setq index (sslength ss))
  (setq n 0)
  (repeat index
    (setq ent (ssname ss n))
    (command ".EXPLODE" ent "")
    (setq n (1+ n))
  )
  (command ".undo" "E")
  (princ)
)
(princ "L\U+1EC7nh ph\U+00E1 to\U+00E0n b\U+1ED9 PILYLINE tr\U+00EAn b\U+1EA3n v\U+1EBD")

Filename: 240974_ep.lsp
Tác giả: cd2k44
Bài viết gốc: 238768
Tên lệnh: cr
(Yêu cầu) xin lisp copy, move đối tượng rồi xoay

Gửi lại bạn

;;;copy va xoay doi tuong
(defun c:cr (/ goc dmoi gocxoay)
(prompt "\nChon doi tuong muon copy")
(ssget)
(setq dgoc (getpoint "\nChon diem goc:"))
(setq dmoi (getpoint "\nChon diem den moi:"))
(command "copy" "P" "" dgoc dgoc "")
(command "move" "p" "" dgoc dmoi "")
(setq gocxoay (/ (* (getangle "\nNhap goc xoay:") 180) pi))
(command "rotate" "P" "" dmoi gocxoay "")
)

Mình bở chế độ bắt điểm đi vì tránh...

>>

Gửi lại bạn

;;;copy va xoay doi tuong
(defun c:cr (/ goc dmoi gocxoay)
(prompt "\nChon doi tuong muon copy")
(ssget)
(setq dgoc (getpoint "\nChon diem goc:"))
(setq dmoi (getpoint "\nChon diem den moi:"))
(command "copy" "P" "" dgoc dgoc "")
(command "move" "p" "" dgoc dmoi "")
(setq gocxoay (/ (* (getangle "\nNhap goc xoay:") 180) pi))
(command "rotate" "P" "" dmoi gocxoay "")
)

Mình bở chế độ bắt điểm đi vì tránh lỗi bắt điểm.Khôi phục lại cho đúng ý bạn


<<

Filename: 238768_cr.lsp
Tác giả: HUNGENG
Bài viết gốc: 241013
Tên lệnh: ha
[Yêu Cầu] Lisp thống kê đoạn thẳng

Cảm ơn bạn nhiều. Lisp của bạn hay lắm. Nhưng mình có vài điểm nữa mong bạn giúp đỡ:

1. Bạn có thể cho them tính năng tính chiều dài cho arc nữa không.

2.Trong bảng Excel bạn cho mình thêm 1 cột STT và sẽ tự động đánh số lần lượt theo thứ tự mình chọn đường từ trên xuống dưới

3.Trong mục

>>

Cảm ơn bạn nhiều. Lisp của bạn hay lắm. Nhưng mình có vài điểm nữa mong bạn giúp đỡ:

1. Bạn có thể cho them tính năng tính chiều dài cho arc nữa không.

2.Trong bảng Excel bạn cho mình thêm 1 cột STT và sẽ tự động đánh số lần lượt theo thứ tự mình chọn đường từ trên xuống dưới

3.Trong mục http://www.cadviet.com/forum/topic/72563-yeu-cau-xin-lisp-copy-move-doi-tuong-roi-xoay/page-2 mình có nhờ mọi người giúp mình sửa 1 cái lisp. Bạn có thể xem giúp mình được không? Cảm ơn bạn nhiều.

 

 

 

 

Sửa cho bạn đây. Lisp có thể dùng cho Line, Polyline, Lwpolyline, Spline.

 

;Doan Van Ha - CADViet.com - Ngay 16/5/2012. Edit 11/7/2013
;Muc dich: nhom cac doi tuong *Line cung Length va cung Layer, sau do xuat ra file.
(defun C:HA( / entlst lst fn pw)
(princ "\nChon cac doi tuong de lay chieu dai can xuat ra file...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "*LINE")))))))
(foreach ent entlst
 (setq lst (cons (list (cdr (assoc 8 (entget ent))) (atof (rtos (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) 2 4))) lst)))
(setq lst (LM:ListOccurrences lst))
(setq fn (getfiled "Chon file de xuat ket qua" "" "xls" 1))
(setq pw (open fn "w"))
(write-line (strcat "Chieu dai" "\t" "So luong" "\t" "Layer") pw)
(foreach n lst
  (write-line (strcat (vl-prin1-to-string (cadr (car n))) "\t" (itoa (cdr n)) "\t" (car (car n))) pw))
(close pw) )
(defun LM:ListOccurrences (lst) ;Thank Lee Mac
(if lst
  (cons
   (cons (car lst) (- (length lst) (length (vl-remove (car lst) (cdr lst)))))
   (LM:ListOccurrences (vl-remove (car lst) (cdr lst))))))
 

<<

Filename: 241013_ha.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 241025
Tên lệnh: ha
Nhờ viết lisp explode các đường polyline.

Lisp expolde tất cả pline có trên bản vẽ, ngoại trừ các rectangle.

;; Explode tat ca Pline ma khong phai la rectangle.
;; Doan Van Ha - CadViet.com - 12/7/2013
(defun C:HA( / ss ent lst UniqueFuzz #SS->List)
 (defun UniqueFuzz (lst fz)
  (if lst 
   (cons (car lst) (UniqueFuzz (vl-remove-if '(lambda (x) (if (= 10 (car x)) (equal x (car lst) fz))) (cdr lst)) fz))))
 (defun #SS->List (ss / i lst)
  (repeat (setq i...
>>

Lisp expolde tất cả pline có trên bản vẽ, ngoại trừ các rectangle.

;; Explode tat ca Pline ma khong phai la rectangle.
;; Doan Van Ha - CadViet.com - 12/7/2013
(defun C:HA( / ss ent lst UniqueFuzz #SS->List)
 (defun UniqueFuzz (lst fz)
  (if lst 
   (cons (car lst) (UniqueFuzz (vl-remove-if '(lambda (x) (if (= 10 (car x)) (equal x (car lst) fz))) (cdr lst)) fz))))
 (defun #SS->List (ss / i lst)
  (repeat (setq i (sslength ss))
   (setq lst (cons (ssname ss (setq i (1- i))) lst))))
 (vl-load-com)
 (command "undo" "be")
 (if (setq ss (ssget "X" '((0 . "LWPOLYLINE"))))
  (foreach ent (#SS->List ss)
   (if (equal (vlax-curve-getEndPoint ent) (vlax-curve-getStartPoint ent) 1E-8)
    (entmod (subst (cons 70 1) (assoc 70 (entget ent)) (entget ent))))
   (entmod (UniqueFuzz (entget ent) 1E-8))
   (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
   (if
    (not
     (and
    (= (length lst) 4)
      (equal (distance (car lst) (caddr lst)) (distance (cadr lst) (cadddr lst)) 1E-8)
      (inters (car lst) (caddr lst) (cadr lst) (cadddr lst))))
(vla-Explode (vlax-ename->vla-object ent)))))
 (command "undo" "e") 
 (princ))
 

<<

Filename: 241025_ha.lsp
Tác giả: quansla
Bài viết gốc: 221310
Tên lệnh: at
Link diện tích,chiều dài đối tượng tới Mtext(phải Regen sau khi thay đổi)

Đây là code viết bởi vl

(defun c:AT (/ entObject entObjectID InsertionPoint ad)
(vl-load-com)
(setq entObject (vlax-ename->vla-object(car (entsel)))
entObjectID (Get-ObjectIDx64 entObject)
InsertionPoint (vlax-3D-Point (getpoint "Select point: "))
ad (vla-get-ActiveDocument (vlax-get-acad-object))
)
(vla-addMText
(if (= 1 (vla-get-activespace ad))
(vla-get-modelspace ad)
>>

Đây là code viết bởi vl

(defun c:AT (/ entObject entObjectID InsertionPoint ad)
(vl-load-com)
(setq entObject (vlax-ename->vla-object(car (entsel)))
entObjectID (Get-ObjectIDx64 entObject)
InsertionPoint (vlax-3D-Point (getpoint "Select point: "))
ad (vla-get-ActiveDocument (vlax-get-acad-object))
)
(vla-addMText
(if (= 1 (vla-get-activespace ad))
(vla-get-modelspace ad)
(if (= (vla-get-mspace ad) :vlax-true)
(vla-get-modelspace ad)
(vla-get-paperspace ad)
)
)
InsertionPoint 0.0
(strcat
"%<\\AcObjProp Object(%<\\_ObjId "
entObjectID
">%).Area \\f \"%pr2%lu2%qf1 %ps%zs8\">%"
)
)
(princ)
)

<<

Filename: 221310_at.lsp
Tác giả: girl
Bài viết gốc: 241014
Tên lệnh: jpl
Lisp chuyển Line sang PL !

EM đang cần viết cái lisp biến các line được chọn thành PL, Em viết không biết sai chỗ nào mà nó mới biến được 1 line chứ chưa biến được nhiều cái 1 lúc. Xin các anh sửa giúp em ạ :

;;;=========
(defun C:jpl() 
(SETQ SS (SSGET)) 
(command "pedit" "m" "y" ss "j")
(princ)
)

 

 

 

;;;=========
(defun C:jpl() 
(SETQ SS...
>>

EM đang cần viết cái lisp biến các line được chọn thành PL, Em viết không biết sai chỗ nào mà nó mới biến được 1 line chứ chưa biến được nhiều cái 1 lúc. Xin các anh sửa giúp em ạ :

;;;=========
(defun C:jpl() 
(SETQ SS (SSGET)) 
(command "pedit" "m" "y" ss "j")
(princ)
)

 

 

 

;;;=========
(defun C:jpl() 
(SETQ SS (SSGET)) 
(command "pedit" "m" "y" ss "j")
)

<<

Filename: 241014_jpl.lsp
Tác giả: TaiNguyen79
Bài viết gốc: 241112
Tên lệnh: vatgoc dimaligned
Lisp dim góc vát

Thanks a.
 
Mấy hôm nay bận quá nên không lên diễn đàn được. Cám ơn a về cái lisp, có điều lisp này không phù hợp với yêu cầu của e rồi ^^, e cần dimension luôn chứ không phải pline và text a ah.
 
Lisp mà e nhờ mọi người viết là tự dim góc vát chứ không phải là chọn điểm đâu a.

Thôi thì...
>>

Thanks a.
 
Mấy hôm nay bận quá nên không lên diễn đàn được. Cám ơn a về cái lisp, có điều lisp này không phù hợp với yêu cầu của e rồi ^^, e cần dimension luôn chứ không phải pline và text a ah.
 
Lisp mà e nhờ mọi người viết là tự dim góc vát chứ không phải là chọn điểm đâu a.

Thôi thì thế này nhé :

(defun vatgoc_tinhtoan (a b c d / osm p1 p2 p3 p4 pt1 pt2 intp d1 d2 a1 a2 di1 di2 ai1 ai2 kqua)
(setq pt1 nil pt2 nil p1 a p2 b p3 c p4 d)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(if (setq intp (inters p1 p2 p3 p4 nil))
(progn
(setq d1 (distance p1 p2) d2 (distance p3 p4) a1 (angle p1 p2) a2 (angle p3 p4))
(setq di1 (distance p1 intp) di2 (distance p3 intp) ai1 (angle p1 intp) ai2 (angle p3 intp))
(cond
((and (and (equal ai1 a1 0.00001) (> di1 d1)) (and (equal ai2 a2 0.00001)(> di2 d2))) (setq pt1 p2 pt2 p4))
(T (setq pt1 nil pt2 nil))
);cond
);prgn
);if
(setvar "osmode" osm)
(if (and pt1 pt2) (setq kqua (list pt1 pt2 intp))))
;-------------------------
(defun c:vatgoc_dimaligned (/ i Egss k cl lstpt vg lst_vg t1 p1 diem n )
(setq i 0)
(setq Egss (entget (car (entsel "\nChon pline :" ))))
(setq k (cdr (assoc 90 Egss)) cl (cdr (assoc 70 Egss)))
(setq lstpt '() vg '() lst_vg '())
(setq i 1)
(while (<= i k)
(progn
(setq t1 (member (assoc 10 Egss) Egss))
(setq p1 (car t1))
(setq Egss (cdr t1))
(setq diem (cdr p1))
(setq lstpt (append lstpt (list diem)))
(setq i (+ 1 i))));while
(setq k (length lstpt))
(if (< k 4) (exit))
(if (= cl 1) (setq lstpt (append lstpt (list (nth 0 lstpt)(nth 1 lstpt) (nth 2 lstpt)))))
(if (and (= cl 0) (equal (nth 0 lstpt) (nth (- k 1) lstpt)))
(setq lstpt (append lstpt (list (nth 1 lstpt) (nth 2 lstpt)))))
(setq k (length lstpt))
(setq n 0)
(while (< n (- k 3))
(repeat 4 (setq vg (append vg (list (nth n lstpt)))) (setq n (1+ n)))
(setq lst_vg (append lst_vg (list vg)) vg '())
(setq n (- n 3))
)
(setq k (length lst_vg) n 0)
(repeat k
(if (setq vgtt (vatgoc_tinhtoan (nth 0 (nth n lst_vg)) (nth 1 (nth n lst_vg)) (nth 3 (nth n lst_vg)) (nth 2 (nth n lst_vg))))
(progn (command "dimaligned" (nth 0 vgtt) (nth 2 vgtt)(nth 2 vgtt))
(command "dimaligned" (nth 1 vgtt) (nth 2 vgtt)(nth 2 vgtt)))
)
(setq n (1+ n))
)
)

PS: Dimstyle bạn tự khai báo phù hợp là đc
<<

Filename: 241112_vatgoc_dimaligned.lsp
Tác giả: TaiNguyen79
Bài viết gốc: 241129
Tên lệnh: ghikt
Xin lisp ghi kích thước tự động

Mình muốn xin diễn đàn viết giúp mình lisp ghi kích thước đoạn thẳng mà khi pick vào điểm đầu và điểm cuối của đoạn thẳng thì sẽ tự động ghi ra text kích thước tại trung điểm của đoạn thẳng với 1 khoảng cách nhất định. Mình xin cảm ơn.

Vấn đề này đã có nhiều rồi. tuy nhiên có lẽ...

>>

Mình muốn xin diễn đàn viết giúp mình lisp ghi kích thước đoạn thẳng mà khi pick vào điểm đầu và điểm cuối của đoạn thẳng thì sẽ tự động ghi ra text kích thước tại trung điểm của đoạn thẳng với 1 khoảng cách nhất định. Mình xin cảm ơn.

Vấn đề này đã có nhiều rồi. tuy nhiên có lẽ đoạn lsp sau đây là hợp với ý bạn :

;ghi kich thuoc
;Luu gia tri bien PTC trong bo nho dung de lay diem truoc do
;neu enter o buoc chon PT1 thi se lay PT1 la diem lien truoc (lastpoint)
(defun c:ghikt (/ OSM PT0 PT1 PT2 DIST A12 MID12)
(setq OSM (getvar "osmode"))
(if (null PTC) (setq PT0 (getvar "Lastpoint")) (setq PT0 PTC))
(setvar "osmode" 1)
(if (null (setq PT1 (getpoint "\nChon diem thu nhat :\n"))) (setq PT1 PT0))
(initget 1) (setq PT2 (getpoint PT1 "\nChon diem thu hai :\n"))
(setvar "osmode" 0)
(setq PTC PT2)
(if (equal PT1 PT2 0.001)
(princ "\nHai diem trung nhau\n")
(progn
(setq DIST (distance PT1 PT2) A12 (angle PT1 PT2) MID12 (polar PT1 A12 (/ DIST 2.0)))
(setq pt (polar MID12 (+ A12 (/ PI 2)) 1))
(if (or (<= A12 (/ PI 2)) (>= A12 (* PI 1.5)))
(command ".TEXT" "M" pt 1 (* (/ A12 pi) 180) (rtos DIST 2 2) "")
(command ".TEXT" "M" pt 1 (+ (* (/ A12 pi) 180) 180) (rtos DIST 2 2) ""))))
(setvar "osmode" OSM)(princ))


<<

Filename: 241129_ghikt.lsp
Tác giả: hochoaivandot
Bài viết gốc: 241154
Tên lệnh: ttt
Nhờ các bác sửa Lisp Copy đối tượng tới nhiều đường Polyline cho trước.

Bạn thử lisp này thử nhé:

(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem...
>>

Bạn thử lisp này thử nhé:

(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
)
(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
)
(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
)
(defun GetVer (e / i L)
(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)

(vl-load-com)

(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
)

)
(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
 
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
 
(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
 
(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
 
(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
 
(defun GetVer (e / i L)
(setq i 0 L nil)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
(defun C:ttt(/ ss_rai pt_rai ss n e lstPt x)
(princ "\nChon doi tuong muon rai")
(setq ss_rai (ssget))
(setq pt_rai (getpoint "\nChon diem chen"))
(princ "\nChon doi tuong duong dan")
(setq ss (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lstPt (GetVer e))
(foreach x lstPt (command "copy" ss_rai "" pt_rai x))
)
(princ)
)

<<

Filename: 241154_ttt.lsp
Tác giả: namnhim
Bài viết gốc: 241309
Tên lệnh: lktd
Xin lisp ghi kích thước tự động

Bạn dùng cái này xem có đúng ý không

 

(defun c:lktd ( )
(command "undo" "be")
  (if (null dolora)(setq dolora "4"))
(Setq temp T)
(While temp
(setq a (strcat "\nKhoang cach dim hien hanh la (" dolora ") /<Diem dau tien>: "))
(Initget "k K")
(setq str (getpoint a))
(Cond
  ((= str "k") (setq dolora (getstring (strcat"\nKhoang cach dim voi line <" dolora "> :"))))
  ((= str "K") (setq dolora (getstring (strcat"\nKhoang cach dim...
>>

Bạn dùng cái này xem có đúng ý không

 

(defun c:lktd ( )
(command "undo" "be")
  (if (null dolora)(setq dolora "4"))
(Setq temp T)
(While temp
(setq a (strcat "\nKhoang cach dim hien hanh la (" dolora ") /<Diem dau tien>: "))
(Initget "k K")
(setq str (getpoint a))
(Cond
  ((= str "k") (setq dolora (getstring (strcat"\nKhoang cach dim voi line <" dolora "> :"))))
  ((= str "K") (setq dolora (getstring (strcat"\nKhoang cach dim voi line <" 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))
(command "DIMALIGNED" a b d)
(cond
((> gocxeo (/ pi 2)) (command ".rotate" "last" "" c 180))
)
(setvar "osmode" luubatdiem)
(command "undo" "end")
 (Princ)
)

<<

Filename: 241309_lktd.lsp

Trang 135/304

135