Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
taonv89

Gán cao độ trong VB.Net

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

Code gán cao độ của VBA:

Sub gancaododf()
Dim objs(0 To 1) As AcadEntity
Dim Entry As AcadObject
Dim x As Double

For i = 1 To 1

    ThisDrawing.Utility.GetEntity Entry, point, "Chon mot Pline "
Set objs(i) = Entry
   UserForm1.Show
  objs(i).Elevation = UserForm1.txtcaodo.Text

Next

End Sub

--------------------->Nhờ các bác pro chuyển sang VB.NET hộ em với !

Rất mong được sự hồi âm của các bác !Thank Pro !

 

 

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

mình sưu tầm được 2 list tính diện tích bằng pick điểm, mỗi lít có ưu nhược điểm riêng
Ưu điểm: + list 1: - tính diện tích theo tỷ lệ chọn ( tính đơn vị là mét thì nhập 100)
                           - phần tính diện tích có hatch để dễ kiểm tra, sau khi kết thúc lệnh thi tự mất
                              ( trừ khi  lệnh bị lỗi )
                            - chọn text đã có thay kết quả vào
 
               + list 2: - tính diện tích theo tỷ lệ mặc định la 1/1 ( đơn vị là mét)
                            - chọn text đã có thay kết quả vào và đổi mầu text
Nhờ giúp: sửa list 1 để khi thay kết quả vào text thì text tự đổi mầu.
 
list1:
(defun c:NN()
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale : "))
    (setq ntl (/ 100 tl))
    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
  (print)
  (print)
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 100 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (print)
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (setq dtl (/ dtl tl2))
  (print dtl)
  (setq elst (entget (car (entsel "Thay cho so: "))))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
  (print)
  (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
  (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun
 
 
 
 
list2:
(defun c:qq ( / tmp)
(setq tong 0.00)
(while (setq   a (getpoint "\nKich mot diem trong khu vuc: "))
(command "boundary" a "")
(command "area" "o" (entlast) )
(command "erase" (entlast) "")
(setq temp (getvar "area"))
(setq tong (+ tong temp))
)
(princ (strcat "\nDien tich la: " (rtos (/ tong 1.0) 2 2) " m2"))
(setvar "CMDECHO" 0)
(princ)
;Thay doi noi dung text
(setq C_text (rtos (/ tong 1.0) 2 2))    ;Bien can thay vao text
      (setq O-Text (entsel (strcat "\nChon Text ghi khoi luong [s..."C_text"]:")))
(if (null O-Text)
  (progn (princ))
  (progn           ;    
      (setq    Text (car O-Text)
          N-Text (cons 1 C_text))
      (setq N-Text1 (subst N-Text (assoc 1 (entget Text)) (entget Text)))
      (entmod N-Text1)
;Danh dau thay doi
    (setq mau 6)
    (setq N-Mau (cdr (car N-Text1)))
  (if (= 62 (car (assoc 62 (entget N-Mau)))); Begin IF-a
     (progn; Begin Progn-a
      (setq Color (cons 62 mau))
      (setq N-mau1 (subst Color (assoc 62 (entget N-Mau)) (entget N-Mau)))
      (entmod N-mau1)
      (entupd Text)
      (princ)    
      ) ; Close Progn-a
      (progn; Begin Progn-b
    (setq Color (cons (cons 62 mau) (cdr (member (assoc 8 (entget N-Mau)) (entget N-Mau)))))
    (setq Color1 (Reverse (member (assoc 8 (entget N-Mau)) (Reverse (entget N-Mau)))))
    (setq N-Mau1 (append Color1 Color))
    (entmod N-Mau1)
    (entupd Text)
    (princ)
      ); Close Progn-b
   ); Close IF-a
);Close Progn
  );Close IF
    (princ)
  )
(defun C:ct (/ M)
(setvar "CMDECHO" 1)
  (setq pt1 (getpoint "\nChon diem 1 ben phai:"))
  (setq pt2 (getpoint "\nChon diem 2 ben phai:"))
  (setq xt (- (car pt2) (car pt1)))
  (setq yt (- (cadr pt2) (cadr pt1)))
  (setq kct (sqrt (+ (* xt xt) (* yt yt))))
  (setq pt3 (getpoint "\nChon diem 1 ben trai:"))
  (setq pt4 (getpoint "\nChon diem 2 ben trai:"))
  (setq xp (- (car pt3) (car pt4)))
  (setq yp (- (cadr pt3) (cadr pt4)))
  (setq kcp (sqrt (+ (* xp xp) (* yp yp))))
  (setq kc (+ kct kcp))
  (setq kcte (rtos kc 2 2))
;Thay doi noi dung text
(setq C_text kcte)    ;Bien can thay vao text
      (setq O-Text (entsel (strcat "\nChon Text trong co [Lcd..."C_text"]:")))
(if (null O-Text)
  (progn (princ))
  (progn           ;    
      (setq Text (car O-Text)
          N-Text (cons 1 C_text))
      (setq N-Text1 (subst N-Text (assoc 1 (entget Text)) (entget Text)))
      (entmod N-Text1)
;Danh dau thay doi
    (setq mau 6)
    (setq N-Mau (cdr (car N-Text1)))
  (if (= 62 (car (assoc 62 (entget N-Mau)))); Begin IF-a
     (progn; Begin Progn-a
      (setq Color (cons 62 mau))
      (setq N-mau1 (subst Color (assoc 62 (entget N-Mau)) (entget N-Mau)))
      (entmod N-mau1)
      (entupd Text)
      (princ)    
      ) ; Close Progn-a
      (progn; Begin Progn-b
    (setq Color (cons (cons 62 mau) (cdr (member (assoc 8 (entget N-Mau)) (entget N-Mau)))))
    (setq Color1 (Reverse (member (assoc 8 (entget N-Mau)) (Reverse (entget N-Mau)))))
    (setq N-Mau1 (append Color1 Color))
    (entmod N-Mau1)
    (entupd Text)
    (princ)
      ); Close Progn-b
   ); Close IF-a
);Close Progn
  );Close IF
    (princ)
  )

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

Đăng nhập để thực hiện theo  

×