- page 132

Info

File

Tác giả: Doan Van Ha
Bài viết gốc: 236291
Tên lệnh: ha

Cách tạo 1 khoảng cách chung tới đối tượng cho nhiều dim line?

Vậy thì vầy!

(defun C:HA()

(princ "\nCho cac Dim...")

(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "Dimension"))))))

(DimSpace ent))

(princ))

(defun DimSpace(ent)

(* 5 (getvar "dimscale") (Get_height ent)))

(defun Get_height(ent / blk1 blklst hei)

(setq blk1 (cdr (assoc -2 (tblsearch "BLOCK" (cdr (assoc 2 (entget ent (list...

Download lisp

Filename: 236291_ha.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 236272
Tên lệnh: ha

tìm hình chiếu của 1 điểm lên mặt phẳng cho trước

Giao của đường thẳng đi qua điểm pt và vuông góc với mặt phẳng xác định bởi 3 điểm p1, p2, p3.

;----- Giao cua duong thang qua diem pt va vuong goc voi mat phang p1,p2,p3.

(defun C:HA( / pt p1 p2 p3 pt1 pg vt pt1)

(or cal (arxload "geomcal"))

(setq pt (getpoint "\nPick diem pt: "))

(setq p1 (getpoint...

Download lisp

Filename: 236272_ha.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 236344
Tên lệnh: ha

Lệnh Trim mở rộng

Thank bác Tue_NV đã phát hiện ra lỗi với POLYLINE. Chưa test nó nên sinh lắm chuyện phiền hà khi gặp nó.

Code mới.

;27/5/2013. Doan Van Ha -CadViet.com

;Co 3 kieu Trim:

;1). Trim theo Phia: pick diem phia nao thi Trim phia do (tuong tu offset).

;2). Trim doan Ngan: Trim phan ngan.

;3). Trim doan Dai: Trim phan dai.

;Khong Trim cac truong hop: doi tuong la duong kin; giao nhau tai hon 1...

Download lisp

Filename: 236344_ha.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 236395
Tên lệnh: ha

[Đã xong] Lệnh Trim mở rộng

Phát hiện ra rồi! Chắc do thiếu "non"?

Code chép lên 4R tự dưng nó mất đi mấy chữ rất buồn cười: mất chu "kin", mất dòng "Chon cac doi tuong bi cat..."

4R dạo này lỡ post lisp là không sửa...

Download lisp

Filename: 236395_ha.lsp

Tác giả: Nguyen Hoanh
Bài viết gốc: 129739
Tên lệnh: cad2geo cad2geo

Cần lisp chuyển dwg/dxf sang Plaxis

Lisp dưới đây sẽ giúp bạn chuyển dữ liệu từ AutoCAD sang file . Tên lệnh là cad2geo
The lisp routine below will help you to transfer data from AutoCAD to file format. Command's name is cad2geo

Download lisp

Filename: 129739_cad2geo_cad2geo.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 236450
Tên lệnh: adjustdim selfadjustdim

Cách tạo 1 khoảng cách chung tới đối tượng cho nhiều dim line?

Đây bạn!

(defun GetDxf(n e)

(cdr (assoc n e)))

(defun ModDxf(n v e)

(if (GetDxf n e)

(entmod (subst (cons n v) (assoc n e) e))

(entmod (append e (list (cons n v))))))

(defun TSel(et ms)

(if ms (princ ms))

(ssget (if et (list (cons 0 et)))))

(defun AdjustDim1 (p l e / a)

(if (= 0 (logand 92 (GetDxf 70 e)))

(progn

...

Download lisp

Filename: 236450_adjustdim_selfadjustdim.lsp

Tác giả: Tue_NV
Bài viết gốc: 236519
Tên lệnh: mtr

[Đã xong] Lệnh Trim mở rộng

Như đã hẹn, Tue_NV post lisp trim "mở rộng" các đối tượng gồm: Trim theo phía, trim cạnh ngắn của đối tượng, trim cạnh dài của đối tượng. Đường dao cắt là 1 Curve bất kì: Line, Pline, Spline, Arc, Circle, ellipse.

(defun c:mtr(/ ssdao sscat pt Tue-list-ss Tue-geom-inters dgiao)
;;write by Tue_NV
  (defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)
  (mapcar 'set '(ssg vlaobj)...
>>

(defun c:mtr(/ ssdao sscat pt Tue-list-ss Tue-geom-inters dgiao)
;;write by Tue_NV
  (defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)
  (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
  (setq L (sslength ssg))
  (Repeat L
        (setq ename (ssname ssg (setq L (1- L))))
          (setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
  )
)
(defun Tue-geom-inters(e1 e2 flag / Lst_tong Lst);;;Tue-list-tach
  (if (= (type e1) 'ENAME) (setq e1 (vlax-ename->vla-object e1)))
  (if (= (type e2) 'ENAME) (setq e2 (vlax-ename->vla-object e2)))
  (vlax-invoke e1 'IntersectWith e2 flag)
)
(setvar "cmdecho" 0)
  (princ "\nChon cac doi tuong bi cat :")
   (setq sscat (ssget '((0 . "*line,Arc"))))
  (command ".draworder" sscat "" "F")
  (princ "\nChon Dao cat :")
  (setq ssdao (ssget ":S" '((0 . "*Line,Arc,ELLIPSE,CIRCLE"))))
  (sssetfirst nil ssdao)
  (initget "N D")
  (setq pt (getpoint "\nPick chon theo phia /doanNgan/doanDai] : "))
(if (eq (type pt) 'LIST)
  (foreach x (Tue-ss-list (list sscat))
       (if (Tue-geom-inters
                       (setq entps (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 (vlax-curve-getendpoint x)) (cons 60 1) )));
                      (ssname ssdao 0) 0)
            (Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")
            (Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")
          )
        (entdel entps)
   )
 )
(if (= pt "N")
  (foreach x (Tue-ss-list (list sscat))
    (if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)
       (if (< (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))
                (/ (vlax-curve-getendparam x) 2.0))
            (Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")
            (Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")
          )
      )
   )
 )
 (if (= pt "D")
  (foreach x (Tue-ss-list (list sscat))
    (if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)
       (if (> (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))
                (/ (vlax-curve-getendparam x) 2.0))
            (Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")
            (Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")
          )
      )
   )
 )
 )

(defun c:mtr(/ ssdao sscat pt Tue-list-ss Tue-geom-inters dgiao)

(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

(mapcar 'set '(ssg vlaobj) L-ss-vlaobj)

(setq L (sslength ssg))

(Repeat L

(setq ename (ssname ssg (setq L (1- L))))

(setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))

)

(defun Tue-geom-inters(e1 e2 flag / Lst_tong Lst);;;Tue-list-tach

(if (= (type e1) 'ENAME) (setq e1 (vlax-ename->vla-object e1)))

(if (= (type e2) 'ENAME) (setq e2 (vlax-ename->vla-object e2)))

(vlax-invoke e1 'IntersectWith e2 flag)

)

(setvar "cmdecho" 0)

(princ "\nChon cac doi tuong bi cat :")

(setq sscat (ssget '((0 . "*line,Arc"))))

(command ".draworder" sscat "" "F")

(princ "\nChon Dao cat :")

(setq ssdao (ssget ":S" '((0 . "*Line,Arc,ELLIPSE,CIRCLE"))))

(sssetfirst nil ssdao)

(initget "N D")

(setq pt (getpoint "\nPick chon theo phia /doanNgan/doanDai] : "))

(if (eq (type pt) 'LIST)

(foreach x (Tue-ss-list (list sscat))

(if (Tue-geom-inters

(setq entps (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 (vlax-curve-getendpoint x)) (cons 60 1) )));

(ssname ssdao 0) 0)

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(entdel entps)

)

(if (= pt "N")

(foreach x (Tue-ss-list (list sscat))

(if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)

(if (< (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))

(/ (vlax-curve-getendparam x) 2.0))

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(if (= pt "D")

(foreach x (Tue-ss-list (list sscat))

(if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)

(if (> (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))

(/ (vlax-curve-getendparam x) 2.0))

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(defun c:mtr(/ ssdao sscat pt Tue-list-ss Tue-geom-inters dgiao)

(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

(mapcar 'set '(ssg vlaobj) L-ss-vlaobj)

(setq L (sslength ssg))

(Repeat L

(setq ename (ssname ssg (setq L (1- L))))

(setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))

)

(defun Tue-geom-inters(e1 e2 flag / Lst_tong Lst);;;Tue-list-tach

(if (= (type e1) 'ENAME) (setq e1 (vlax-ename->vla-object e1)))

(if (= (type e2) 'ENAME) (setq e2 (vlax-ename->vla-object e2)))

(vlax-invoke e1 'IntersectWith e2 flag)

)

(setvar "cmdecho" 0)

(princ "\nChon cac doi tuong bi cat :")

(setq sscat (ssget '((0 . "*line,Arc"))))

(command ".draworder" sscat "" "F")

(princ "\nChon Dao cat :")

(setq ssdao (ssget ":S" '((0 . "*Line,Arc,ELLIPSE,CIRCLE"))))

(sssetfirst nil ssdao)

(initget "N D")

(setq pt (getpoint "\nPick chon theo phia /doanNgan/doanDai] : "))

(if (eq (type pt) 'LIST)

(foreach x (Tue-ss-list (list sscat))

(if (Tue-geom-inters

(setq entps (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 (vlax-curve-getendpoint x)) (cons 60 1) )));

(ssname ssdao 0) 0)

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(entdel entps)

)

(if (= pt "N")

(foreach x (Tue-ss-list (list sscat))

(if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)

(if (< (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))

(/ (vlax-curve-getendparam x) 2.0))

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

(if (= pt "D")

(foreach x (Tue-ss-list (list sscat))

(if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)

(if (> (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))

(/ (vlax-curve-getendparam x) 2.0))

(Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")

(Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")

)

Download lisp

Filename: 236519_mtr.lsp

Tác giả: Tue_NV
Bài viết gốc: 236581
Tên lệnh: mtr

Lệnh Trim mở rộng

Hình tôi khoanh tròn nhé!

http://www.cadviet.com/upfiles/3/67029_trim_loi.dwg

Tue_NV đã có tính tới "vòi bấu víu không được chọn" mà chưa tính tới "vòi bấu víu" được chọn nên mới xảy ra tình trạng...

Hình tôi khoanh tròn nhé!

http://www.cadviet.com/upfiles/3/67029_trim_loi.dwg

Tue_NV đã có tính tới "vòi bấu víu không được chọn" mà chưa tính tới "vòi bấu víu" được chọn nên mới xảy ra tình trạng này.

Đã sửa lại code. Bác DVH và các bạn thử xem :

@KetXu: Có TH như bạn nêu. Nên chăng sử dụng Offset dẫn hướng rồi trim. Ý bạn thế nào?

 
(defun c:mtr(/ ssdao sscat pt Tue-list-ss Tue-geom-inters dgiao lst-cat lst-cat2 XYmin XYmax Lx Ly)
;;;;;write by Tue_NV
  (defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)
  (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
  (setq L (sslength ssg))
  (Repeat L
        (setq ename (ssname ssg (setq L (1- L))))
(setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
  ) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun Tue-geom-inters(e1 e2 flag / Lst_tong Lst);;;Tue-list-tach
  (if (= (type e1) 'ENAME) (setq e1 (vlax-ename->vla-object e1)))
  (if (= (type e2) 'ENAME) (setq e2 (vlax-ename->vla-object e2)))
  (vlax-invoke e1 'IntersectWith e2 flag)
)
(command "undo" "be")
(setvar "cmdecho" 0)
  (princ "\nChon cac doi tuong bi cat :")
   (setq sscat (ssget '((0 . "*line,Arc"))))
  (command ".draworder" sscat "" "F")
  (princ "\nChon Dao cat :")
  (setq ssdao (ssget ":S" '((0 . "*Line,Arc,ELLIPSE,CIRCLE"))))
  (sssetfirst nil ssdao)
  (setq sscat2 (ssadd))
  (foreach x (vl-remove (ssname ssdao 0) (Tue-ss-list (list sscat)))
     (if (Tue-geom-inters x (ssname ssdao 0) 0) 
(setq lst-cat (append lst-cat (list x)))
(setq lst-cat2 (append lst-cat2 (list x)))
    )
  )
(foreach x (Tue-ss-list (list sscat))
(vla-getboundingbox (vlax-ename->vla-object x) 'minp 'maxp)
(setq LX (append LX (list (car(safearray-value minp)))
   (list (car(safearray-value maxp)))))
(setq LY (append LY (list (cadr(safearray-value minp)))
   (list (cadr(safearray-value maxp)))))
)
   (setq XYmin (list (apply 'min LX) (apply 'min LY) 0.0))
   (setq XYmax (list (apply 'max LX) (apply 'max LY) 0.0))
 
  (initget "N D")
  (setq pt (getpoint "\nPick chon theo phia /doanNgan/doanDai] : "))
(command "zoom" XYmin XYmax)
(if (eq (type pt) 'LIST)
  (progn (mapcar 'entdel lst-cat2)
  (foreach x lst-cat
       (if (Tue-geom-inters
   (setq entps (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 (vlax-curve-getendpoint x)) (cons 60 1) )));
           (ssname ssdao 0) 0)
 (Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")
 (Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")
)
        (entdel entps) 
   )
(mapcar 'entdel lst-cat2)
  )
 )
(if (= pt "N")
  (progn (mapcar 'entdel lst-cat2)
  (foreach x lst-cat
    (if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)
       (if (< (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))
     (/ (vlax-curve-getendparam x) 2.0))
 (Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")
 (Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")
)
      )
   )
(mapcar 'entdel lst-cat2)
  )
 )
 (if (= pt "D")
  (progn (mapcar 'entdel lst-cat2)
  (foreach x lst-cat
    (if (= (length (setq dgiao (Tue-geom-inters (ssname ssdao 0) x 0))) 3)
       (if (> (vlax-curve-getparamatpoint x (Tue-geom-inters (ssname ssdao 0) x 0))
     (/ (vlax-curve-getendparam x) 2.0))
 (Command "trim" ssdao x "" (vlax-curve-getstartpoint x) "")
 (Command "trim" ssdao x "" (vlax-curve-getendpoint x) "")
)
      )
   )
(mapcar 'entdel lst-cat2)
  )
 )
(command "zoom" "p")
(command "undo" "end")
 )

Download lisp

Filename: 236581_mtr.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 236595
Tên lệnh: ha

Lệnh Trim mở rộng

Lisp đã sửa theo các góp ý từ bài #14 đến #16.

;28/5/2013. Doan Van Ha -CadViet.com

;Co 3 kieu Trim:

;1). Trim theo Phia: pick diem phia nao thi Trim phia do (tuong tu offset).

;2). Trim doan Ngan.

;3). Trim doan Dai.

;Khong Trim cac truong hop: doi tuong la duong kin ; giao nhau tai hon 1 diem ; giao nhau bieu kien.

(defun C:HA( / ent0 ent ent2 ss ento lstg lst len1 len2 objlst...

Lisp đã sửa theo các góp ý từ bài #14 đến #16.

;28/5/2013. Doan Van Ha -CadViet.com

;Co 3 kieu Trim:

;1). Trim theo Phia: pick diem phia nao thi Trim phia do (tuong tu offset).

;2). Trim doan Ngan.

;3). Trim doan Dai.

;Khong Trim cac truong hop: doi tuong la duong kin ; giao nhau tai hon 1 diem ; giao nhau bieu kien.

(defun C:HA( / ent0 ent ent2 ss ento lstg lst len1 len2 objlst typ)

(vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho") osm (getvar "osmode"))

(if

(and

(princ "\nChon 1 doi tuong dao cat...")

(setq ss (ssget ":S" '((0 . "Line,Polyline,Lwpolyline,Spline,Arc"))))

(setq ent0 (ssname ss 0))

(princ "\nChon cac doi tuong bi cat...")

(setq ss (ssget '((0 . "Line,Polyline,Lwpolyline,Spline,Arc")))))

(progn

(initget "N D") (setq typ (getpoint "Pick phia can Trim hoac chon kieu Trim <N>: "))

(if (not typ) (setq typ "N"))

(setvar "cmdecho" 0) (setvar "osmode" 0)

(setq objlst (mapcar 'vlax-ename->vla-object (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssadd ent0 ss)))))))

(command "zoom" "w" (setq pll (car (LM:ListBoundingBox objlst))) (setq pur (cadr (LM:ListBoundingBox objlst))))

(if (listp typ)

(progn

(command "offset" (* (getvar "viewsize") 1E-6) ent0 typ "")

(setq ento (entlast))))

(foreach ent1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

(setq lstg (HA:Giao (vlax-ename->vla-object ent0) (vlax-ename->vla-object ent1) acExtendNone))

(if (and (= (length lstg) 1) (not (equal (car lstg) (vlax-curve-getStartPoint ent1) 1E-3)) (not (equal (car lstg) (vlax-curve-getEndPoint ent1) 1E-3)))

(progn

(setq lst (HA:GetNewEnt12 ent1 pll pur (car lstg)))

(setq len1 (HA:LenCur (setq ent1 (car lst))) len2 (HA:LenCur (setq ent2 (cadr lst))))

(cond

((or (and (= typ "N") (> len1 len2)) (and (= typ "D") (< len1 len2))) (entdel ent2))

((or (and (= typ "N") (< len1 len2)) (and (= typ "D") (> len1 len2))) (entdel ent1))

((listp typ)

(if (HA:Giao (vlax-ename->vla-object ento) (vlax-ename->vla-object ent1) acExtendNone)

(entdel ent1)

(entdel ent2)))))))

(if ento (entdel ento))))

(setvar "cmdecho" cmd) (setvar "osmode" osm) (command "zoom" "p") (command "undo" "e") (princ))

(defun HA:GetNewEnt12(ent pll pur pt / typ1 ss1 ss2 entlst)

(setq typ1 (cdr (assoc 0 (entget ent))))

(setq ss1 (ssget "c" pll pur '((0 . "POLYLINE"))))

(command ".break" ent pt pt)

(if (equal typ1 "POLYLINE")

(progn

(setq ss2 (ssadd))

(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "c" pll pur '((0 . "POLYLINE"))))))

(if (not (ssmemb ent ss1))

(ssadd ent ss2))

(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))

(list (car entlst) (cadr entlst))))

(list ent (entlast))))

(defun HA:LenCur(ent)

(vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))

(defun HA:Giao(obj1 obj2 mode / l r)

(setq l (vlax-invoke obj1 'intersectwith obj2 mode))

(repeat (/ (length l) 3)

(setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))

(defun LM:ListBoundingBox(objlst / l1 l2 ll ur)

(foreach obj objlst

(vla-getboundingbox obj 'll 'ur)

(setq l1 (cons (vlax-safearray->list ll) l1) l2 (cons (vlax-safearray->list ur) l2)))

(mapcar (function (lambda(a b) (apply 'mapcar (cons a b)))) '(min max) (list l1 l2)))

Download lisp

Filename: 236595_ha.lsp

Tác giả: ketxu
Bài viết gốc: 162964
Tên lệnh: f+nil

(Yêu cầu) lisp fillet. lấy một đối tuợng chọn làm chuân

Định nghĩa lại thì mệt lắm hè...

Download lisp

Filename: 162964_f+nil.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 236626
Tên lệnh: vht

?Needle or Cannula Depth. A number of insertion depths that allow the needle or cannula to be used on a variety of fatty tissue levels are available. Two or three depths are available and a doctor can provide guidance on which one to use.

Giải pháp bẫy lỗi đề xuất cho bài #12. Ai có giải pháp hay hơn thì đề xuất nhé?

(defun C:VHT( / p r)

(if

(and

(not (initget 1))

(setq p (getpoint "\nSpecify center point for circle: "))

(not (initget 7))

(setq r (getdist p "\nSpecify radius of circle: ")))

(command ".circle" "non" p r))

(princ))

Download lisp

Filename: 236626_vht.lsp

Tác giả: tien2005
Bài viết gốc: 236799
Tên lệnh: rt

Lisp rải mặt cắt thép theo tỷ lệ bản vẽ

Bạn thử lisp sau, mình chỉ lấy những cái sẵn có rồi sửa lại theo yêu cầu của bạn

(defun c:rt (/ a pt1 pt2  times pt #dia1 #inter1)
  (setq #OSMODE (getvar "OSMODE"))
  (setvar "cmdecho" 0)
  (or #dia(setq #dia 16))
  (or #inter(setq #inter 200))
  (or #tl(setq #tl 20))
  (if(and(setq	pt1    (getpoint "\nDiem dau..."))
	 (setq pt2    (getpoint "\n... diem cuoi" pt1))
	 (not (initget 6))
	 (setq #dia   (cond((getdist pt2...
>>

Bạn thử lisp sau, mình chỉ lấy những cái sẵn có rồi sửa lại theo yêu cầu của bạn

(defun c:rt (/ a pt1 pt2  times pt #dia1 #inter1)
  (setq #OSMODE (getvar "OSMODE"))
  (setvar "cmdecho" 0)
  (or #dia(setq #dia 16))
  (or #inter(setq #inter 200))
  (or #tl(setq #tl 20))
  (if(and(setq	pt1    (getpoint "\nDiem dau..."))
	 (setq pt2    (getpoint "\n... diem cuoi" pt1))
	 (not (initget 6))
	 (setq #dia   (cond((getdist pt2 (strcat"\nDuong kinh thep <" (rtos #dia 2 2)">: ")))(#dia)))
	 (not (initget 6))
	 (setq #inter (cond((getdist(strcat"\nKhoang cach giua cac thanh thep  <" (rtos #inter 2 2)">: ")))(#inter)) )
	 (not (initget 6))
	 (setq #tl (cond((getint (strcat"\nTy le <" (rtos #tl 2 0)">: ")))(#tl)))
	 )
    (progn
      (setq #dia1 (/ #dia #tl)
	    #inter1 (/ #inter #tl)
	    a      (angle pt1 pt2)
	    times  (fix (/ (distance pt1 pt2) #inter1))
	    )

      (command "_.Undo" "be")
      (setvar "osmode" 0)

      (while (>= times 0)
	(setq pt (polar pt1 a (* times #inter1)))
	(command "_.DONUT" 0 #dia1 pt "")
	(setq times (1- times))
	)
      )
    )
  (command "_.Undo" "be")
  (setvar "osmode" #OSMODE)
  (princ)
)

Download lisp

Filename: 236799_rt.lsp

Tác giả: tien2005
Bài viết gốc: 236943
Tên lệnh: rt

Lisp rải mặt cắt thép theo tỷ lệ bản vẽ

Bạn thử lisp này xem đã chưa

(defun c:rt (/ a pt1 pt2  times pt #dia1 #inter1 dyn)
  (setq #OSMODE (getvar "OSMODE"))
  (setq dyn (getvar "DYNMODE"))
  (setvar "cmdecho" 0)
  (setvar "DYNMODE" 3)
  (or #dia(setq #dia 16))
  (or #inter(setq #inter 200))
  (or #tl(setq #tl 20))
  (if(and(setq	pt1    (getpoint "\nDiem dau..."))
	 (setq pt2    (getpoint "\n... diem cuoi" pt1))
	 (not (initget 6))
	 (setq #dia   (cond((getdist pt2 (strcat"\nDuong...
>>

Bạn thử lisp này xem đã chưa

(defun c:rt (/ a pt1 pt2  times pt #dia1 #inter1 dyn)
  (setq #OSMODE (getvar "OSMODE"))
  (setq dyn (getvar "DYNMODE"))
  (setvar "cmdecho" 0)
  (setvar "DYNMODE" 3)
  (or #dia(setq #dia 16))
  (or #inter(setq #inter 200))
  (or #tl(setq #tl 20))
  (if(and(setq	pt1    (getpoint "\nDiem dau..."))
	 (setq pt2    (getpoint "\n... diem cuoi" pt1))
	 (not (initget 6))
	 (setq #dia   (cond((getdist pt2 (strcat"\nDuong kinh thep <" (rtos #dia 2 2)">: ")))(#dia)))
	 (not (initget 6))
	 (setq #inter (cond((getdist(strcat"\nKhoang cach giua cac thanh thep  <" (rtos #inter 2 2)">: ")))(#inter)) )
	 (not (initget 6))
	 (setq #tl (cond((getint (strcat"\nTy le <" (rtos #tl 2 0)">: ")))(#tl)))
	 )
    (progn
      (setq #dia1 (/ #dia #tl)
	    #inter1 (+(/ #inter #tl)(* #dia1 1))
	    a      (angle pt1 pt2)
	    times  (fix (/ (distance pt1 pt2) #inter1))
	    pt1 (polar pt1 (+ a (/ pi 4)) ( * #dia1 0.5 (sqrt 2.0)))
	    )

      (command "_.Undo" "be")
      (setvar "osmode" 0)

      (while (>= times 0)
	(setq pt (polar pt1 a (* times #inter1)))
	(command "_.DONUT" 0 #dia1 pt "")
	(setq times (1- times))
	)
      )
    )
  (command "_.Undo" "en")
  (setvar "osmode" #OSMODE)
  (setvar "DYNMODE" dyn)
  (princ)
)

Download lisp

Filename: 236943_rt.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 237023
Tên lệnh: ha

Lệnh Trim mở rộng

Tôi chỉ down được bản thứ 2 còn bản thứ 1 lỗi server. Sửa lisp chút xíu cho nó ổn.

P/S: CadViet bị lỗi up file nên các bạn down về chịu khó delete mấy chữ này trong lisp nhé: <span> </span>

;http://www.cadviet.com/forum/topic/71578-da-xong-lenh-trim-mo-rong/page-3

;01/6/2013....

Tôi chỉ down được bản thứ 2 còn bản thứ 1 lỗi server. Sửa lisp chút xíu cho nó ổn.

P/S: CadViet bị lỗi up file nên các bạn down về chịu khó delete mấy chữ này trong lisp nhé: <span> </span>

;http://www.cadviet.com/forum/topic/71578-da-xong-lenh-trim-mo-rong/page-3

;01/6/2013. Doan Van Ha -CadViet.com

;Co 3 kieu Trim:

;1). Trim theo Phia: pick diem phia nao thi Trim phia do (tuong tu offset).

;2). Trim doan Ngan.

;3). Trim doan Dai.

;Khong Trim cac truong hop: doi tuong la duong kin ; giao nhau tai hon 1 diem ; giao nhau bieu kien.

(defun C:HA( / ent0 ent ent2 ss ento lstg lst len1 len2 objlst typ)

(vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho") osm (getvar "osmode"))

(if

(and

(princ "\nChon 1 doi tuong dao cat...")

(setq ss (ssget ":S" '((0 . "Line,Polyline,Lwpolyline,Spline,Arc"))))

(setq ent0 (ssname ss 0))

(princ "\nChon cac doi tuong bi cat...")

(setq ss (ssget '((0 . "Line,Polyline,Lwpolyline,Spline,Arc")))))

(progn

(initget "N D") (setq typ (getpoint "Pick phia can Trim hoac chon kieu Trim <N>: "))

(if (not typ) (setq typ "N"))

(setvar "cmdecho" 0) (setvar "osmode" 0)

(setq objlst (mapcar 'vlax-ename->vla-object (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssadd ent0 ss)))))))

(command "zoom" "w" (setq pll (car (LM:ListBoundingBox objlst))) (setq pur (cadr (LM:ListBoundingBox objlst))))

(if (listp typ)

(progn

(command "offset" 1E-8 ent0 typ "")

(setq ento (entlast))))

(foreach ent1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

(setq lstg (HA:Giao (vlax-ename->vla-object ent0) (vlax-ename->vla-object ent1) acExtendNone))

(if (and (= (length lstg) 1) (not (equal (car lstg) (vlax-curve-getStartPoint ent1) 1E-3)) (not (equal (car lstg) (vlax-curve-getEndPoint ent1) 1E-3)))

(progn

(setq lst (HA:GetNewEnt12 ent1 pll pur (car lstg)))

(setq len1 (HA:LenCur (setq ent1 (car lst))) len2 (HA:LenCur (setq ent2 (cadr lst))))

(cond

((or (and (= typ "N") (> len1 len2)) (and (= typ "D") (< len1 len2))) (entdel ent2))

((or (and (= typ "N") (< len1 len2)) (and (= typ "D") (> len1 len2))) (entdel ent1))

((listp typ)

(if (HA:Giao (vlax-ename->vla-object ento) (vlax-ename->vla-object ent1) acExtendNone)

(entdel ent1)

(entdel ent2)))))))

(if ento (entdel ento))))

(setvar "cmdecho" cmd) (setvar "osmode" osm) (command "zoom" "p") (command "undo" "e") (princ))

(defun HA:GetNewEnt12(ent pll pur pt / typ1 ss1 ss2 entlst)

(setq typ1 (cdr (assoc 0 (entget ent))))

(setq ss1 (ssget "c" pll pur '((0 . "POLYLINE"))))

(command ".break" ent pt pt)

(if (equal typ1 "POLYLINE")

(progn

(setq ss2 (ssadd))

(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "c" pll pur '((0 . "POLYLINE"))))))

(if (not (ssmemb ent ss1))

(ssadd ent ss2))

(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))

(list (car entlst) (cadr entlst))))

(list ent (entlast))))

(defun HA:LenCur(ent)

(vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))

(defun LM:ListBoundingBox(objlst / l1 l2 ll ur)

(foreach obj objlst

(vla-getboundingbox obj 'll 'ur)

(setq l1 (cons (vlax-safearray->list ll) l1) l2 (cons (vlax-safearray->list ur) l2)))

(mapcar (function (lambda(a B) (apply 'mapcar (cons a B)))) '(min max) (list l1 l2)))

(defun HA:Giao(obj1 obj2 mode / l r)

(setq l (vlax-invoke obj1 'intersectwith obj2 mode))

(if (and l (equal (vlax-curve-getClosestPointTo obj2 l nil) l 1E-15))

(repeat (/ (length l) 3)

(setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l))))

Download lisp

Filename: 237023_ha.lsp

Tác giả: ketxu
Bài viết gốc: 119993
Tên lệnh: vsw vse vne vnw vw

Chọn đối tượng theo layer

1.Bạn click Thanks là được rồi^^
2.Với những lệnh nhiều hơn 1 thao tác chọn, bạn nên làm 1 lisp lệnh tắt nhỏ nhỏ.
Cách làm thường là bạn thực hiện các bước làm như thủ công,sau đó ấn f2 để xem thứ tự các thao tác.Sau đó tạo file lisp với nội dung

Lần lượt các view khác là :..

Các yêu cầu khác bạn cứ tự khám phá nhé

Download lisp

Filename: 119993_vsw_vse_vne_vnw_vw.lsp

Tác giả: lyky
Bài viết gốc: 237247
Tên lệnh: cba

Tạo liên kết Text với Block attribute trong cad

Sau khi gia công xong, nếu bạn hiệu chỉnh giá trị chiều dài biểu kiến trên thanh thép ---> kết quả tự động link vào Block Attribute thì thật là tiện dụng. Tuy nhiên, nếu có thể chấp nhận một chút phiền toái, sau khi bạn hiệu chỉnh giá trị chiều dài biểu kiến, sử dụng code sau để hiệu chỉnh giá trị trong Block:

(defun C:CBA( / ENT KQUA LST LST2 LST3...
>>

(defun C:CBA( / ENT KQUA LST LST2 LST3 OBJLST SS SS1)
(vl-load-com)
(prompt"\nChon so lieu:\n") (setq ss (ssget '((0 . "TEXT")))) (setq kqua 0)
(while (and ss (> (sslength ss) 0))
(setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))
(ssdel ent ss))
(prompt"\nChon Block:\n") (setq ss1 (ssget '((0 . "INSERT"))))
(setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))))
(foreach obj objlst (setq lst (GetAtt obj))
(foreach lst1 lst
(if (= (strcase (car lst1)) "LTHANH")
  (setq lst2 (cons (car lst1) kqua))
  (setq lst2 lst1))
  (setq lst3 (cons lst2 lst3)))
  (SetAtt obj lst3))
(princ))
;-----by MENZI ENGINEERING GmbH, Switzerland-----;
(defun GetAtt (obj) (mapcar '(lambda (att) (cons (vla-get-TagString att) (vla-get-TextString att))) (vlax-invoke obj 'GetAttributes)))
(defun SetAtt (obj lst / attval) (mapcar '(lambda (att) (if (setq attval (cdr (assoc (vla-get-TagString att) lst))) (vla-put-TextString att attval))) (vlax-invoke obj 'GetAttributes)) (vla-update obj))

Download LISP file
Download TEST file

P/S: À, nếu bạn muốn làm tròn 10 kết quả tổng chiều dài trước khi gán vào Block thì bổ xung thêm vào code nhé!

Download lisp

Filename: 237247_cba.lsp

Tác giả: gia_bach
Bài viết gốc: 237262
Tên lệnh: linkt

Tạo liên kết Text với Block attribute trong cad

Mình có file cad và hình ảnh bên dưới với yêu cầu: Tạo liên kết Text với Block attribute trong cad.

Nhờ các bạn giúp mình. Thanks!

>>

Mình có file cad và hình ảnh bên dưới với yêu cầu: Tạo liên kết Text với Block attribute trong cad.

Nhờ các bạn giúp mình. Thanks!

file cad: http://www.mediafire.com/?7eeeb4dmkzrfy8p

Similar topics from web:
mẹo hay sử dụng cho autocad | Nguyễn Toàn Blog\s
Auto lisp trong cad?
Autolisp và tiện ích trên CAD
Trợ giúp kỹ sư xây dựng
cad.điện.t
Chia sẻ Bộ Lisp rất hay: ”Kho báu của Minh”
REDSUN QUẬN10: Autodesk Autocad
Làm sao lấy dữ liệu trong cad qua excel?
Chia sẻ kinh nghiệm dùng Autocad | Facebook
Auto CAD qua các hình vẽ
Smashwords — Ấn phẩm CADViet 1 — A book by Nguyen Hoanh
Hỏi về in ấn trong Autocad
Cad Nang Cao Rat Hay
Diễn đān CADViet
Meo vat trong cad

Lisp tạo liên kết các Text vào Block ứng với file Cad bạn gửi.

(defun c:linkT (/ blk fieldexp ss);link Text to Attribute
  ;; By : Gia_Bach 2013 ;;
  (vl-load-com)
  (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1)
    (if (and
	  (princ "\nChon cac Text nguon : ")
	  (setq ss (ssget '((0 . "TEXT"))))
	  (princ "\nChon Block can link : ")
	  (setq blk (ssget "_+.:S:E" (list (cons 0 "INSERT")(cons 2 "THONG KE THEP"))))) 
      (progn
	(setq fieldExp "%<\\AcExpr (0")
	(foreach e (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
	  (setq fieldExp (strcat fieldExp
				 "+%<\\AcObjProp Object(%<\\_ObjId "
				 (itoa (vla-get-objectid e))
				 ">%).TextString>%")) )
	(foreach att (vlax-invoke (vlax-Ename->Vla-Object (ssname blk 0)) 'GetAttributes)
	  (if (= (vla-get-TagString att) "LTHANH")
	    (progn
	      (vla-put-textstring att (strcat fieldExp ") \\f \"%lu2%pr0\">%"))
	      (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))  acActiveViewport ) ) ) )
	(princ)))
    (alert "\nChi chay tu Autocad 2006")  )  )

Download lisp

Filename: 237262_linkt.lsp

Tác giả: Doan Van Ha
Bài viết gốc: 237326
Tên lệnh: ha

Giúp e giải đề này với ( bản vẽ đính kèm)

Với bài toán theo file bạn gởi thì dùng lisp này.

(defun C:HA( / ent1 ent2 pt p1 p2 px lst1 lst2)

(if

(and

(setq ent1 (car (entsel "\nChon duong mat: ")))

(setq pt (getpoint "\nChon diem tim: "))

(setq ent2 (car (entsel "\nChon cao do diem tim: "))))

(while (setq p (getpoint "\nPick diem can tinh: "))