Đến nội dung


Hình ảnh
- - - - -

Tiện ích nhỏ về kích thước và đo đạc


  • Please log in to reply
6 replies to this topic

#1 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 13 March 2009 - 11:29 AM

1- Vài tiện ích nhỏ, hy vọng có ích cho một số bạn thường phải xử lý Dim và Measure:


;;;=================================
;;;SMALL UTILITIES FOR DIMENSIONS AND MEASUREMENTS
;;;CAC TIEN ICH NHO VE KICH THUOC VA DO LUONG
;;;=================================
;;;HUONG DAN:
;;;SaveAs *.lsp, go lenh Appload, go cac lenh sau day de chay:
;;;-------------------------------------------------------------
;;;1- Lenh SCC: SCale with Constant dimensions
;;;Hoat dong nhu lenh Scale cua AutoCAD nhung giu nguyen gia tri Dim
;;;(chi co "Dim Scale Linear" va "Dim Scale Overall" thay doi)
;;;Cac thuoc tinh khac cua Dim khong bi anh huong
;;;Tuy chon Dim Scale Overall = Y cho phep scale ca cac yeu to khac cua Dim
;;;(text, kich thuoc mui ten, khoang nho ra cua duong giong...)
;;;Mac dinh la Dim Scale Overall = N
;;;Chap nhan cac Dim co DimStyle khac nhau
;;;-------------------------------------------------------------
;;;2- Lenh CHD: CHeck Dimensions
;;;Kiem tra toan bo cac doi tuong Dimensions co trong ban ve
;;;Dim bi edit bang Text Override se chuyen sang layer DimCheck co mau RED
;;;-------------------------------------------------------------
;;;3- Lenh XY: ghi toa do X, Y cua diem pick
;;;Ket qua ghi dang Leader va 1 Mtext co 2 dong
;;;-------------------------------------------------------------
;;;4- Lenh CL: ve Center Line cho duong tron tai layer CEN
;;;Neu Layer khong ton tai, chuong trinh tu tao layer CEN
;;;Voi thiet lap mau Magenta, Ltype ACAD_ISO04W100
;;;-------------------------------------------------------------
;;;5- Lenh L1: Do va ghi chieu dai 1 doi tuong, vi tri dat text do user chon
;;;-------------------------------------------------------------
;;;6- Lenh LL: Do va ghi chieu dai nhieu doi tuong, cho phep chon hang loat
;;;Vi tri dat text tai diem giua cua tung doi tuong
;;;-------------------------------------------------------------
;;;7- Lenh LTO: Do va ghi tong chieu dai nhieu doi tuong, user chon vi tri dat text
;;;-------------------------------------------------------------
;;;GHI CHU CHUNG VOI KET QUA GHI DANG TEXT
;;;Chuong trinh dung TextStyle hien hanh de ghi ket qua
;;;So chu so thap phan phu thuoc thiet lap Units
;;;Vao Format -> Units -> chon Precision tuy y
;;;-------------------------------------------------------------
;;;Copyright by ssg - www.cadviet.com - March 2009
;;;=================================



;;;PUBLIC FUNCTIONS
;;;=================================
(defun getL(e) ;;;Get Length of curve e
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;;-------------------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------------------
(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0 Le nil)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)
;;;-------------------------------------------------------------
(Defun Bdraw()
;;;Begin draw, get some current system variables, disable them
(setq OldOs (getvar "osmode"))
(setq OldLay (getvar "clayer"))
(setvar "osmode" 0)
)
;;;-------------------------------------------------------------
(Defun Edraw()
;;;End draw, reset all system variables
(setvar "osmode" OldOs)
(setvar "clayer" OldLay)
)
;;;-------------------------------------------------------------
(Defun SetLayer(MyLayer)
;;;Make and Set Layer
(if (not (tblsearch "LAYER" MyLayer)) (progn
(Cond
((= (strcase MyLayer) "0") (setq MyColor "White" MyLtype "Continuous"))
((= (strcase MyLayer) "CEN") (setq MyColor "Magenta" MyLtype "ACAD_ISO04W100"))
((= (strcase MyLayer) "DIM") (setq MyColor "Green" MyLtype "Continuous"))
((= (strcase MyLayer) "HATCH") (setq MyColor "Yellow" MyLtype "Continuous"))
((= (strcase MyLayer) "HID") (setq MyColor "Cyan" MyLtype "ACAD_ISO02W100"))
((= (strcase MyLayer) "STT") (setq MyColor 140 MyLtype "Continuous"))
((= (strcase MyLayer) "KHUNGTEN") (setq MyColor 120 MyLtype "Continuous"))
)
(Command "Layer" "N" MyLayer "L" MyLtype MyLayer "C" MyColor MyLayer "T" MyLayer "")
))
(setvar "CLayer" MyLayer)
)
;;;=================================



;;;DIMENSION AND GEOMETRIC COMMAND FUNCTIONS
;;;=================================
(defun SCDim( / e ob OName SF LSF)
(while (setq e (ssname ssd 0))
(setq
ob (vlax-ename->vla-object e)
OName (vla-get-ObjectName ob)
SF (vla-get-ScaleFactor ob)
)
(if (not (wcmatch OName "*AngularDimension"))
(progn
(setq LSF (vla-get-LinearScaleFactor ob))
(command "dimoverride" "dimlfac" (/ LSF k) "" e "")
)
)
(if (/= opt "N") (command "dimoverride" "dimscale" (* SF k) "" e ""))
(ssdel e ssd)
)
)
;;;-------------------------------------------------------------
(defun C:SCC( / ss ssd p k opt) ;;;SCale with Constant dimensions
(vl-load-com)
(setq
ss (ssget)
ssd (ssget "p" '((0 . "DIMENSION")))
p (getpoint "\nBase point:")
k (getreal "\nScale Factor:")
opt (strcase (getstring "\nDim scale overall? [Yes/No] :"))
)
(if (= opt "") (setq opt "N"))
(if (> k 1)
(progn (command "scale" ss "" p k) (SCDim))
(progn (SCDim) (command "scale" ss "" p k))
)
(princ)
)
;;;=================================
(defun C:CHD( / ss e txt n) ;;;CHeck Dimensions
(setq ss (ssget "X" '((0 . "DIMENSION"))))
(setq n 0)
(if (not (tblsearch "layer" "DimCheck"))
(command "Layer" "N" "DimCheck" "C" "Red" "DimCheck" "")
)
(while (setq e (ssname ss 0))
(setq txt (cdr (assoc 1 (entget e))))
(if (not (or (= txt "") (vl-string-search "<>" txt))) (progn
(command "change" e "" "p" "LA" "DimCheck" "")
(setq n (1+ n))
))
(ssdel e ss)
)
(if (= n 0) (setq S "Ket qua check: OK")
(setq S (strcat "Co " (itoa n) " Dimensions bi sua Text Override"
"\nDa duoc chuyen sang layer DimCheck co mau RED!")
)
)
(alert S)
(princ)
)
;;;=================================
(defun C:XY( / p1 p2)
(setq
p1 (getpoint "\nFirst point:")
p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X=" (rtos (car p1)) "\\PY=" (rtos (cadr p1))) "")
(princ)
)
;;;=================================
(defun C:CL(/ p r p1 p2 p3 p4 oldos oldlay) ;;;Center Line duong tron
(setq
p (getpoint "\nCenter point:")
oldOrtho (getvar "orthomode")
)
(setvar "orthomode" 1)
(setq r (getdist p "\nEnd point: "))
(Bdraw)
(SetLayer "CEN")
(command "line" (polar p pi r) (polar p 0 r) "")
(command "line" (polar p (/ pi 2) r) (polar p (/ pi -2) r) "")
(setvar "orthomode" oldOrtho)
(Edraw)
(princ)
)
;;;=================================
(defun C:L1( / e L) ;;;Do va ghi chieu dai 1 doi tuong
(setq e (car (entsel "\nSelect object:")))
(command "lengthen" e "")
(setq L (getvar "perimeter"))
(wtxt (strcat "L= " (rtos L)) (getpoint "\nPosition of text:"))
)
;;;=================================
(defun Measure1(e / L p)
(vl-load-com)
(setq
L (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
p (vlax-curve-getPointAtDist e (/ L 2))
)
(wtxt (strcat "L= " (rtos L)) p)
)
;;;-------------------------------------------------------------
(defun C:LL( / ss e) ;;;Do chieu dai nhieu doi tuong, cho phep chon hang loat
;;;Ket qua ghi tai diem giua cua tung doi tuong
(setq ss (ssget '((0 . "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"))))
(while (setq e (ssname ss 0))
(measure1 e)
(ssdel e ss)
)
)
;;;=================================
(defun C:LTO( / ss Le L e L1) ;;;Do va ghi tong chieu dai nhieu doi tuong
(setq
ss (ssget '((0 . "LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")))
Le (ss2ent ss)
L 0
)
(foreach e Le (setq L (+ L (getL e))))
(wtxt (strcat "Lt= " (rtos L)) (getpoint "\nPosition of text:"))
)
;;;=================================


2- Có vấn đề gì về sử dụng, các bạn phản hồi để ssg sửa

3- Cần bổ sung thêm những tiện ích gì thuộc dạng này không?
  • 0

#2 buiquangnam

buiquangnam

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 16 (tàm tạm)

Đã gửi 13 March 2009 - 11:48 AM

1- Vài tiện ích nhỏ, hy vọng có ích cho một số bạn thường phải xử lý Dim và Measure:


;;;=================================
;;;SMALL UTILITIES FOR DIMENSIONS AND MEASUREMENTS
;;;CAC TIEN ICH NHO VE KICH THUOC VA DO LUONG
;;;=================================
;;;HUONG DAN:
;;;SaveAs *.lsp, go lenh Appload, go cac lenh sau day de chay:
;;;-------------------------------------------------------------
;;;1- Lenh SCC: SCale with Constant dimensions
;;;Hoat dong nhu lenh Scale cua AutoCAD nhung giu nguyen gia tri Dim
;;;(chi co "Dim Scale Linear" va "Dim Scale Overall" thay doi)
;;;Cac thuoc tinh khac cua Dim khong bi anh huong
;;;Tuy chon Dim Scale Overall = Y cho phep scale ca cac yeu to khac cua Dim
;;;(text, kich thuoc mui ten, khoang nho ra cua duong giong...)
;;;Mac dinh la Dim Scale Overall = N
;;;Chap nhan cac Dim co DimStyle khac nhau
;;;-------------------------------------------------------------
;;;2- Lenh CHD: CHeck Dimensions
;;;Kiem tra toan bo cac doi tuong Dimensions co trong ban ve
;;;Dim bi edit bang Text Override se chuyen sang layer DimCheck co mau RED
;;;-------------------------------------------------------------
;;;3- Lenh XY: ghi toa do X, Y cua diem pick
;;;Ket qua ghi dang Leader va 1 Mtext co 2 dong
;;;-------------------------------------------------------------
;;;4- Lenh CL: ve Center Line cho duong tron tai layer CEN
;;;Neu Layer khong ton tai, chuong trinh tu tao layer CEN
;;;Voi thiet lap mau Magenta, Ltype ACAD_ISO04W100
;;;-------------------------------------------------------------
;;;5- Lenh L1: Do va ghi chieu dai 1 doi tuong, vi tri dat text do user chon
;;;-------------------------------------------------------------
;;;6- Lenh LL: Do va ghi chieu dai nhieu doi tuong, cho phep chon hang loat
;;;Vi tri dat text tai diem giua cua tung doi tuong
;;;-------------------------------------------------------------
;;;7- Lenh LTO: Do va ghi tong chieu dai nhieu doi tuong, user chon vi tri dat text
;;;-------------------------------------------------------------
;;;GHI CHU CHUNG VOI KET QUA GHI DANG TEXT
;;;Chuong trinh dung TextStyle hien hanh de ghi ket qua
;;;So chu so thap phan phu thuoc thiet lap Units
;;;Vao Format -> Units -> chon Precision tuy y
;;;-------------------------------------------------------------
;;;Copyright by ssg - www.cadviet.com - March 2009
;;;=================================
;;;PUBLIC FUNCTIONS
;;;=================================
(defun getL(e) ;;;Get Length of curve e
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;;-------------------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------------------
(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0 Le nil)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)
;;;-------------------------------------------------------------
(Defun Bdraw()
;;;Begin draw, get some current system variables, disable them
(setq OldOs (getvar "osmode"))
(setq OldLay (getvar "clayer"))
(setvar "osmode" 0)
)
;;;-------------------------------------------------------------
(Defun Edraw()
;;;End draw, reset all system variables
(setvar "osmode" OldOs)
(setvar "clayer" OldLay)
)
;;;-------------------------------------------------------------
(Defun SetLayer(MyLayer)
;;;Make and Set Layer
(if (not (tblsearch "LAYER" MyLayer)) (progn
(Cond
((= (strcase MyLayer) "0") (setq MyColor "White" MyLtype "Continuous"))
((= (strcase MyLayer) "CEN") (setq MyColor "Magenta" MyLtype "ACAD_ISO04W100"))
((= (strcase MyLayer) "DIM") (setq MyColor "Green" MyLtype "Continuous"))
((= (strcase MyLayer) "HATCH") (setq MyColor "Yellow" MyLtype "Continuous"))
((= (strcase MyLayer) "HID") (setq MyColor "Cyan" MyLtype "ACAD_ISO02W100"))
((= (strcase MyLayer) "STT") (setq MyColor 140 MyLtype "Continuous"))
((= (strcase MyLayer) "KHUNGTEN") (setq MyColor 120 MyLtype "Continuous"))
)
(Command "Layer" "N" MyLayer "L" MyLtype MyLayer "C" MyColor MyLayer "T" MyLayer "")
))
(setvar "CLayer" MyLayer)
)
;;;=================================
;;;DIMENSION AND GEOMETRIC COMMAND FUNCTIONS
;;;=================================
(defun SCDim( / e ob OName SF LSF)
(while (setq e (ssname ssd 0))
(setq
ob (vlax-ename->vla-object e)
OName (vla-get-ObjectName ob)
SF (vla-get-ScaleFactor ob)
)
(if (not (wcmatch OName "*AngularDimension"))
(progn
(setq LSF (vla-get-LinearScaleFactor ob))
(command "dimoverride" "dimlfac" (/ LSF k) "" e "")
)
)
(if (/= opt "N") (command "dimoverride" "dimscale" (* SF k) "" e ""))
(ssdel e ssd)
)
)
;;;-------------------------------------------------------------
(defun C:SCC( / ss ssd p k opt) ;;;SCale with Constant dimensions
(vl-load-com)
(setq
ss (ssget)
ssd (ssget "p" '((0 . "DIMENSION")))
p (getpoint "\nBase point:")
k (getreal "\nScale Factor:")
opt (strcase (getstring "\nDim scale overall? [Yes/No] :"))
)
(if (= opt "") (setq opt "N"))
(if (> k 1)
(progn (command "scale" ss "" p k) (SCDim))
(progn (SCDim) (command "scale" ss "" p k))
)
(princ)
)
;;;=================================
(defun C:CHD( / ss e txt n) ;;;CHeck Dimensions
(setq ss (ssget "X" '((0 . "DIMENSION"))))
(setq n 0)
(if (not (tblsearch "layer" "DimCheck"))
(command "Layer" "N" "DimCheck" "C" "Red" "DimCheck" "")
)
(while (setq e (ssname ss 0))
(setq txt (cdr (assoc 1 (entget e))))
(if (not (or (= txt "") (vl-string-search "<>" txt))) (progn
(command "change" e "" "p" "LA" "DimCheck" "")
(setq n (1+ n))
))
(ssdel e ss)
)
(if (= n 0) (setq S "Ket qua check: OK")
(setq S (strcat "Co " (itoa n) " Dimensions bi sua Text Override"
"\nDa duoc chuyen sang layer DimCheck co mau RED!")
)
)
(alert S)
(princ)
)
;;;=================================
(defun C:XY( / p1 p2)
(setq
p1 (getpoint "\nFirst point:")
p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X=" (rtos (car p1)) "\\PY=" (rtos (cadr p1))) "")
(princ)
)
;;;=================================
(defun C:CL(/ p r p1 p2 p3 p4 oldos oldlay) ;;;Center Line duong tron
(setq
p (getpoint "\nCenter point:")
oldOrtho (getvar "orthomode")
)
(setvar "orthomode" 1)
(setq r (getdist p "\nEnd point: "))
(Bdraw)
(SetLayer "CEN")
(command "line" (polar p pi r) (polar p 0 r) "")
(command "line" (polar p (/ pi 2) r) (polar p (/ pi -2) r) "")
(setvar "orthomode" oldOrtho)
(Edraw)
(princ)
)
;;;=================================
(defun C:L1( / e L) ;;;Do va ghi chieu dai 1 doi tuong
(setq e (car (entsel "\nSelect object:")))
(command "lengthen" e "")
(setq L (getvar "perimeter"))
(wtxt (strcat "L= " (rtos L)) (getpoint "\nPosition of text:"))
)
;;;=================================
(defun Measure1(e / L p)
(vl-load-com)
(setq
L (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
p (vlax-curve-getPointAtDist e (/ L 2))
)
(wtxt (strcat "L= " (rtos L)) p)
)
;;;-------------------------------------------------------------
(defun C:LL( / ss e) ;;;Do chieu dai nhieu doi tuong, cho phep chon hang loat
;;;Ket qua ghi tai diem giua cua tung doi tuong
(setq ss (ssget '((0 . "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"))))
(while (setq e (ssname ss 0))
(measure1 e)
(ssdel e ss)
)
)
;;;=================================
(defun C:LTO( / ss Le L e L1) ;;;Do va ghi tong chieu dai nhieu doi tuong
(setq
ss (ssget '((0 . "LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")))
Le (ss2ent ss)
L 0
)
(foreach e Le (setq L (+ L (getL e))))
(wtxt (strcat "Lt= " (rtos L)) (getpoint "\nPosition of text:"))
)
;;;=================================


2- Có vấn đề gì về sử dụng, các bạn phản hồi để ssg sửa

3- Cần bổ sung thêm những tiện ích gì thuộc dạng này không?


Thanks.
bạn có thể nói rõ thêm về các ứng dụng cũng như cách sử dụng(câu lệnh) được kô?

Bài viết đã được chỉnh sửa nội dung bởi ssg: 13 March 2009 - 04:14 PM
Sửa 1 dòng chú giải

  • 0

#3 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 13 March 2009 - 04:11 PM

Thanks.
bạn có thể nói rõ thêm về các ứng dụng cũng như cách sử dụng(câu lệnh) được kô?

Ssg nghĩ rằng các dòng hướng dẫn ở đầu chương trình đã đủ rồi. Tiếng Việt không dấu nhưng chắc không đến nỗi tối nghĩa! Chưa rõ lắm thì cứ chạy thử sẽ rõ.
  • 0

#4 ui_troi_2005

ui_troi_2005

    biết vẽ arc

  • Members
  • PipPip
  • 47 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 19 March 2009 - 09:14 AM

1- Vài tiện ích nhỏ, hy vọng có ích cho một số bạn thường phải xử lý Dim và Measure:


;;;=================================
;;;SMALL UTILITIES FOR DIMENSIONS AND MEASUREMENTS
;;;CAC TIEN ICH NHO VE KICH THUOC VA DO LUONG
;;;=================================
;;;HUONG DAN:
;;;SaveAs *.lsp, go lenh Appload, go cac lenh sau day de chay:
;;;-------------------------------------------------------------
;;;1- Lenh SCC: SCale with Constant dimensions
;;;Hoat dong nhu lenh Scale cua AutoCAD nhung giu nguyen gia tri Dim
;;;(chi co "Dim Scale Linear" va "Dim Scale Overall" thay doi)
;;;Cac thuoc tinh khac cua Dim khong bi anh huong
;;;Tuy chon Dim Scale Overall = Y cho phep scale ca cac yeu to khac cua Dim
;;;(text, kich thuoc mui ten, khoang nho ra cua duong giong...)
;;;Mac dinh la Dim Scale Overall = N
;;;Chap nhan cac Dim co DimStyle khac nhau
;;;-------------------------------------------------------------
;;;2- Lenh CHD: CHeck Dimensions
;;;Kiem tra toan bo cac doi tuong Dimensions co trong ban ve
;;;Dim bi edit bang Text Override se chuyen sang layer DimCheck co mau RED
;;;-------------------------------------------------------------
;;;3- Lenh XY: ghi toa do X, Y cua diem pick
;;;Ket qua ghi dang Leader va 1 Mtext co 2 dong
;;;-------------------------------------------------------------
;;;4- Lenh CL: ve Center Line cho duong tron tai layer CEN
;;;Neu Layer khong ton tai, chuong trinh tu tao layer CEN
;;;Voi thiet lap mau Magenta, Ltype ACAD_ISO04W100
;;;-------------------------------------------------------------
;;;5- Lenh L1: Do va ghi chieu dai 1 doi tuong, vi tri dat text do user chon
;;;-------------------------------------------------------------
;;;6- Lenh LL: Do va ghi chieu dai nhieu doi tuong, cho phep chon hang loat
;;;Vi tri dat text tai diem giua cua tung doi tuong
;;;-------------------------------------------------------------
;;;7- Lenh LTO: Do va ghi tong chieu dai nhieu doi tuong, user chon vi tri dat text
;;;-------------------------------------------------------------
;;;GHI CHU CHUNG VOI KET QUA GHI DANG TEXT
;;;Chuong trinh dung TextStyle hien hanh de ghi ket qua
;;;So chu so thap phan phu thuoc thiet lap Units
;;;Vao Format -> Units -> chon Precision tuy y
;;;-------------------------------------------------------------
;;;Copyright by ssg - www.cadviet.com - March 2009
;;;=================================
;;;PUBLIC FUNCTIONS
;;;=================================
(defun getL(e) ;;;Get Length of curve e
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;;-------------------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------------------
(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0 Le nil)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)
;;;-------------------------------------------------------------
(Defun Bdraw()
;;;Begin draw, get some current system variables, disable them
(setq OldOs (getvar "osmode"))
(setq OldLay (getvar "clayer"))
(setvar "osmode" 0)
)
;;;-------------------------------------------------------------
(Defun Edraw()
;;;End draw, reset all system variables
(setvar "osmode" OldOs)
(setvar "clayer" OldLay)
)
;;;-------------------------------------------------------------
(Defun SetLayer(MyLayer)
;;;Make and Set Layer
(if (not (tblsearch "LAYER" MyLayer)) (progn
(Cond
((= (strcase MyLayer) "0") (setq MyColor "White" MyLtype "Continuous"))
((= (strcase MyLayer) "CEN") (setq MyColor "Magenta" MyLtype "ACAD_ISO04W100"))
((= (strcase MyLayer) "DIM") (setq MyColor "Green" MyLtype "Continuous"))
((= (strcase MyLayer) "HATCH") (setq MyColor "Yellow" MyLtype "Continuous"))
((= (strcase MyLayer) "HID") (setq MyColor "Cyan" MyLtype "ACAD_ISO02W100"))
((= (strcase MyLayer) "STT") (setq MyColor 140 MyLtype "Continuous"))
((= (strcase MyLayer) "KHUNGTEN") (setq MyColor 120 MyLtype "Continuous"))
)
(Command "Layer" "N" MyLayer "L" MyLtype MyLayer "C" MyColor MyLayer "T" MyLayer "")
))
(setvar "CLayer" MyLayer)
)
;;;=================================
;;;DIMENSION AND GEOMETRIC COMMAND FUNCTIONS
;;;=================================
(defun SCDim( / e ob OName SF LSF)
(while (setq e (ssname ssd 0))
(setq
ob (vlax-ename->vla-object e)
OName (vla-get-ObjectName ob)
SF (vla-get-ScaleFactor ob)
)
(if (not (wcmatch OName "*AngularDimension"))
(progn
(setq LSF (vla-get-LinearScaleFactor ob))
(command "dimoverride" "dimlfac" (/ LSF k) "" e "")
)
)
(if (/= opt "N") (command "dimoverride" "dimscale" (* SF k) "" e ""))
(ssdel e ssd)
)
)
;;;-------------------------------------------------------------
(defun C:SCC( / ss ssd p k opt) ;;;SCale with Constant dimensions
(vl-load-com)
(setq
ss (ssget)
ssd (ssget "p" '((0 . "DIMENSION")))
p (getpoint "\nBase point:")
k (getreal "\nScale Factor:")
opt (strcase (getstring "\nDim scale overall? [Yes/No] :"))
)
(if (= opt "") (setq opt "N"))
(if (> k 1)
(progn (command "scale" ss "" p k) (SCDim))
(progn (SCDim) (command "scale" ss "" p k))
)
(princ)
)
;;;=================================
(defun C:CHD( / ss e txt n) ;;;CHeck Dimensions
(setq ss (ssget "X" '((0 . "DIMENSION"))))
(setq n 0)
(if (not (tblsearch "layer" "DimCheck"))
(command "Layer" "N" "DimCheck" "C" "Red" "DimCheck" "")
)
(while (setq e (ssname ss 0))
(setq txt (cdr (assoc 1 (entget e))))
(if (not (or (= txt "") (vl-string-search "<>" txt))) (progn
(command "change" e "" "p" "LA" "DimCheck" "")
(setq n (1+ n))
))
(ssdel e ss)
)
(if (= n 0) (setq S "Ket qua check: OK")
(setq S (strcat "Co " (itoa n) " Dimensions bi sua Text Override"
"\nDa duoc chuyen sang layer DimCheck co mau RED!")
)
)
(alert S)
(princ)
)
;;;=================================
(defun C:XY( / p1 p2)
(setq
p1 (getpoint "\nFirst point:")
p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X=" (rtos (car p1)) "\\PY=" (rtos (cadr p1))) "")
(princ)
)
;;;=================================
(defun C:CL(/ p r p1 p2 p3 p4 oldos oldlay) ;;;Center Line duong tron
(setq
p (getpoint "\nCenter point:")
oldOrtho (getvar "orthomode")
)
(setvar "orthomode" 1)
(setq r (getdist p "\nEnd point: "))
(Bdraw)
(SetLayer "CEN")
(command "line" (polar p pi r) (polar p 0 r) "")
(command "line" (polar p (/ pi 2) r) (polar p (/ pi -2) r) "")
(setvar "orthomode" oldOrtho)
(Edraw)
(princ)
)
;;;=================================
(defun C:L1( / e L) ;;;Do va ghi chieu dai 1 doi tuong
(setq e (car (entsel "\nSelect object:")))
(command "lengthen" e "")
(setq L (getvar "perimeter"))
(wtxt (strcat "L= " (rtos L)) (getpoint "\nPosition of text:"))
)
;;;=================================
(defun Measure1(e / L p)
(vl-load-com)
(setq
L (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
p (vlax-curve-getPointAtDist e (/ L 2))
)
(wtxt (strcat "L= " (rtos L)) p)
)
;;;-------------------------------------------------------------
(defun C:LL( / ss e) ;;;Do chieu dai nhieu doi tuong, cho phep chon hang loat
;;;Ket qua ghi tai diem giua cua tung doi tuong
(setq ss (ssget '((0 . "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"))))
(while (setq e (ssname ss 0))
(measure1 e)
(ssdel e ss)
)
)
;;;=================================
(defun C:LTO( / ss Le L e L1) ;;;Do va ghi tong chieu dai nhieu doi tuong
(setq
ss (ssget '((0 . "LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")))
Le (ss2ent ss)
L 0
)
(foreach e Le (setq L (+ L (getL e))))
(wtxt (strcat "Lt= " (rtos L)) (getpoint "\nPosition of text:"))
)
;;;=================================


2- Có vấn đề gì về sử dụng, các bạn phản hồi để ssg sửa

3- Cần bổ sung thêm những tiện ích gì thuộc dạng này không?


Chào bác SSQ.

các lisp bác đưa lên thật tuyệt vời, em cảm ơn bác nhiều lắm.
nhưng em có một thắc mắc nhỏ là cái lệnh LTO đó nó luông luôn tính tổng ở tỉ lệ 1:1, nếu bản vẽ vẽ ở tỉ lệ khác thì nó ko theo tỉ lệ đó, trong khi đó các kthước đo ở tỉ lệ đó vànhư vậy có mâu thuẫn giữa kthước và tổng kthước, mong bác xem lại và có thể cho bản tính tỏng đó hoànthiện hơn.

Rất cảm ơn bác.
  • 0
Úi Trời!!!!!!!!!!!!!!!

#5 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 20 March 2009 - 08:04 PM

1- Vài tiện ích nhỏ, hy vọng có ích cho một số bạn thường phải xử lý Dim và Measure
2- Có vấn đề gì về sử dụng, các bạn phản hồi để ssg sửa
3- Cần bổ sung thêm những tiện ích gì thuộc dạng này không?

SSg sửa lại lệnh LL : đo và ghi chiều dài nhiều đối tượng, bỡi vì anh em địa chính sẽ rất cần cái này để ghi kích thước cạnh thửa đất, mà lệnh LL của SSG cho ra kết quả không thuộc "qui phạm", đặt biệt nếu thửa đất tạo bằng polyline kín thì nó cho kết quả chu vi chứ không phải từng cạnh.
Đây là file tham khảo
http://www.cadviet.c...huocthuadat.dwg
Mong hối âm của SSg. Thanks!
  • 0

#6 ui_troi_2005

ui_troi_2005

    biết vẽ arc

  • Members
  • PipPip
  • 47 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 24 March 2009 - 10:27 AM

SSg sửa lại lệnh LL : đo và ghi chiều dài nhiều đối tượng, bỡi vì anh em địa chính sẽ rất cần cái này để ghi kích thước cạnh thửa đất, mà lệnh LL của SSG cho ra kết quả không thuộc "qui phạm", đặt biệt nếu thửa đất tạo bằng polyline kín thì nó cho kết quả chu vi chứ không phải từng cạnh.
Đây là file tham khảo
http://www.cadviet.c...huocthuadat.dwg
Mong hối âm của SSg. Thanks!


Chào bác SSG.

Lệnh SCC đó sau khi sử dụng nó không thể edit size kthước đc. mong bác sửa lại hiện tại em sủa nó phải xoá đi rồi trả lại kthước cũ rồi mới thay đổi size đc..

Chúc bác và anh em trong diễn đàn luôn vui.
  • 0
Úi Trời!!!!!!!!!!!!!!!

#7 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 25 March 2009 - 07:45 AM

Chào bác SSG.

Lệnh SCC đó sau khi sử dụng nó không thể edit size kthước đc. mong bác sửa lại hiện tại em sủa nó phải xoá đi rồi trả lại kthước cũ rồi mới thay đổi size đc..

Chúc bác và anh em trong diễn đàn luôn vui.

Không hiểu ý, edit size là làm gì? Tại sao không edit được?
Xin diễn giải bản chất của SCC:
- Scale toàn bộ với hệ số k do user nhập vào
- Duyệt qua tất cả các đối tượng dim bị scale
- Với từng đối tượng dim:
+ Chia Dimscale Linear với k
+ Nhân Dimscale Overall với k (nếu user chọn "Y" khi được hỏi)
Hai động tác trên tương đương với việc chọn đối tượng dim, gõ lệnh mo và sửa thủ công. Điểm khác nhau duy nhất là chương trình làm hàng loạt và tự động nên nhanh hơn "by hand". Đơn giản vậy thôi. Bạn thử làm thủ công cho 1 dim nào đó, so sánh kết quả với SCC sẽ hiểu ra thực chất vấn đề.

Ngoài ra, ssg xin ghi nhận các góp ý của tất cả các bạn về topic này. Tuy nhiên, ssg đang có rất nhiều việc cấp bách, "nước sôi lửa bỏng" trong công việc nên chưa xem được gì cả. Hẹn các bạn lúc nào đó thư thả hơn. Trước mắt, có lẽ ssg sẽ vắng mặt trên diễn đàn một thời gian khá dài (không xác định trước được). Mong các bạn hiểu và thông cảm cho.
Chúc anh em vui khoẻ. Good bye! See you again!
Ssg
  • 0