| Info | File |
Tác giả: Tot77
Bài viết gốc: 302174
Tên lệnh: cpy |
Lisp copy nhanh đối tượng theo nhiều khoảng cách
nizagara medicine ajax “I really don’t feel like we ever really played at a high level,” Nash said. “Yeah, we won at a high level, but i don’t think we ever did feel comfortable or confident out there. We were winning games and scrapping and fighting and turning around, but we never found that commonality. We never found that confidence as a team.”
|
Tác giả: pphung183
Bài viết gốc: 302200
Tên lệnh: k |
các bác cho em xin lisp khổ giấy với ạ
Lâu rồi không biết tay nghề có bị cùn ko nữa, bạn nguyentan1991 thử xem nhé!
(defun c:k (/ oldlst a b c d e f g h kho TL)
(command "undo" "be")
(setq oldlst (mapcar 'getvar (list "CMDECHO" "OSMODE" "cecolor")))
(setvar "CMDECHO" 0)
(setq a (getpoint "\n chon diem chen :"))
(if (not TL) (setq TL 1.00))
(setq...
>> Lâu rồi không biết tay nghề có bị cùn ko nữa, bạn nguyentan1991 thử xem nhé!
(defun c:k (/ oldlst a b c d e f g h kho TL)
(command "undo" "be")
(setq oldlst (mapcar 'getvar (list "CMDECHO" "OSMODE" "cecolor")))
(setvar "CMDECHO" 0)
(setq a (getpoint "\n chon diem chen :"))
(if (not TL) (setq TL 1.00))
(setq TL1 (getDIST (strcat "\nScale <" (rtos TL 2 2) ">:")))
(if TL1 (setq TL TL1))
(setvar "osmode" 0)
(if (not (tblsearch "layer" "Defpoints")) (Command "layer" "N" "Defpoints" ""))
(initget "0 1 2 3 4")
(setq kho (getkword "\Kho A0 _ Kho A1 _ Kho A2 _ Kho A3 _ Kho A4 ? <0>:"))
(if (= kho "0")
(progn
(setq b (polar a 0 (* TL 1189)))
(setq c (polar b (/ pi 2) (* TL 841)))
(setq d (polar a (/ pi 2) (* TL 841)))
(setq e (polar a (/ pi 4) (* TL (sqrt (* 2 12 12)))))
(setq f (polar e 0 (- (* TL 1189) (* TL 24))))
(setq g (polar f (/ pi 2) (- (* TL 841) (* TL 24))))
(setq h (polar e (/ pi 2) (- (* TL 841) (* TL 24))))
(command "Pline" e f g h "c")
(command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
(command "Pline" a b c d "c")
(command "change" "last" "" "properties" "layer" "defpoints" "")))
(if (= kho "1")
(progn
(setq b (polar a 0 (* TL 841)))
(setq c (polar b (/ pi 2) (* TL 594)))
(setq d (polar a (/ pi 2) (* TL 594)))
(setq e (polar a (/ pi 4) (* TL (sqrt (* 2 12 12)))))
(setq f (polar e 0 (- (* TL 841) (* TL 24))))
(setq g (polar f (/ pi 2) (- (* TL 594) (* TL 24))))
(setq h (polar e (/ pi 2) (- (* TL 594) (* TL 24))))
(command "Pline" e f g h "c")
(command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
(command "Pline" a b c d "c")
(command "change" "last" "" "properties" "layer" "defpoints" "")))
(if (= kho "2")
(progn
(setq b (polar a 0 (* TL 594)))
(setq c (polar b (/ pi 2) (* TL 420)))
(setq d (polar a (/ pi 2) (* TL 420)))
(setq e (polar a (/ pi 4) (* TL (sqrt (* 2 100)))))
(setq f (polar e 0 (- (* TL 594) (* TL 20))))
(setq g (polar f (/ pi 2) (- (* TL 420) (* TL 20))))
(setq h (polar e (/ pi 2) (- (* TL 420) (* TL 20))))
(command "Pline" e f g h "c")
(command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
(command "Pline" a b c d "c")
(command "change" "last" "" "properties" "layer" "defpoints" "")))
(if (= kho "3")
(progn
(setq b (polar a 0 (* tl 420)))
(setq c (polar b (/ pi 2) (* TL 297)))
(setq d (polar a (/ pi 2) (* TL 297)))
(setq e (polar a (/ pi 4) (* TL (sqrt (* 2 100)))))
(setq f (polar e 0 (- (* TL 420) (* TL 20))))
(setq g (polar f (/ pi 2) (- (* TL 297) (* TL 20))))
(setq h (polar e (/ pi 2) (- (* TL 297) (* TL 20))))
(command "Pline" e f g h "c")
(command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
(command "Pline" a b c d "c")
(command "change" "last" "" "properties" "layer" "defpoints" "")))
(if (= kho "4")
(progn
(setq b (polar a 0 (* TL 297)))
(setq c (polar b (/ pi 2) (* TL 210)))
(setq d (polar a (/ pi 2) (* TL 210)))
(setq e (polar a (/ pi 4) (* TL (sqrt (* 2 81)))))
(setq f (polar e 0 (- (* TL 297) (* TL 18))))
(setq g (polar f (/ pi 2) (- (* TL 210) (* TL 18))))
(setq h (polar e (/ pi 2) (- (* TL 210) (* TL 18))))
(command "Pline" e f g h "c")
(command "change" "last" "" "properties" "layer" "0" "")
(setvar "cecolor" "4")
(command "Pline" a b c d "c")
(command "change" "last" "" "properties" "layer" "defpoints" "")))
(mapcar 'setvar (list "CMDECHO" "OSMODE" "cecolor") oldlst)
(command "undo" "e")
(princ))
<< |
Tác giả: Snowman
Bài viết gốc: 24513
Tên lệnh: c m ucd xc |
Cho em hỏi chút về lệnh battman
Lỗi phát sinh là do loại block động khi copy không còn mang tên của block gốc (mã (2."*") không giống block gốc)
Tôi đã sửa lại lisp copy block cao độ cho phù hợp, bạn có thể copy rồi chèn bao nhiêu vị trí tuỳ thích.
Lisp cũ chỉ có tác dụng với những block có tên "ac", tôi đã sửa lại có thể dùng với tên block bất kỳ (có thể gây lỗi khi chọn nhầm loại block khác, không... >> Lỗi phát sinh là do loại block động khi copy không còn mang tên của block gốc (mã (2."*") không giống block gốc)
Tôi đã sửa lại lisp copy block cao độ cho phù hợp, bạn có thể copy rồi chèn bao nhiêu vị trí tuỳ thích.
Lisp cũ chỉ có tác dụng với những block có tên "ac", tôi đã sửa lại có thể dùng với tên block bất kỳ (có thể gây lỗi khi chọn nhầm loại block khác, không có attribute-nên lưu ý khi dùng)
Đây là đoạn lisp mới
<<
|
|
Filename: 24513_c_m_ucd_xc.lsp
|
|
Tác giả: Doan Van Ha
Bài viết gốc: 302479
Tên lệnh: ha | |
Tác giả: toiyeuvietnam
Bài viết gốc: 302607
Tên lệnh: layoff lo |
Em cần Lisp bật tắt layer... (layon, layoff, layiso)
các anh ơi, nhò các anh giúp sủa doạn đoạn code Layoff dưới đây, dể pick đối tượng Layer nào thì đối tượng đó tắt ngay mà không phải Enter sau khi chon đối tượng giống như Freeze đấy!
;;; ============================ Layer OFF =================================
(DEFUN LAYOFF (/ SSET SSL ENT LAY I MODE)
(setvar "cmdecho" 0)
(prompt "\nTuan Giap hay chon doi tuong tren layer(s) muon OFF: ")
...
>> các anh ơi, nhò các anh giúp sủa doạn đoạn code Layoff dưới đây, dể pick đối tượng Layer nào thì đối tượng đó tắt ngay mà không phải Enter sau khi chon đối tượng giống như Freeze đấy!
;;; ============================ Layer OFF =================================
(DEFUN LAYOFF (/ SSET SSL ENT LAY I MODE)
(setvar "cmdecho" 0)
(prompt "\nTuan Giap hay chon doi tuong tren layer(s) muon OFF: ")
(SETQ SSET (SSGET))
(IF (/= NIL SSET) (PROGN (SETQ SSL (SSLENGTH SSET)) (SETQ LAY "") (SETQ I 0) (SETQ MODE 0)
(WHILE (< I SSL) (SETQ ENT (ENTGET (SSNAME SSET I)))
(IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
(SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) )) (SETQ I (+ I 1)))
(COMMAND "LAYER" "OFF" LAY "")
(IF (= MODE 1) (COMMAND ""))))
(setq Loff6 Loff5) (setq Loff5 Loff4) (setq Loff4 Loff3) (setq Loff3 Loff2) (setq Loff2 Loff1) (setq Loff1 LAY)
(princ (strcat "\n Layer : " LAY " da OFF.")) (setvar "cmdecho" 1) (princ))(defun c:LAYOFF () (layoff))
(defun c:LO () (layoff))
<<
|
|
Filename: 302607_layoff_lo.lsp
|
|
Tác giả: Tot77
Bài viết gốc: 297588
Tên lệnh: cat cat |
Lisp trim đối tượng
Bạn dùng thử cái này. Cần lưu ý:
Bạn dùng thử cái này. Cần lưu ý:
Bạn dùng thử cái này. Cần lưu ý:
1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.
2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.
3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.
Sở dĩ phải...
>> Bạn dùng thử cái này. Cần lưu ý:
Bạn dùng thử cái này. Cần lưu ý:
Bạn dùng thử cái này. Cần lưu ý:
1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.
2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.
3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.
Sở dĩ phải có giai đoạn nhập phía và số line chọn khác nhau là để cho lisp đỡ phải "phán đoán" (công đoạn này cũng nhiêu khê lắm).
(defun c:cat()
(defun dxf(id v) (cdr (assoc id (entget v))))
(defun midp(d1 d2) (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
(defun gan(pt v) (inters (dxf 10 v) (dxf 11 v) pt (polar pt (+ 1.5708 (angle (dxf 10 v) (dxf 11 v))) 1) nil))
(defun cdd(v1 v2)
(or (equal (angle (dxf 10 v1) (dxf 11 v1)) (angle (dxf 10 v2) (dxf 11 v2)) 0.001)
(equal (angle (dxf 11 v1) (dxf 10 v1)) (angle (dxf 10 v2) (dxf 11 v2)) 0.001))
)
(defun trim(v l / ll)
(if (setq ll (mapcar '(lambda(x) (inters (dxf 10 v) (dxf 11 v) (dxf 10 x) (dxf 11 x) nil)) l))
(command "trim" (acet-list-to-ss l) "" (list v (midp (car ll) (last ll))) "")
nil)
)
(defun cat(l1 l2)
(cond ((and (= (length l1) 1) (= (length l2) 1))
(setq phia (getpoint "\nPhia bi cat:"))
(command "trim" (acet-list-to-ss l2) "" (list (car l1) (gan phia (car l1))) "")
(command "trim" (acet-list-to-ss l1) "" (list (car l2) (gan phia (car l2))) ""))
((and (= (length l1) 1) (= (length l2) 2))
(setq phia (getpoint "\nPhia bi cat:")) (trim (car l1) l2)
(command "trim" (acet-list-to-ss l1) "" (list (car l2) (gan phia (car l2))) "")
(command "trim" (acet-list-to-ss l1) "" (list (last l2) (gan phia (last l2))) ""))
((and (= (length l1) 2) (= (length l2) 2))
(trim (car l1) l2) (trim (last l1) l2)
(trim (car l2) l1) (trim (last l2) l1))
)
)
;;;
(setvar 'edgemode 1)
(command "undo" "be")
(setq ss (acet-ss-to-list (ssget '((0 . "LINE"))))
ss1 nil
os (getvar 'osmode))
(setvar 'osmode 0)
(while ss
(setq ss1 (if (setq tm (vl-remove-if-not '(lambda(x) (cdd (car ss) x)) ss))
(cons tm ss1) (cons (list (car ss)) ss1))
ss (vl-remove-if '(lambda(x) (cdd (car ss) x)) ss))
)
(setq ss1 (vl-sort ss1 '(lambda(x y) (< (length x) (length y)))))
(cat (car ss1) (last ss1))
(command "undo" "e")
(setvar 'osmode os) (princ)
)
1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.
2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.
3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.
Sở dĩ phải có giai đoạn nhập phía và số line chọn khác nhau là để cho lisp đỡ phải "phán đoán" (công đoạn này cũng nhiêu khê lắm).
1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.
2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.
3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.
1. Nếu là tường góc thì chỉ chọn 2 line rồi nhập phía bị cắt.
2. Nếu là tường biên thì chọn 3 line (biên trong tường và 2 line cắt) rồi cũng nhập phía bị cắt.
3. Nếu là tường giữa thì chọn cả 4 line, không cần nhập phía gì cả.
Sở dĩ phải có giai đoạn nhập phía và số line chọn khác nhau là để cho lisp đỡ phải "phán đoán" (công đoạn này cũng nhiêu khê lắm).
<<
|
|
Filename: 297588_cat_cat.lsp
|
|
Tác giả: Nguyen Hoanh
Bài viết gốc: 13085
Tên lệnh: bl1 |
Kô hiện bảng Layer Properties Manager & Plot khi dùng lisp
intivar does not work States experiencing problems were Alabama, California,Georgia, Iowa, Illinois, Louisiana, Massachusetts, Maryland,Maine, Michigan, Mississippi, New Jersey, Ohio, Oklahoma,Pennsylvania, Texas and Virginia, Lightfoot said. humana medicare part d mail order pharmacy Nothing is quite perfect this season in the Bronx, so Rivera... >> intivar does not work States experiencing problems were Alabama, California,Georgia, Iowa, Illinois, Louisiana, Massachusetts, Maryland,Maine, Michigan, Mississippi, New Jersey, Ohio, Oklahoma,Pennsylvania, Texas and Virginia, Lightfoot said. humana medicare part d mail order pharmacy Nothing is quite perfect this season in the Bronx, so Rivera came into his second straight game Thursday with the Yanks losing big, this time on their way to a 4-0 defeat to Tampa Bay. An old Bob Sheppard recording and âEnter Sandmanâ heralded his arrival from the pen. The Stadium pulsated. He got Delmon Young to fly out, Sam Fuld to ground back to the mound, stranding two Rays runners. marksans pharma share price tips Thecompany employs around 2,500 people, with offices in Wimbledon, Brighton,Nottingham and Bedworth. Existing management, led by chief executive JohnPearmund, continue to have a stake in the business after todayâs deal. <<
|
Tác giả: dongkhanhlove
Bài viết gốc: 13089
Tên lệnh: geb |
convert anonymous block to normal block
Bác Hoành ơi ! Dù em đã copy thật là kỹ nhưng chẳng hiểu sao cad cứ báo lỗi là :
Command: ap
APPLOAD convertanyblock.lsp successfully loaded.
Command:
Copyright © 1998, Fabricated Designs, Inc.
Loading UnAnon v1.0 .....; error: malformed string on input
Command: UnAnon
Unknown command "UNANON". Press F1 for help.
Command: UnAnonall
Unknown command... >> Bác Hoành ơi ! Dù em đã copy thật là kỹ nhưng chẳng hiểu sao cad cứ báo lỗi là :
Command: ap
APPLOAD convertanyblock.lsp successfully loaded.
Command:
Copyright © 1998, Fabricated Designs, Inc.
Loading UnAnon v1.0 .....; error: malformed string on input
Command: UnAnon
Unknown command "UNANON". Press F1 for help.
Command: UnAnonall
Unknown command "UNANONALL". Press F1 for help. << |
Tác giả: phamthe
Bài viết gốc: 303257
Tên lệnh: autopl |
nhờ sửa lisp vẽ Pline tự động
nhờ các anh sửa giúp đoạn code dưới đây nối các điểm Point lại với nhau thành Pline bằng đưa chuột đến các điểm nhưng có thể Zoom to khi cần bắt điểm gần nhau và có thể Undo khi bắt điểm sai với!
(defun c:AutoPL ( / *ModSpc *ActDoc *acad ss sslen junk done pnt ep )
(setq *ModSpc (vlax-get-property (setq *ActDoc (vlax-get-property (setq *acad (vlax-get-acad-object))...
>> nhờ các anh sửa giúp đoạn code dưới đây nối các điểm Point lại với nhau thành Pline bằng đưa chuột đến các điểm nhưng có thể Zoom to khi cần bắt điểm gần nhau và có thể Undo khi bắt điểm sai với!
(defun c:AutoPL ( / *ModSpc *ActDoc *acad ss sslen junk done pnt ep )
(setq *ModSpc (vlax-get-property (setq *ActDoc (vlax-get-property (setq *acad (vlax-get-acad-object)) 'ActiveDocument)) 'ModelSpace))
(princ "\nSelect Point Objects:")
(if
(and
(setq ss (ssget '(( 0 . "POINT")))) (setq junk (getpoint "\nClick to Start")))
(progn
(setq sslen (sslength ss))
(setq drawn nil)
(setq done nil)
(while
(and (= 5 (car (setq pnt (grread T 1 0)))) (= done nil))
(setq ep (is_nearest ss (nth 1 pnt)))
(cond
((= drawn nil)(progn
(setq drawn (list (car ep)))
(drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates))))))
((= (length drawn) 1)(if (not (is_drawn (car ep)))
(progn
(setq drawn (cons (car ep) drawn))
(drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
((>= (length drawn) 2)(if (not (is_drawn (car ep)))
(progn
(setq drawn (cons (car ep) drawn))
(drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
)
(if (= sslen (length drawn))
(setq done T)))
(setq pl-obj (vlax-invoke-method *ModSpc 'Addpolyline (pl->var (drawn->pntlist)))))
(exit))
(princ)
)
BAN VẼ TEST http://www.cadviet.com/upfiles/3/116810_drawing_test.dwg
<<
|
|
Filename: 303257_autopl.lsp
|
|
Tác giả: Tot77
Bài viết gốc: 303404
Tên lệnh: dtb |
hỏi về mline?
BlockReplace thay đổi toàn bộ block này sang block khác.
Còn nếu muốn chỉ đổi 1 số thôi thì dùng lisp này, với điều kiện là block mới có hiện diện trong bản vẽ, chứ nếu chưa có thì không đổi tên được, đồng thời nó đổi luôn hình dạng theo block mới.
(defun c:dtb(/ tencu tenmoi ssl)
(setq tencu (getstring "\nTen block cu:")
tenmoi (getstring "\nTen block...
>> BlockReplace thay đổi toàn bộ block này sang block khác.
Còn nếu muốn chỉ đổi 1 số thôi thì dùng lisp này, với điều kiện là block mới có hiện diện trong bản vẽ, chứ nếu chưa có thì không đổi tên được, đồng thời nó đổi luôn hình dạng theo block mới.
(defun c:dtb(/ tencu tenmoi ssl)
(setq tencu (getstring "\nTen block cu:")
tenmoi (getstring "\nTen block moi:")
ssl (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list '(0 . "INSERT") (cons 2 tencu))))))
)
(mapcar '(lambda(x) (entmod (subst (cons 2 tenmoi) (assoc 2 (entget x)) (entget x)))) ssl)
(princ)
)
<< |
Tác giả: Tot77
Bài viết gốc: 303439
Tên lệnh: sss |
Nhờ viết lisp vẽ đoạn thẳng song song
Xài thử cái này.
(defun c:sss()
(setq ss (ssget '((0 . "POINT")))
dss (car (entsel "\nDuong song song:"))
ss10 (cdr (assoc 10 (entget dss)))
ss11 (cdr (assoc 11 (entget dss)))
dgh (car (entsel "\nDuong gioi han:"))
gh10 (cdr (assoc 10 (entget dgh)))
gh11 (cdr (assoc 11 (entget dgh)))
os (getvar 'osmode))
(setvar 'osmode 0)
(foreach pt (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq pt (cdr (assoc 10 (entget pt...
>> Xài thử cái này.
(defun c:sss()
(setq ss (ssget '((0 . "POINT")))
dss (car (entsel "\nDuong song song:"))
ss10 (cdr (assoc 10 (entget dss)))
ss11 (cdr (assoc 11 (entget dss)))
dgh (car (entsel "\nDuong gioi han:"))
gh10 (cdr (assoc 10 (entget dgh)))
gh11 (cdr (assoc 11 (entget dgh)))
os (getvar 'osmode))
(setvar 'osmode 0)
(foreach pt (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq pt (cdr (assoc 10 (entget pt )))
ints (inters pt (polar pt (angle ss10 ss11) 1) gh10 gh11 nil))
(command "line" pt ints ""))
(setvar 'osmode os)
)
<< |
Tác giả: Tot77
Bài viết gốc: 303450
Tên lệnh: sss |
Nhờ viết lisp vẽ đoạn thẳng song song
Pick từng điểm thì dĩ nhiên được nhưng như vậy thì vất vả quá!! :wub:
(defun c:sss(/ dss ss10 ss11 dgh gh10 gh11 os pt)
(setq dss (car (entsel "\nDuong song song:"))
ss10 (cdr (assoc 10 (entget dss)))
ss11 (cdr (assoc 11 (entget dss)))
dgh (car (entsel "\nDuong gioi han:"))
gh10 (cdr (assoc 10 (entget dgh)))
gh11 (cdr (assoc 11 (entget dgh)))
os (getvar 'osmode))
(setvar 'osmode 0)
(while (and (setq pt (car...
>> Pick từng điểm thì dĩ nhiên được nhưng như vậy thì vất vả quá!! :wub:
(defun c:sss(/ dss ss10 ss11 dgh gh10 gh11 os pt)
(setq dss (car (entsel "\nDuong song song:"))
ss10 (cdr (assoc 10 (entget dss)))
ss11 (cdr (assoc 11 (entget dss)))
dgh (car (entsel "\nDuong gioi han:"))
gh10 (cdr (assoc 10 (entget dgh)))
gh11 (cdr (assoc 11 (entget dgh)))
os (getvar 'osmode))
(setvar 'osmode 0)
(while (and (setq pt (car (entsel "\nChon Diem:")))
(= (cdr (assoc 0 (entget pt))) "POINT"))
(command "line" (setq pt (cdr (assoc 10 (entget pt))))
(inters pt (polar pt (angle ss10 ss11) 1) gh10 gh11 nil) ""))
(setvar 'osmode os) (princ)
)
(defun c:sss(/ dss ss10 ss11 dgh gh10 gh11 os pt)
(setq dss (car (entsel "\nDuong song song:"))
ss10 (cdr (assoc 10 (entget dss)))
ss11 (cdr (assoc 11 (entget dss)))
dgh (car (entsel "\nDuong gioi han:"))
gh10 (cdr (assoc 10 (entget dgh)))
gh11 (cdr (assoc 11 (entget dgh)))
os (getvar 'osmode))
(setvar 'osmode 0)
(while (and (setq pt (car (entsel "\nChon Diem:")))
(= (cdr (assoc 0 (entget pt))) "POINT"))
(command "line" (setq pt (cdr (assoc 10 (entget pt))))
(inters pt (polar pt (angle ss10 ss11) 1) gh10 gh11 nil) ""))
(setvar 'osmode os) (princ)
)
<<
|
Tác giả: Tot77
Bài viết gốc: 303453
Tên lệnh: sss |
Nhờ viết lisp vẽ đoạn thẳng song song
Vậy mà trong bản vẽ bạn đưa rõ ràng là các điểm (point ) A,B,C. Thôi được, vậy thì cái này.
(defun c:sss(/ dss ss10 ss11 dgh gh10 gh11 os pt)
(setq dss (car (entsel "\nDuong song song:"))
ss10 (cdr (assoc 10 (entget dss)))
ss11 (cdr (assoc 11 (entget dss)))
dgh (car (entsel "\nDuong gioi han:"))
gh10 (cdr (assoc 10 (entget dgh)))
gh11 (cdr (assoc 11 (entget dgh)))
)
(while (setq pt (getpoint "\nChon...
>> Vậy mà trong bản vẽ bạn đưa rõ ràng là các điểm (point ) A,B,C. Thôi được, vậy thì cái này.
(defun c:sss(/ dss ss10 ss11 dgh gh10 gh11 os pt)
(setq dss (car (entsel "\nDuong song song:"))
ss10 (cdr (assoc 10 (entget dss)))
ss11 (cdr (assoc 11 (entget dss)))
dgh (car (entsel "\nDuong gioi han:"))
gh10 (cdr (assoc 10 (entget dgh)))
gh11 (cdr (assoc 11 (entget dgh)))
)
(while (setq pt (getpoint "\nChon Diem:"))
(command "line" "_non" pt "_non" (inters pt (polar pt (angle ss10 ss11) 1) gh10 gh11 nil) ""))
(princ)
)
<< |
Tác giả: Tot77
Bài viết gốc: 303678
Tên lệnh: kn |
Nhờ các anh chị giúp 1 đoạn LISP!
Bạn dùng thử cái này. Dùng cho dim dli và dal. Chọn dim trước rồi chọn line.
Đối với dim dal thì nếu dim và line không song song thì trị của dim sẽ đổi.
(defun c:kn(/ ss a)
(prompt "\nChon Dim:")
(setq ss (ssget '((0 . "Dimension") (15 0.0 0.0 0.0)))
a (car (entsel "\nChon Line:"))
a1 (vlax-curve-getstartpoint a)
a2 (vlax-curve-getendpoint a))
(foreach obj (vl-remove-if 'listp...
>> Bạn dùng thử cái này. Dùng cho dim dli và dal. Chọn dim trước rồi chọn line.
Đối với dim dal thì nếu dim và line không song song thì trị của dim sẽ đổi.
(defun c:kn(/ ss a)
(prompt "\nChon Dim:")
(setq ss (ssget '((0 . "Dimension") (15 0.0 0.0 0.0)))
a (car (entsel "\nChon Line:"))
a1 (vlax-curve-getstartpoint a)
a2 (vlax-curve-getendpoint a))
(foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq tt13 (cdr (assoc 13 (entget obj)))
tt10 (cdr (assoc 10 (entget obj)))
tt14 (cdr (assoc 14 (entget obj)))
tt50 (+ 1.5708 (cdr (assoc 50 (entget obj))))
a14 (inters tt14 (polar tt14 tt50 1) a1 a2 nil)
a13 (inters tt13 (polar tt13 tt50 1) a1 a2 nil))
(entmod (subst (cons 13 a13) (assoc 13 (entget obj)) (entget obj)))
(entmod (subst (cons 14 a14) (assoc 14 (entget obj)) (entget obj)))
(entmod (subst (cons 10 tt10) (assoc 10 (entget obj)) (entget obj)))
)
)
<< |
Tác giả: voicoibk
Bài viết gốc: 13124
Tên lệnh: loadit |
Lại lỗi in ấn thôi!
Các Bác ơi giúp em với!
Em dùng autocad 2007, có điều khi vẽ đặt khá nhiều lớp màu. Khi in thì màu xanh, màu đỏ và một số màu khác khác mờ (Mặc dù đặt kích thước nét đã như nhau). Khi in bằng máy pho to thì mức độ đậm nhạt không khác biệt nhiều, nhưng khi in bằng máy in thì lộ rõ phần màu rất mờ nhạt. Em không biết chỉnh nó ở chỗ nào nữa, ra hàng hỏi thì họ dấu nghề không bảo... >> Các Bác ơi giúp em với!
Em dùng autocad 2007, có điều khi vẽ đặt khá nhiều lớp màu. Khi in thì màu xanh, màu đỏ và một số màu khác khác mờ (Mặc dù đặt kích thước nét đã như nhau). Khi in bằng máy pho to thì mức độ đậm nhạt không khác biệt nhiều, nhưng khi in bằng máy in thì lộ rõ phần màu rất mờ nhạt. Em không biết chỉnh nó ở chỗ nào nữa, ra hàng hỏi thì họ dấu nghề không bảo thế mới ức chứ. Có bác nào biết cách chỉ giúp em với nhé! Ngàn lần cảm ơn!!!! <<
|
|
Filename: 13124_loadit.lsp
|
|
Tác giả: mrphuocvie
Bài viết gốc: 303675
Tên lệnh: dte |
Nhờ các anh chị giúp 1 đoạn LISP!
Dạ đúng ah!
Em có viết thử 1 đoạn LISP với sự "tận dụng" lại đoạn LISP cutdim trên diễn đàn nhưng vẫn còn bị lỗi. Mong mọi người xem và chỉnh sửa lại giúp em.
Lỗi như sau:
-Khi đầu line PT10 thu về đầu line thì dim đó sẽ trả về giá trị 0.
;;Keo chan dim ve!
(DEFUN C:DTE (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
...
>> Dạ đúng ah!
Em có viết thử 1 đoạn LISP với sự "tận dụng" lại đoạn LISP cutdim trên diễn đàn nhưng vẫn còn bị lỗi. Mong mọi người xem và chỉnh sửa lại giúp em.
Lỗi như sau:
-Khi đầu line PT10 thu về đầu line thì dim đó sẽ trả về giá trị 0.
;;Keo chan dim ve!
(DEFUN C:DTE (/ 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 DEM 0)
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(WHILE (< DEM LTH)
(PROGN
(SETQ PT (CDR (ASSOC 10 (ENTGET (SSNAME SS DEM)))))
(SETQ PT (TRANS PT 1 0))
(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 0) (= 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 "\nCompleted command!")
(PRINC)
)
<< |
Tác giả: MANHHUNGXDA
Bài viết gốc: 13132
Tên lệnh: loadit |
TỔNG HỢP CÁC LISP MH!!!
vâng, em bỏ cái WBM đi, ai mà có cái WBM thì copy cái file .exe vào cho đầy đủ nhé
http://www.cadviet.com/upfiles/gui_cadviet_1.rar
|
|
Filename: 13132_loadit.lsp
|
|
Tác giả: interwar1283
Bài viết gốc: 13098
Tên lệnh: apl | |
Tác giả: pdle
Bài viết gốc: 195906
Tên lệnh: an |
Đóng băng layer
Em thêm dòng đổi layer hiện hành vẫn ko được!
(defun c:an (/ ob ss)
(
setq ss (ssget "_X" (list(cons 8 "3D")))
ob (ssname ss 0)
)
(command "clayer" "0")
(command "layfrz" ob)
(princ)
)
|
Tác giả: Tot77
Bài viết gốc: 303816
Tên lệnh: test |
Xin lisp kiểm tra độ vênh của tấm BTXM
Bạn thử cái này, điều kiện là text canh trái, tấm là lwpolyline.
(defun c:test(/ ss ssl txt lwp canhngan caodo venh kq)
(setq ss (ssget '((0 . "TEXT,LWPOLYLINE")))
ssl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
txt (vl-remove-if '(lambda(x) (= "LWPOLYLINE" (cdr (assoc 0 (entget x))))) ssl)
lwp (car (vl-remove-if '(lambda(x) (= "TEXT" (cdr (assoc 0 (entget x))))) ssl) )
lwp (mapcar 'cdr (vl-remove-if-not...
>> Bạn thử cái này, điều kiện là text canh trái, tấm là lwpolyline.
(defun c:test(/ ss ssl txt lwp canhngan caodo venh kq)
(setq ss (ssget '((0 . "TEXT,LWPOLYLINE")))
ssl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
txt (vl-remove-if '(lambda(x) (= "LWPOLYLINE" (cdr (assoc 0 (entget x))))) ssl)
lwp (car (vl-remove-if '(lambda(x) (= "TEXT" (cdr (assoc 0 (entget x))))) ssl) )
lwp (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= 10 (car x))) (entget lwp)))
lwp (mapcar '(lambda(z) (list z
(car (vl-sort txt '(lambda(x y) (< (distance (cdr (assoc 10 (entget x))) z)
(distance (cdr (assoc 10 (entget y))) z))))))) lwp)
lwp (mapcar '(lambda(x) (list (car x) (atof (cdr (assoc 1 (entget (last x))))))) lwp)
canhngan (min (distance (car (nth 0 lwp)) (car (nth 1 lwp)))
(distance (car (nth 0 lwp)) (car (nth 3 lwp))))
caodo (mapcar 'cadr lwp)
venh (if (<= (setq kq (/ (abs (- (+ (nth 0 caodo) (nth 2 caodo)) (+ (nth 1 caodo) (nth 3 caodo)))) canhngan 1.0)) 0.01)
(princ (strcat "\nDo venh = " (rtos kq) " <= 1%"))
(princ (strcat "\nDo venh = " (rtos kq) " > 1%")))
) (princ)
)
<<
|
|
Filename: 303816_test.lsp
|
|