Diskuzní fórum, poradna

archiv · obvod, plocha

;=========================================================== ==============
; Mistnost.lsp    Popis místnosti
; (c) Copyright 2006 PepaR
; from: www.? ? ?.com
 ;----------------------------------------------------------- --------------
; Description:
;
; Zjistí plochu a obvod místnosti a zapíše jej jako atributy do bloku
;
; Command options:
;  "MISTNOST" Výšková kóta
;  "VKO" Oprava hodnoty výškové kóty
 ;=========================================================== =================
(defun prid_poly ()
  (command "_area" "_e" en)
  (setq celk_obvod (+ celk_obvod (getvar "perimeter")))
  (setq celk_plocha (+ celk_plocha (getvar "area")))
  (ssdel en ss)
)
(defun mistnost_zjisti (/ celk_obvod celk_plocha)
  (setq celk_obvod 0.0)
  (setq celk_plocha 0.0)
  (prompt "\nVyberte køivku(y) místnosti: ")
  (setq ss (ssget))
  (while (> (sslength ss) 0)
    (setq en (ssname ss 0))
    (setq ed (entget en))
    (setq e_type (cdr (assoc '0 ed)))
    (cond
      ((= e_type "POLYLINE") (prid_poly))
      ((= e_type "LWPOLYLINE") (prid_poly))
      ((or
  (/= e_type "POLYLINE")
  (/= e_type "LWPOLYLINE")
       )
       (ssdel en ss)
      )
    )
 )
  (setq plocha (rtos (/ celk_plocha (* 1000.0 1000.0)) 2 2))   ;;; Prevod na mm^2 -> m^2
  (setq obvod (rtos (/ celk_obvod 1000.0) 2  2))         &nb sp;    ;;; Prevod na mm -> m
)
(defun mistnost_zapis (entl naz / e eg)
 (setq e (entnext entl))
 (while e
  (setq eg (entget e))
  (if (= (cdr (assoc 0 eg)) "ATTRIB")
   (progn
    (if (= (cdr (assoc 2 eg)) "PLOCHA")
     (progn
       (setq eg (subst (cons 1 plocha) (assoc 1 eg) eg))
       (entmod eg)
     )
    )

    (if (= (cdr (assoc 2 eg)) "OBVOD")
     (progn
       (setq eg (subst (cons 1 obvod) (assoc 1 eg) eg))
       (entmod eg)
     )
    )

    (if (= (cdr (assoc 2 eg)) "NAZEV")
     (progn
       (setq eg (subst (cons 1 naz) (assoc 1 eg) eg))
       (entmod eg)
     )
    )

   )
  )
  (setq e (entnext e))
 ) 
(princ)
)
;;; Pozor, entlast za urcitych okolnosti nevraci posledni entitu (je-li jako posledni entita napr. blok s atributy nebo polyline)
(defun entlast1 (/ e en)
 (setq en (entlast))
 (while en
  (setq e en)
  (setq en (entnext en))
 )
 e
)

(defun C:MISTNOST (/ entl entl1 attrq naz)
  (setq attrq (getvar "ATTREQ"))
  (setvar "ATTREQ" 0)

  (setq entl1 (entlast1))
  (setq entl (entlast))

  (mistnost_zjisti)
  (setq naz (getstring "\nNazev mistnosti: "))
  (prompt "\nUrèete bod vložení oznaèení místnosti :")
  (command "_-INSERT" "c_mistnosti" pause (getvar "dimscale")(getvar "dimscale") pause)
  (mistnost_zapis entl1 naz)
  (entupd entl)
  (setvar "ATTREQ" attrq)
  (command "_DDATTE" entl)
  (princ)
)

Příbuzné CAD tipy:
Tip 4825:		Společný popis či plocha pro více místností.
Tip 10894:		Revit - dvě místnosti v jediném místě.
Tip 11351:		Jak v Revitu přečíslovat místnosti v zadaném pořadí?
Tip 7788:		Jak změnit výšku pro výpočet plochy místností?
Tip 5487:		Výkaz prvků po místnostech (automatická inventarizace vybavení místností).
Tip 5020:		Export místností z Revitu do ADT.

Diskuzní fórum, poradna

?CAD diskuze, rady, výměna zkušeností

Popis místnosti

?
CAD diskuze, rady, výměna zkušeností