- page 135

Info

File

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.

Download lisp

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

Download lisp

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

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 )

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

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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

)

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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

Download lisp

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)

Download lisp

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

;;;=========
(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")

)

Download lisp

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

Download lisp

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

Download lisp

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

)

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

Download lisp

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

Download lisp

Filename: 241309_lktd.lsp

Trang 135/330