Lisp Cut dim, cut hatch, align it

[hsoso 0]

Sau khi tìm hiểu, mình đã tìm được cái này trên diễn đàn.

 

Lisp cắt Dim.

 

Cách dùng:

- Sau khi upload, dùng lệnh CD.

- click điểm 1 để chọn vị trí cắt chân Dim,

- click điểm 2 để chọn vị trí cắt đường Dim.

 

Nếu không muốn cắt chân Dim hoặc đường Dim thì nhấn phím dấu cách.

 

(defun c:cd (/ entdt dcat1 dcat2 sodimsua index sodt ssdt tt)

  (defun cdim (entdt    pchan     pduong      /       tt        old10

           old13    old14     new10      new13       new14    p10n

           p13n    p14n     p10o      p13o       p14o        gocduong

           gocchan    pchanb     pduongb loaidim

          )

    (defun chanvuonggoc    (ph p1 p2 / ptemp pkq goc)

      (setq

    goc   (+ (angle p1 p2) (/ pi 2.0))

    ptemp (polar ph goc 1000.0)

    pkq   (inters ph ptemp p1 p2 nil)

      )

      pkq

    )

    (setq

      tt       (entget entdt)

      old10    (assoc '10 tt)

      old13    (assoc '13 tt)

      old14    (assoc '14 tt)

      p10o     (cdr old10)

      p13o     (cdr old13)

      p14o     (cdr old14)

      loaidim  (logand (cdr (assoc '70 tt)) 7)

      gocduong (cond

         ((= loaidim 1) (angle p13o p14o))

         ((= loaidim 0) (cdr (assoc '50 tt)))

         (t nil)

           )

      pchan (cond

          (pchan (list (car pchan) (cadr pchan) 0.0))

          (t pchan)

        )

      pduong (cond

          (pduong (list (car pduong) (cadr pduong) 0.0))

          (t pduong)

        )

      

    )

    (if    gocduong

      (progn

    (if pchan

      (setq

        pchanb (polar pchan gocduong 1000.0)

        p13n   (chanvuonggoc (list (car p13o) (cadr p13o) 0.0) pchan pchanb)

        p14n   (chanvuonggoc (list (car p14o) (cadr p14o) 0.0) pchan pchanb)

        new13  (cons 13 p13n)

        new14  (cons 14 p14n)

        tt       (subst new13 old13 tt)

        tt       (subst new14 old14 tt)

      )

    )

    (if pduong

      (setq

        pduongb (polar pduong gocduong 1000.0)

        p10n    (chanvuonggoc (list (car p10o) (cadr p10o) 0.0) pduong pduongb)

        new10   (cons 10 p10n)

        tt        (subst new10 old10 tt)

      )

    )

    (entmod tt)

      )

    )

    gocduong

  )

 

 

  (setq    ssdt     (ssget '((0 . "DIMENSION")))

    dcat1     (getpoint "\nDiem cat chan DIM: ")

    dcat2     (getpoint "\nDiem cat duong DIM: ")

        

    dcat1    (cond

           (dcat1 (trans dcat1 1 0))

           (t nil)

         )

    dcat2    (cond

           (dcat2 (trans dcat2 1 0))

           (t nil)

         )    

    sodt     (sslength ssdt)

    index     0

    sodimsua 0

  )

  (repeat sodt

    (setq entdt    (ssname ssdt index)

      index    (1+ index)

      tt    (entget entdt)

 

    )

    (if    (cdim entdt dcat1 dcat2)

      (setq sodimsua (1+ sodimsua))

    )

  )

  (princ (strcat "\nSo duong dim da sua: " (itoa sodimsua)))

 

)

[be_chanh 894]

Chào các bạn, bạn nào có cái file gì cắt dim cho bằng nhau share tớ với, tớ quên mất file gì rồi.

Mình có 2 kiểu cắt DIM

 

Mở Notepad. Copy và PASTE đoạn mã sau. Save với tên tương ứng.

 

1. Lựa chọn DIM và chọn điểm chân DIM

 

Tên file: CatDim.LSP

 

Lệnh: CD

 

Mã

(defun useerror(tt)
(cond
((= tt 0)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ ORM (GETVAR "ORTHOMODE"))
(SETQ SNA (GETVAR "SNAPANG"))
 
(COMMAND "_UNDO" "be")
 
(SETQ OLDERR *error*
*error* myerror)
)
((= tt 1)
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(SETVAR "ORTHOMODE" ORM)
(SETVAR "SNAPANG" SNA)
 
(COMMAND "_UNDO" "e")
 
(setq *error* OLDERR) ; Restore old *error* handler
(PRINC)
)
)
)
 
;; SUA SAI
(defun myerror (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(SETVAR "ORTHOMODE" ORM)
(SETVAR "SNAPANG" SNA)
 
(COMMAND "_UNDO" "e")
 
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)
;*******************************************************************************
 
(DEFUN C:CD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
*error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
(PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
(PROGN
(SETQ PT10 (CDR (ASSOC 10 DS)))
(SETQ PT11 (CDR (ASSOC 11 DS)))
(SETQ PT13 (CDR (ASSOC 13 DS)))
(SETQ PT14 (CDR (ASSOC 14 DS)))
(SETQ N70 (CDR (ASSOC 70 DS)))
(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
(PROGN
(SETQ GOCY (ANGLE PT10 PT14))
(SETQ GOCX (+ GOCY (/ PI 2)))
)
)
(SETVAR "OSMODE" 0)
(SETQ PTI (POLAR PT GOCX 2))
(SETQ PT13I (POLAR PT13 GOCY 2))
(SETQ PT14I (POLAR PT14 GOCY 2))
(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
(SETQ O13 (ASSOC 13 DS))
(SETQ O14 (ASSOC 14 DS))
(SETQ N13 (CONS 13 PT13N))
(SETQ N14 (CONS 14 PT14N))
(SETQ DS (SUBST N13 O13 DS))
(SETQ DS (SUBST N14 O14 DS))
(ENTMOD DS)
)
)
(SETQ DEM (+ DEM 1))
)
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(PRINC)
)

 

2. Lựa chọn DIM, chọn vị trí dây DIM và chọn điểm chân DIM

 

Tên file: CatDimX.LSP

 

Lệnh: CDX

 

Mã:

(defun c:cdx (/ entdt dcat1 dcat2 sodimsua index sodt ssdt tt)
(defun cdim (entdt pchan pduong / tt old10
old13 old14 new10 new13 new14 p10n
p13n p14n p10o p13o p14o gocduong
gocchan pchanb pduongb loaidim
)
(defun chanvuonggoc (ph p1 p2 / ptemp pkq goc)
(setq
goc (+ (angle p1 p2) (/ pi 2.0))
ptemp (polar ph goc 1000.0)
pkq (inters ph ptemp p1 p2 nil)
)
pkq
)
(setq
tt (entget entdt)
old10 (assoc '10 tt)
old13 (assoc '13 tt)
old14 (assoc '14 tt)
p10o (cdr old10)
p13o (cdr old13)
p14o (cdr old14)
loaidim (logand (cdr (assoc '70 tt)) 7)
gocduong (cond
((= loaidim 1) (angle p13o p14o))
((= loaidim 0) (cdr (assoc '50 tt)))
(t nil)
)
pchan (cond
(pchan (list (car pchan) (cadr pchan) 0.0))
(t pchan)
)
pduong (cond
(pduong (list (car pduong) (cadr pduong) 0.0))
(t pduong)
)
 
)
(if gocduong
(progn
(if pchan
(setq
pchanb (polar pchan gocduong 1000.0)
p13n (chanvuonggoc (list (car p13o) (cadr p13o) 0.0) pchan pchanb)
p14n (chanvuonggoc (list (car p14o) (cadr p14o) 0.0) pchan pchanb)
new13 (cons 13 p13n)
new14 (cons 14 p14n)
tt (subst new13 old13 tt)
tt (subst new14 old14 tt)
)
)
(if pduong
(setq
pduongb (polar pduong gocduong 1000.0)
p10n (chanvuonggoc (list (car p10o) (cadr p10o) 0.0) pduong pduongb)
new10 (cons 10 p10n)
tt (subst new10 old10 tt)
)
)
(entmod tt)
)
)
gocduong
)
 
(init)
(setq ssdt (ssget '((0 . "DIMENSION")))
dcat1 (getpoint "\nDiem cat chan DIM: ")
dcat2 (getpoint "\nDiem cat duong DIM: ")
 
dcat1 (cond
(dcat1 (trans dcat1 1 0))
(t nil)
)
dcat2 (cond
(dcat2 (trans dcat2 1 0))
(t nil)
)
sodt (sslength ssdt)
index 0
sodimsua 0
)
(repeat sodt
(setq entdt (ssname ssdt index)
index (1+ index)
tt (entget entdt)
 
)
(if (cdim entdt dcat1 dcat2)
(setq sodimsua (1+ sodimsua))
)
)
(princ (strcat "\nSo duong dim da sua: " (itoa sodimsua)))
(done)
)

[thekingnet 7]

Bác nào có lisp dùng để trim luôn cả hatch ko ! dùng cho cad 2004 ỵ Thanks các bác !

[Hieuss 162]

bác cài cad2005 mà dùng. Cắt luôn được hatch cần gì lisp. Mà cad2005 với cad2004 nặng như nhau nhưng 2005 có nhiều ưu điểm hơn 2004. Dùng phê hơn nhiều.

[Zoi 36]

sao không dùng hẳn 2007 đi, cắt hatch, trim bằng cửa sổ, ko cần F, vẽ 3D xoay trục cực nhanh. Cái gì cũng ngon.

 

mà CAD2007, con máy dùng CE500 + 512mb ram ghẻ chạy veo veo... :lol:

 

Có nặng gì đâu ???

[thekingnet 7]

hix ! nhưng tôi quen dùgn cad 2004 rồi, với cả lại ,các thiết lập của tôi, và lisp dang dùng ko sử dụng cho cad 2005 dc ! Các pác cố giúp tôi với !

[Hieuss 162]

cad 2005 không khác gì cad 2004. dùng y hệt nhau nhưng hơn một số thứ rất tiện ích. Cad 2006, 2007 dùng thì khác hẳn, dùng hơi khó

[khimatro 2]

Cái cdx hình như không dùng được mình thử thì hiện ra thông báo lỗi sau:

---------------------------------------------------------------------------------------'

Command: cdx

; error: no function definition: INIT

---------------------------------------------------------------------------------------

[admin 486]

Để sửa lỗi này, khimatro hãy tìm các dòng có lệnh: (init) và (done) và xóa đi là ok.

[bemove 1314]

Align các đối tượng thẳng hàng theo left. right. center

Ví dụ như muốn gióng các đối tượng Dtext theo lề trái. dùng lisp này nhé

HD: copy file alignit.DCL vào thư mục support

Appload file alignit.lsp như bình thương

 

http://www.cadviet.com/upfiles/alignit.zip

[xuangiangtedi 3]

Chào các bạn mình có một vấn đề về Dim rất mong nhận được sự giúp đỡ của các bạn. Mình thấy vấn đề này cũng khá phức tạp không chắc có làm được không, nhưng thôi kệ cư đưa lên đây biết đấu có bác nào kiệt xuất lại có thế giải quyêt đựơc thì sao. Vấn đề của mình là mình muốn dim nhanh đường polyline liên tục giồng như tính năng Quick dim trong Cad nhưng hướng của các kích thước phải luôn song song với phương của các đoạn thẳng trong polyline ( tức là mình muốn đo theo phương chéo cuủa các đường thảng chú không phải theo phương ngang). Vậy có cao thủ nào biết được xin hãy giúp đỡ mình nhé. Chân thành cảm ơn vì đã đọc.

Mình gửi kèm theo file để các bạn dễ hình dung(file này mình phải dim thủ công tưn cái một đó.

http://www.cadviet.com/upfiles/2/bd_chia_tam_1.dwg

[gia_bach 1553]

Vậy là sao?! Thì đâu có ai trả lời gì đâu cả bạn cũng có nói là làm được hay không làm được đâu?

sao không ai trả lời mình vậy. không làm được thi cũng trả lời một câu là không làm được để mình đỡ phải chờ chứ?

Bạn có quyền đặt câu hỏi nhờ giúp đỡ.

Và bạn có quyền chờ hay không chờ câu trả lời của mọi nguời. (để khỏi tốn thời gian)

 

Mọi nguời có quyền đọc và trả lời hay không trả lời mọi vấn đề.

 

CadViet có hơn 56 ngàn thành viên :

- nếu mỗi thành viên đều trả lời; liệu bạn có đủ thời gian để đọc hết không ?

- khi đó diễn đàn chỉ có các bài đại lọai như : tui không biết, tui biết nhưng tui không có thời gian giúp bạn, thậm chí là tui biết nhưng tui không thích giúp bạn ...

 

 

Thực ra vấn đề của bạn đã đuợc đề cập rồi. hãy sử dụng chức năng tìm kiếm truớc khi nhờ giúp đỡ.

[vlgkhoi2190 0]

bạn ơi cho mình hỏi mình download lisp CD về rồi, vào cad load rồi nhưng khi gõ CD thì cad báo là ko có lệnh này... làm sao đây mọi người giúp với

[phamhiep_xda 0]

lisp của bạn này bị lỗi rồi mọi người đừng down dùng nữa.dùng lisp mình bên dưới kìa,lệnh tắt sa chữ defun c trong lisp nhé!

[quynh536 0]

help! Các cao thủ giup e với.

em đang làm trong nganh cấp thoát nước, hiện e đang muốn có 1 lisp để đo chiều dài của đường pline ròi hiện giá trị bên canh đường pline đó luôn, các bác cao thủ giúp e với!

Dưới là file ví dụ.

vô cùng cảm ơn các bác!

http://www.cadviet.com/upfiles/5/80655_vidu_1.dwg

[sv_mt 0]

cám ơn mọi người đã giúp đỡ nhé. :D  :D