Chuyển đến nội dung
Diễn đàn CADViet

Bee

Thành viên
  • Số lượng nội dung

    553
  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    37

Bài đăng được đăng bởi Bee


  1.  

     

    Thử cái này xem nhé. ^_^

    (defun Bee_run (ss / n vlaobj)
      (if (tblsearch "style" "gaiheki")
        (command "-style" "gaiheki" "romans.shx" 50. 0.75 "" "" "" "")
        )
      (if ss
        (progn
          (setq n 0)
          (repeat (sslength ss)
            (setq vlaobj (vlax-ename->vla-object (ssname ss n)))
            (if (= (vlax-get vlaobj 'StyleName) "bigfont")
              (vlax-put vlaobj 'StyleName  "standard")
              )
            (vlax-put vlaobj 'Height  100.)
            (vlax-put vlaobj 'ScaleFactor  0.55)
            (setq n (1+ n))
            )      
          )
        )
      )
    (defun c:test1 ()                
      (Bee_run (ssget "_X" '((0 . "TEXT,MTEXT"))))
      (princ)
      )
    (defun c:test2 ()                
      (Bee_run (ssget '((0 . "TEXT,MTEXT"))))
      (princ)
      )
    

    CHẠY ĐƯỢC RỒI BÁC Ạ :D.

    MỖI CÁI KHÔNG CHUYỂN ĐƯỢC STYLE CỦA TEXT VỀ STANDARD.

     

    NHÂN TIỆN E MUỐN HỎI LUÔN LÀ NẾU NHƯ LÚC CHỈNH "GAIHEKI" STYLE NẾU NHƯ MUỐN CHỌN THÊM THUỘC TÍNH BIGFONT THÌ LÀM THẾ NÀO Ạ :).

    EM XIN CÁM ƠN BÁC NHIỀU.

    + thay đổi text style từ "bigfont" về "standard" ---> cái này là thằng TEXT nào thuộc style bigfont thì sẽ chuyển về standard. Còn các thằng khác ko chuyển.

     

    + CHỌN THÊM THUỘC TÍNH BIGFONT ---->(command "-style" ) tìm hiểu thêm lệnh này nhé.

    • Vote tăng 1

  2. hiện giờ e vẫn đang làm như thế.

    nhưng mà mỗi lần làm thế mất tầm 20-30s.

    mà trong 1 buổi thì em phải làm thế tầm 30-40 lần nên cũng tương đối mất công nên mới lên mạn phép nhờ mọi người tạo hộ cái lisp :)

    Thử cái này xem nhé. ^_^

    (defun Bee_run (ss / n vlaobj)
      (if (tblsearch "style" "gaiheki")
        (command "-style" "gaiheki" "romans.shx" 50. 0.75 "" "" "" "")
        )
      (if ss
        (progn
          (setq n 0)
          (repeat (sslength ss)
            (setq vlaobj (vlax-ename->vla-object (ssname ss n)))
            (if (= (vlax-get vlaobj 'StyleName) "bigfont")
              (vlax-put vlaobj 'StyleName  "standard")
              )
            (vlax-put vlaobj 'Height  100.)
            (vlax-put vlaobj 'ScaleFactor  0.55)
            (setq n (1+ n))
            )      
          )
        )
      )
    (defun c:test1 ()                
      (Bee_run (ssget "_X" '((0 . "TEXT,MTEXT"))))
      (princ)
      )
    (defun c:test2 ()                
      (Bee_run (ssget '((0 . "TEXT,MTEXT"))))
      (princ)
      )
    
    • Vote tăng 1

  3. Các bác giúp đỡ em vấn đề này với ạ.

    Em đang sử dụng 1 file bản vẽ dạng XREF.  Trên file này có 1 dòng RTEXT đính kèm đường dẫn tới file hiện hành của bản vẽ.

    Lợi ích của đường dẫn này là để dễ dàng tìm lại file trong máy khi người dùng có lỡ quên đi đường dẫn tới file.

     

    Cái dòng Rtext này em dùng cả năm rồi. Trước giờ em chỉ xài chùa, tạo ra file Xref mới nào thì cứ copy dòng Rtext sang để xài.

    Tuy nhiên thì tò mò em vẫn muốn hỏi các bác:

     

    1. RTEXT là gì. Nó có ý nghĩa gì đối với việc sử dụng cad     < Do em thấy Rtext ít được xài > 

    2. Cách thức sử dụng Rtext ra sao.

    3. Xem trong Property của Rtext, phần Contents , em thấy có cú pháp : $(upper,$(getvar, "dwgprefix"))$(upper,$(getvar, "dwgname")) $(edtime,0,MONDD"," YYYY-H:MM AM/PM)

    Cú pháp này ở đây em thấy xêm xêm như lisp, nhưng em chưa hiểu được hướng dẫn lập ra cú pháp này ở đâu.

     

    Link file bản vẽ Xref của em: https://drive.google.com/open?id=0B8Wyt0hkwi0yYjdzVTRBRy1iUXM

    Mong các bác hướng dẫn cho em xíu.... : )))))

    Nó là ngôn ngữ Diesel Expression. Hoi a GG la có hướng dẫn :D

    • Vote tăng 1

  4. Như tiêu đề, các bác có thể giúp em làm cái Lisp

     

    - Tự đánh số tam giác,

    - Xuất bảng thống kê tam giác, ví dụ tam giác "X1" có 3 cạnh A= ??? B=???? C=???.......

     

    Em chân thành cảm ơn ạ.

    Em không up được file mẫu... có hình đây ạ...

    https://s-media-cache-ak0.pinimg.com/originals/8a/46/7e/8a467e07668167a7c2899f49fe30bf54.png

    Demo 1 phát. Làm tí cho đỡ buồn ^_^

     

    https://youtu.be/iS3042bTAd0

     

    Code here:

    (defun c:demo  (/ a b c doc osm i lst msp name num p pt row rws TblObj triangle txt)
      (vl-load-com)
      (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
            msp (vla-get-modelspace doc)
    	osm (getvar 'osmode)
            )
      (command "undo" "begin")
      (if (setq p (getpoint "\nVi tri dat bang thong ke: "))
        (progn
          (setvar 'osmode 0)
          (setq TblObj (vla-addtable
                         msp
                         (vlax-3d-point p)
                         2 ;NumRows
                         4 ;NumColumns
                         750 ;RowHeight 15=txt x 3
                         3000 ;ColWidth 100
                         )
                ) ;setq
    
          (vla-put-vertcellmargin TblObj 200)
          (vla-SetColumnWidth TblObj 0 1000)
          (vla-SetRowHeight TblObj 0 1500)
          (mapcar '(lambda (x) (vla-setTextHeight TblObj x 250))
                  (list acTitleRow acHeaderRow acDataRow)
                  )
          (mapcar '(lambda (x) (vla-setAlignment TblObj x 5))
                  (list acTitleRow acHeaderRow acDataRow)
                  )
          
          (vla-setText TblObj 0 0 "B\U+1EA3ng th\U+1ED1ng kê kích thu\U+1EDBc tam giác")
          
          (vla-setText TblObj 1 0 "STT")
    
          (vla-setText TblObj 1 1 "A")
    
          (vla-setText TblObj 1 2 "B")
    
          (vla-setText TblObj 1 3 "C")
    
          (setq i 1
                row 2)
          (setq num (getint "\nChon so ten diem bat dau: "))
            (if (null num)
              (setq num 1)
              )
    
          (while (setq pt (getpoint "\nChon diem dat text: "))
            
            (setq name (strcat "X" (rtos num 2 0)))
    	
            (setq txt (entmake
                        (list
                          (cons 0 "TEXT")
                          (cons 40 (getvar "textsize"))
                          (cons 50 0.)
                          (cons 10 pt)
                          (cons 1 name)
                          )
                        )
                  )
            (command "-boundary" "_none" pt "")
            (setq triangle (entlast))
            (setq lst (mapcar (function cdr)
                                    (vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget triangle))
                                    ) ;_  mapcar
                        )
            (setq a (distance (car lst) (cadr lst)))
            (setq b (distance (cadr lst) (caddr lst)))
            (setq c (distance (caddr lst) (car lst)))
            
            (setq rws (vla-Get-Rows TblObj))
            (vla-InsertRows TblObj rws (vla-GetRowHeight TblObj (1- rws)) 1);; 1 number of rows
    
            
            (vla-setText TblObj row 0 (rtos (1+ i) 2 0))
            (vla-setText TblObj row 1 (rtos a 2 0))
            (vla-setText TblObj row 2 (rtos b 2 0))
            (vla-setText TblObj row 3 (rtos c 2 0))
    	(mapcar '(lambda (x) (vla-setTextHeight TblObj x 250))
    		(list acTitleRow acHeaderRow acDataRow)
    		)
    	(mapcar '(lambda (x) (vla-setAlignment TblObj x 5))
    		(list acTitleRow acHeaderRow acDataRow)
    		)
    	(setq i (1+ i)
                  row (1+ row)
    	      num (1+ num)
                  )       
            ) ;while
          ) ;progn
        ) ;if
      (command "undo" "end")
      (setvar 'osmode osm)
      (princ)
      )
    
    • Vote tăng 1

  5. Dear Các bác CadViet!

    Công việc của em chuyên bốc khối lượng (Dự toán+Thi công)

    Các công tác thống kê và tính toán rất nhiều. 

    Để đếm và kiểm tra số lượng phục vụ tính toán rất quan trọng

    (VD: Loại cửa, Lanh tô, Bổ trụ...)

    Vì vậy, em nhờ các bác viết giúp em đoạn Lisp để kiểm tra và xóa các text/đối tượng đè lên nhau trong cad.

    Em cảm ơn các bác CadViet nhé!

    Command : OVERKILL

    ^_^


  6. Hi bạn,

    nếu đường thẳng nằm dọc hay nằm ngiêng lisp ko tính được, mình gửi bản vẽ đính kèm nhờ bạn xem với nhé, thanks

     

    https://drive.google.com/open?id=0B1TsLvqrTXByZkhva1RYZUZJUFk

    Đã fix nhé ^_^

    ;;Lenh TEST
    
    (defun c:test (/ ss n _length pt1 pt2 pt3 pt4 ss1 )
      (vl-load-com)
      (setvar "CMDECHO" 0)
      (princ "\nChon LINE: ")
      (if (setq ss (ssget '((0 . "LINE"))))
        (progn
          (command "zoom" "ob" ss "")
          (setq n 0)
          (repeat (sslength ss)
    	(setq _length (/ (vlax-get (vlax-ename->vla-object (ssname ss n)) 'Length) 1000.))
    	(setq pt1 (polar (cdr (assoc 10 (entget (ssname ss n)))) (+ (angle (cdr (assoc 10 (entget (ssname ss n))))
    									   (cdr (assoc 11 (entget (ssname ss n))))
    									   )
    								      (/ pi 2)
    								    )
    			 100.)
    	      )
    	(setq pt2 (polar (cdr (assoc 11 (entget (ssname ss n)))) (- (angle (cdr (assoc 10 (entget (ssname ss n))))
    									   (cdr (assoc 11 (entget (ssname ss n))))
    									   )
    								      (/ pi 2)
    								    )
    			 100.)
    	      )
    	(setq pt3 (polar (cdr (assoc 10 (entget (ssname ss n)))) (- (angle (cdr (assoc 10 (entget (ssname ss n))))
    									   (cdr (assoc 11 (entget (ssname ss n))))
    									   )
    								      (/ pi 2)
    								    )
    			 100.)
    	      )
    	(setq pt4 (polar (cdr (assoc 11 (entget (ssname ss n)))) (+ (angle (cdr (assoc 10 (entget (ssname ss n))))
    									   (cdr (assoc 11 (entget (ssname ss n))))
    									   )
    								      (/ pi 2)
    								    )
    			 100.)
    	      )
    
    	(setq ss1 (ssget "CP" (list pt1 pt4 pt2 pt3) '((0 . "TEXT"))))
    	(if ss1
    	  (if (> (sslength ss1) 1)
    	    (progn
    	      (princ "\nCo >1 TEXT tai vi tri vung chon xung quanh LINE.")
    	      (redraw (ssname ss n) 3)
    	      )
    	    (entmod (subst (cons 1 (strcat "L= " (rtos _length 2 1) " m"))
    			   (assoc 1 (entget (ssname ss1 0)))
    			   (entget (ssname ss1 0)))
    		    )
    	    )
    	  )
    	(setq n (1+ n))
    	);repeat
          );progn
        (princ "\nBan da khong chon LINE.")
        );if
      (command "zoom" "P")
      (princ)
      )
    
    • Vote tăng 1

  7. mình ko up lên cadviet mình gửi kèm link gồm dwg và lisp bạn nhé, đây là lisp mình lấy được trên diễn đàn, cảm ơn bạn, cuối tuần vui vẽ nhé

     

    https://drive.google.com/file/d/0B1TsLvqrTXBycDY1RzllYW0yU28/view?usp=sharing

    Lisp mới đây, chỉ cần chọn LINE còn lại lisp làm việc nhé. ^_^ Thay tên lệnh tùy ý. 

     

    Chui khắp các topic nhờ vả mà ko thấy ai repply, khổ thân ^_^

    ;;Lenh TEST
    
    (defun c:test (/ ss n _length pt1 ss1)
      (setvar "CMDECHO" 0)
      (princ "\nChon *LINE: ")
      (if (setq ss (ssget '((0 . "*LINE"))))
        (progn
          (command "zoom" "ob" ss "")
          (setq n 0)
          (repeat (sslength ss)
    	(setq _length (/ (vlax-get (vlax-ename->vla-object (ssname ss n)) 'Length) 1000.))
    	
    	(setq pt1 (polar (cdr (assoc 10 (entget (ssname ss n)))) (/ pi 2) 100.))
    	
    	(setq ss1 (ssget "C" pt1 (cdr (assoc 11 (entget (ssname ss n)))) '((0 . "TEXT"))))
    	(if ss1
    	  (entmod (subst (cons 1 (strcat "L= " (rtos _length 2 1) " m"))
    			   (assoc 1 (entget (ssname ss1 0)))
    			   (entget (ssname ss1 0)))
    		    )
    	    )
    	(setq n (1+ n))
    	);repeat
          );progn
        (princ "\nBan da khong chon LINE.")
        );if
      (command "zoom" "P")
      (princ)
      )
    
    • Vote tăng 1

  8. Mình dùng là odinate dimension k dùng cốt text

    khi dùng stretch nó sẽ nhảy theo giống như là dimension

    bác có thể down cái file mình đính kèm về mà xem

    Mình vẫn thấy dùng field là ổn dù cho tỷ lệ nào vẫn dùng được.

     

    Đây là lisp dùng cho công việc bạn yêu cầu. Nhớ chọn window từ phải qua trái thì mới stretch được nhé.

     

    Tết nhất đến nơi mọi người bận chắc chẳng ai rảnh viết lisp mấy đâu. ^_^

    (defun c:kkk (/ os ss p1 p2)
      (setq os (getvar "osmode"))
      (princ "\nChon cot cao do: ")
      (if (setq ss (ssget "_:L"))
        (if	(setq p1 (getpoint "\nChon diem goc copy: "))
          (if (setq p2 (getpoint p1 "\nChon diem dat moi: "))
    	(progn
    	  (command "_.copybase" p1 ss "")
    	  (setvar "OSMODE" 0)
    	  (command "_.stretch" "P" "" p1 p2)
    	  (command "_.pasteclip" p1)
    	)
    	(princ "\nBan da khong chon diem moi.")
          )
          (princ "\nBan da khong chon diem goc.")
        )
        (princ "\nBan da khong chon doi tuong.")
      )
      (setvar 'osmode os)
      (princ)
    )
    
    • Vote tăng 1

  9. cái này mình dùng rồi nó chỉ dùng được khi mình có 1 bản vẽ cần điền tọa độ

    file mình vẽ nhiều vùng khác nhau cần điền tọa độ không cùng gốc thì không dùng đc, hoặc phải dàn hàng ngang bản vẽ ra rất bất tiện

    thứ 2 là khi mình vẽ bản vẽ nhiều tỉ lệ khác nhau thì việc chỉnh sửa cũng mất thời gian hơn

    mình đưa về dimension nên khi vẽ các tỉ lệ khác nhau chỉ cần chọn lại dimension là được

    Nhờ các bác viết Lisp như trên giúp mình vs ??

    Thế giá trị cốt trong text nó nhảy theo cái gì ?


  10. Mình muốn nhờ các bác viết Lisp kết hợp 2 lênh stretch và copy 

    mình vẽ cầu thường dùng dimension ordinate để điền cao độ chứ k dùng lisp điền cao độ như bên đường

    bình thường phải copy dimension sau đó stretch hơi mất thời gian 

    file vidu mình đính kèm

    http://www.mediafire.com/file/xc24pfldusg085d/Vi+du.dwg

    Cái này nghiên cứu dùng FIELD trong cad nhé. Field hay lắm đấy. Chỉ việc copy cốt xong là nó nhảy, không cần lisp nào khác

    • Vote tăng 1

  11.  

    Mình có sưu tầm được 1 lisp cộng các số text rồi viết ra kết quả đè lên 1 text khác. tên lệnh: CS

    Nhưng gặp phải các khó khăn sau:

    + Kết quả viết ra nó có chưa 1 số sau dấu thập phân, mình muốn thay đổi thì sửa ở dòng lệnh nào.

    + Mình muốn sau mỗi lần nhấp vô các text cần cộng nó hiện kết quả ngay ở dòng Command cho mình thấy. Ví dụ có text 2 3 6 7, sau khi nhấp vô số 2 và 3, dưới command cho kết quả là 5, nhấp thêm số 6 thì command cho là 11....

    + Tốt nhất khi ghi kết quả, mình muốn nó tạo ra 1 text mới với cao chữ là 2 thay vì ghi đè lên text có sẵn, anh em nào sửa giúp mình với

    NỘI DUNG LISP:

    ;;;Created by "NXT "

    (defun C:CS (/ mysset counter number_total number name_ent cur_ent text_origin

    number_total number_total_text LOOP result result_text text_modified old new)

    (setvar "CMDECHO" 0)

    ;***************************************************************************************

    (princ "\nSelect text objects for addition")

    (setq mysset (ssget))

    (if (/= mysset nil)

    (progn

    (setq counter 0)

    (setq number_total 0.00)

    (setq number 0.00)

    (while (< counter (sslength mysset)) 

    (setq name_ent (ssname mysset counter))

    (setq cur_ent (entget name_ent))

    (if (or 1f642.png(= (cdr (assoc '0 cur_ent)) "TEXT")

    1f642.png(= (cdr (assoc '0 cur_ent)) "MTEXT")

    )

    (progn

    (setq text_origin (cdr (assoc 1 cur_ent)))

    (setq number (distof text_origin 2));doi chuoi thanh so thuc

    (if 1f642.png(= number nil)

    (setq number 0.00)

    (setq number_total (+ number number_total)) 

    )

    )

    (if 1f642.png(= (cdr (assoc '0 cur_ent)) "DIMENSION")

    (progn

    (setq text_origin (cdr (assoc 42 cur_ent)))

    (setq number (/ text_origin 100.0))

    (if 1f642.png(= number nil)

    (setq number 0.00)

    (setq number_total (+ number number_total)) 

    )

    )

    (setq counter (+ counter 1))

    )

    (setq number_total_text (rtos number_total));;doi so thuc thanh chuoi

    )

    (princ "\nThanks a lot and back to you !")

    )

    ;***************************************************************************************

    (setq LOOP T)

    (while 1f642.png(= LOOP T)

    (while (null (setq result (nentsel "\nSelect text for result: ")))

    (princ "Nothing selected !")

    ); bat buoc user phai chon mot doi tuong

    ;-----------------------------------------------------------------------

    ;lam noi bat doi tuong nguon bang ham redraw

    (redraw (car result) 3)

    (setq result_text (entget (car result)))

    (if (or 1f642.png(= (cdr (assoc '0 result_text)) "TEXT")

    1f642.png(= (cdr (assoc '0 result_text)) "MTEXT")

    1f642.png(= (cdr (assoc '0 result_text)) "DIMENSION")

    )

    (progn

    (setq text_origin (cdr (assoc 1 result_text)));Dong text can thay doi...

    (setq text_modified number_total_text) ;Duoc thay doi boi...

    (setq old (cons 1 text_origin))

    (setq new (cons 1 text_modified))

    (entmod (subst new old result_text))

    (setq LOOP nil)

    )

    (progn

    (princ "Please select text object !")

    (setq LOOP T);Neu doi tuong khong phai la text thi vong lap se tiep tuc

    ) ;cho den khi chon duoc text

    )

    );Ket thuc viec chon doi text result

    ;***************************************************************************************

    ;Tra ve lai trang thai cu cho doi text result

    (redraw (car result) 4)

    (princ)

    );end program

     

    sao lại pót kèm topic khác nhỉ ^_^

    Giờ rảnh rang , ko thấy ai nghịch thì mình nghịch vây.

    Thấy bạn viết đc lisp nên mình làm cái ví dụ này (chưa đúng hết các trường hợp con trỏ chuột ở các vị trí menu.......) bạn có thể nghiên cứu thêm cho hoàn thiện. Good luck.

    (defun c:test (/)
    
      (if (setq text (car (entsel "\nChon text dau tien: "))
    	    loop t
          )
        (progn
          (setq sum 0)
          (setq num (distof (cdr (assoc 1 (entget text)))))
          (if (not (null num))
    	(setq sum (+ sum num))
    	(princ "\nTEXT chon khong phai la number!")
          )
          (while (and (setq gr (grread t 15 2)) loop)
    	(cond
    	  ((= (car gr) 5)
    	   (and txt (entdel txt) (setq txt nil))
    	   (if (cadr gr)
    	     (progn
    	       (setq pt	(polar (cadr gr)
    			       (* pi 1.5)
    			       (* 2 (cdr (assoc 40 (entget text))))
    			)
    	       )
    	       (redraw text 3)
    	       (setq
    		 txt (entmakex
    		       (list
    			 '(0 . "TEXT")
    			 '(100 . "AcDbEntity")
    			 '(100 . "AcDbText")
    			 (assoc 40 (entget text))
    			 (cons 10 pt)
    			 (cons 1 (strcat "Tong la: " (rtos sum 2 2)))
    		       )
    		     )			;entmakex_txt_sum
    	       )
    	     )
    	   )
    	  )				;cond gr 5
    	  ((= (car gr) 3)
    	   (if (and (setq ent (car (nentselp (cadr gr))))
    		    (vl-position
    		      (cdr (assoc 0 (entget ent)))
    		      '("MTEXT" "TEXT")
    		    )
    	       )
    	     (progn
    	       (redraw ent 3)
    	       (setq num (distof (cdr (assoc 1 (entget ent)))))
    	       (if (not (null num))
    		 (progn
    		   (setq
    		     pt1
    		      (polar (cadr gr)
    			     (* pi 1.5)
    			     (* 2 (cdr (assoc 40 (entget text))))
    		      )
    		   )
    		   (setq sum (+ sum num))
    		   (and txt (entdel txt) (setq txt nil))
    		   (setq
    		     txt (entmakex
    			   (list
    			     '(0 . "TEXT")
    			     '(100 . "AcDbEntity")
    			     '(100 . "AcDbText")
    			     (assoc 40 (entget text))
    			     (cons 10 pt1)
    			     (cons
    			       1
    			       (strcat "Tong la: " (rtos sum 2 2))
    			     )
    
    			   )
    			 )		;entmakex_txt_sum
    		   )
    
    		 )			;progn
    		 (princ "\nTEXT chon khong phai la number!")
    	       )
    	     )				;progn
    	     (princ "\nBan chon khong phai la TEXT!")
    	   )				;if
    	  )				;cond gr 3
    	  (t
    	   (and txt (entdel txt) (setq txt nil))
    	   (setq loop nil)
    	  )				
    	)				;COND
          )
        )					;progn
      )					;if
      (command "regen")
      (princ)
    )
    

  12. Em cảm ơn a. Do em chưa biết gì về lisp nên khi em thực hiện như anh hướng dẫn lại không vẽ được. Em nhờ a hướng dẫn chi tiết hơn một chút nữa được không ạ.

    Sao lại ko được.?

     

    Ví dụ TK đây:

    (defun C:tk ()
      (setq v (getvar "osmode"))
      (setq B (getint "\nNhap be rong loai thep goc:"))
      (setq a (getint "Nhap kich thuoc truc bu long:"))
      (setq dauthanh (getint "Nhap chieu dai dau thanh:"))
      (setq pt1 (getpoint "Diem dau : "))
      (setq pt2 (getpoint "Diem cuoi : " pt1))
      (command "osnap" "none")
      (command "-layer" "set" "1" "");vị trí bất kỳ trước command line là đc mà.
      (setq goc (angle pt1 pt2))
      (setq pt3 (polar pt2 goc dauthanh))
      (setq pt4 (polar pt1 goc (* dauthanh -1)))
      (setq pt5 (polar pt3 (+ (/ PI 2) goc) a))
      (setq pt6 (polar pt3 (- goc (/ PI 2)) (- B a)))
      (setq pt7 (polar pt4 (- goc (/ PI 2)) (- B a)))
      (setq pt8 (polar pt4 (+ (/ PI 2) goc) a))
      (setq pt9 (polar pt3 (+ (/ PI 2) goc) (- a (/ (* B 15) 100))))
      (setq pt10 (polar pt4 (+ (/ PI 2) goc) (- a (/ (* B 15) 100))))
      (if (> a 0)
        (progn
          (command "color" 1)
          (command "line" pt1 pt2 "")
          (setq truc (ssget "L"))
          (command "chprop" truc "" "lt" "center" "")
        )
      )
      (command "color" 7)
      (command "pline" pt5 pt6 pt7 pt8 "close")
      (command "color" 2)
      (command "line" pt10 pt9 "")
      (setq denta (ssget "L"))
      (command "chprop" denta "" "lt" "hidden" "")
      (command "color" 7)
      (if (> dauthanh 0)
        (progn
          (command "color" 7)
          (command "circle" pt1 10)
          (command "circle" pt2 10)
        )
      )
      (setvar "osmode" v)
    )
    

  13. Nhờ chỉnh sửa giúp lisp vẽ nhanh thép hình L:

    Chào mọi người trên diễn đàn, mình  có sưu tầm được 1 lisp vẽ xà thép hình L, dùng để thiết kế các bộ xà bằng thép hình L. Nội dung lisp như sau: gõ lệnh tk, nhập bề rộng loại thép góc, nhập kích thước trục bu lông, nhập chiều dài đầu thanh, chọn điểm đầu, chọn điểm cuối sẽ vẽ được 1 thanh xà thép hình L. Nhưng các đường line chỉ được gọi ra thông qua màu sắc được quy định trong lisp. Vậy mình muốn nhờ chỉnh sửa lại để các đường line đó sẽ thuộc 1 layer mình có thể đặt tên bất kỳ để có thể dễ dàng quản lý. Cảm ơn mọi người! Dưới đây mình đính kèm theo lisp:

    http://www.cadviet.com/upfiles/6/150480_vexa_2.lsp

    Thêm dòng (command "-layer" "set" "NAME_LAYER" "") trước lệnh vẽ line là line vẽ ra sẽ thuộc layer đó. ^_^


  14. Thay (Rtos (gt1 ent) 2 2) thành (Rtos (gt1 ent) 2 0)

     

    - Các bác thâm niên thì cho em hỏi xíu: Cái Hàm ( LISPED  .....)   thì em tìm nó ở đâu thế. Trong thư viện Help chẳng thấy đâu, cứ ngờ ngợ  ;)  ;)

    acad.dcl 

     

    // LispEd.dcl

    //
    //
    // Prototype layout for single-line MText editor.
     
    MTEXTED sysvar: 
     ":LispEd" --->single line lisp :D
    + "" ------------> full editor
    • Vote tăng 1

  15. Copy lisp mà ko hiểu thì làm sao viết được. Heizzzz.

     

    1. Đặt biến cục bộ lung ku tung ---> chứng tỏ copy ko hiểu :D

    2. Đặt góc mà lại chọn hàm getpoint----->cũng là ko hiểu :D

    3. Xử lý block_att mà trực tiếp ---> cũng là ko hiểu. :D

     

    Nghiên cứu học hỏi thêm nhé.

    Đây là lisp sửa ở trên ^_^

    (defun c:gra (/ atd dt osm p1 st uni)
      (setq osm (getvar "osmode"))
      (setq uni (getvar "insunits"))
      (setq atd (getvar "attdia"))		;1
      (acet-error-init (list (list "OSMODE" 0) t))
      (setvar "attdia" 0)
      (setvar "insunits" 6)
      (setvar "cmdecho" 0)
    ;;;  (vl-cmdf "clayer" "ANNOTATION")
      (initget "G C")
      (setq st (getkword "\nTEXT: <Grass/Concrete (C. S/W)>: "))
      (if (= st "G")
        (setq st "GRASS")
        (if	(= st "C")
          (setq st "CONCRETE (C. S/W)")
        )
      )
      (command
        "_.insert"
        "TEXT01"
        (setq p1 (getpoint "\n\\U+0110i\\U+1EC3m \\U+0111\\U+1EB7t TEXT:"))
        1
        1
        (angle p1 (getpoint p1 "\nGóc quay: "))
        st
      )
    
      (setq dt (entnext (entlast)))
      (if (/= (cdr (assoc 0 (entget dt))) "SEQEND")
        (progn
          (entmod
    	(subst (cons 40 0.5) (assoc 40 (entget dt)) (entget dt))
          )
          (entupd dt)
        )
      )
      (setvar "osmode" osm)
      (setvar "insunits" uni)
      (setvar "attdia" atd)
      (setvar "cmdecho" 1)
      (acet-error-restore)
      (princ)
    )
    
    
    • Vote tăng 1

  16. Chào mọi người. Em có 1 yêu cầu cần giúp đỡ như sau:

    - Em có list ban đầu ((5 (a1 a2 a4) ) (10 (b1 b3 b4))  (5 (a3)))

    - Và e cần kết quả như sau: ((5 (a1 a2 a4 a3)) (10 (b1 b3 b4))).

    Cho hỏi là có hàm nào thực hiện đc như trên ko a?

    Thank.

    Nghịch tí ^_^

     

    (setq lst '((5 (a1 a2 a4) ) (10 (b1 b3 b4))  (5 (a3))))

     

    (append (list (list (caar lst) (append (cadar lst) (car (cdaddr lst))))) (list (cadr lst)))

    • Vote tăng 1
×