CADwiesel's Forum

Code: Alles auswählen

;;;------------------------------------------------------------------------------------------------
;;; Programm: BAUBEM
;;; Funktion: Wandelt alle Nachkommazahlen einer Bemassung in hochgestellte Zahlen um
;;;           Das Programm geht von einer Bemassung in "cm" aus!
;;; Author:   Thomas Schnitzler (c) 2013
;;; HowTo:    Sucht in der Bemassung die "echte" Länge und wandelt diese in einen String um
;;; Beispiel: Bemassung ist 134,28 und Textüberschreibung ist "134~AfAE’~Ac€A!~Af‚~A‚Â^3"
;;;           Vorraussetzung ist eine Bemassung in cm
;;;------------------------------------------------------------------------------------------------
(DEFUN c:baubem (/ cnt ent maß sel txt)
 (PROMPT "\nZu ändernde Bemassung wählen: ")
 (SETQ sel (SSGET '((0 . "DIMENSION")))
       cnt 0
 )
 (WHILE (< cnt (SSLENGTH sel))
  (SETQ ent (ENTGET (SSNAME sel cnt))
        maß (VL-STRING-SUBST "" ".0" (RTOS (CDR (ASSOC 42 ent)) 2 1))
        cnt (1+ cnt)
  )
  (IF (VL-STRING-SEARCH "." maß)
   (SETQ txt (STRCAT (VL-STRING-SUBST "{\\A1\\H0.75x;\\S" "." maß) "^;}"))
   (SETQ txt maß)
  )
  (SETQ ent (SUBST (CONS 1 txt) (ASSOC 1 ent) ent))
  (ENTMOD ent)
 ) ;_while
 (PRINC)
)

Code: Alles auswählen

;;;------------------------------------------------------------------------------------------------
;;; Programm: BAUBEM2
;;; Funktion: Wandelt alle Nachkommazahlen einer Bemassung in hochgestellte Zahlen um
;;;           Maße unter 1m werden in Zentimeter und die ab 1m in Meter vermasst
;;; Author:   Thomas Schnitzler (c) 2013
;;; Datum:    15.09.2013
;;; HowTo:    Misst die "echte" Länge und wandelt diese in einen String um
;;; Beispiel: Bemassung ist 134.28 => Textüberschreibung ist "1,34~AfAE’~Ac€A!~Af‚~A‚Â^3"
;;;           Bemassung ist  50.19 => Textüberschreibung ist   "50~AfAE’~Ac€A!~Af‚~A‚Â^2"
;;;------------------------------------------------------------------------------------------------
(DEFUN c:baubem2 (/ cnt sel)
 (beminit)
 (PROMPT "\nZu ändernde Bemassung wählen: ")
 (SETQ sel (SSGET '((0 . "DIMENSION")))
       cnt 0
 )
 (WHILE	(< cnt (SSLENGTH sel))		;
  (bemtext (ENTGET (SSNAME sel cnt)))
  (SETQ cnt (1+ cnt))
 )
 (PRINC)
)
;;;------------------------------------------------------------------------------------------------
(DEFUN bemtext (ent / dp1 dp2 lst nks pos txt vks)
 (SETQ dp1 (CDR (ASSOC 10 ent))
       dp2 (POLAR dp1 (CDR (ASSOC 50 ent)) (CDR (ASSOC 42 ent)))
       txt (RTOS (CVUNIT (DISTANCE dp1 dp2) bb_einheit "CM") 2 bb_nachkomma)
       pos (+ 1 (VL-STRING-SEARCH "." txt))
       lst (LIST (ATOI (SUBSTR txt 1 (1- pos))) (ATOI (SUBSTR txt (1+ pos))))
       vks (IF (>= (NTH 0 lst) 100)
	    (VL-STRING-SUBST "," "." (RTOS (/ (NTH 0 lst) 100.0) 2 2))
	    (RTOS (NTH 0 lst) 2 0)
	   )
       nks (ITOA (NTH 1 lst))
       txt (STRCAT vks "{\\A1\\H0.75x;\\S" nks "^;}")
       ent (SUBST (CONS 1 txt) (ASSOC 1 ent) ent)
 )
 (ENTMOD ent)
)
;;;------------------------------------------------------------------------------------------------
(DEFUN beminit ()
 (INITGET 1 "MM Cm Dm M Km")
 (IF (NOT (BOUNDP 'bb_einheit))
  (SETQ bb_einheit (STRCASE (GETKWORD "\nEinheit [MM/Cm/Dm/M/Km]: ")))
 )
 (IF (NOT (BOUNDP 'bb_nachkomma))
  (SETQ bb_nachkomma (nv (GETINT "\nNachkommastellen <1>: ") 1))
 )
)
;;;------------------------------------------------------------------------------------------------
(DEFUN nv (chk val)
 (IF (NULL chk)
  val
  chk
 )
)
;;;------------------------------------------------------------------------------------------------