Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
goblinangel

[Nhờ Vả] Lisp Tự Động Đánh Số Và Thống Kê Kích Thước Tam Giác (Đa Giác Càng Tốt Ạ)

Các bài được khuyến nghị

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×