CADsite forum

Er is iets verkeerd gegaan met kopieren

;;;arb
(defun plar(/ pt pt1 pt2)
(setq pt (getpoint"\nStarting Point: "))
(setq pt1 (getpoint pt "\nNext Point: "))
(command "Pline" pt pt1 "")
   (while
      (setq pt2 (getpoint pt1"\nNext Point: "))
      (command "pline" "" pt2 "")
      (command "pedit" pt "j" pt pt2 "" "")
      (setq pt1 pt2)
   )
(command "pedit" pt "c" "")
(princ)
)

(defun ar5 (/ cm fd ar1 ar2 ar3 tab oba lu tpt lin wh)
(vl-load-com)

  (setq cm (getvar "cmdecho"))
  (setvar"cmdecho" 0)
  (setq fd (getvar "fielddisplay"))
  (if (/= fd 0)(setvar"fielddisplay" 0))

    (setq ar1 (entsel "\nSelect Area Boundary: "))
    (setq ar2 (car ar1))
    (setq tab (vlax-ename->vla-object ar2))
    (setq oba (vla-get-objectid tab))

(setq lu (getvar "lunits"))
(setq tpt (getpoint"\nSelect Area Text Point: "))
(cond
((= lu 2) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu6%qf1\">%")))
((= lu 4) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%")))
((= lu 5) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu5\">%")))
((= lu 3) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%")))
((= lu 1) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu1\">%")))
)
(command "mtext" tpt "w" "0" lin "")

(princ)
)      

(defun c:arb (/ key)
(initget  1 "Boundary/label-area Label-area")
(setq key (getkword "\nWould you like Boundary/label-area<B> or Label-area<L>: "))
   (cond
     ((= key "Boundary/label-area")(plar)(ar5))
     ((= key "Label-area")(ar5))
   )
(princ)
)

Is dit hetgeen jullie zoeken?

;;;arb
(defun plar(/ pt pt1 pt2)
(setq pt (getpoint"\nStarting Point: "))
(setq pt1 (getpoint pt "\nNext Point: "))
(command "Pline" pt pt1 "")
   (while
      (setq pt2 (getpoint pt1"\nNext Point: "))
      (command "pline" "" pt2 "")
      (command "pedit" pt "j" pt pt2 "" "")
      (setq pt1 pt2)
   )
(command "pedit" pt "c" "")
(princ)
)

(defun ar5 (/ cm fd ar1 ar2 ar3 tab oba lu tpt lin wh)
(vl-load-com)

  (setq cm (getvar "cmdecho"))
  (setvar"cmdecho" 0)
  (setq fd (getvar "fielddisplay"))
  (if (/= fd 0)(setvar"fielddisplay" 0))

    (setq ar1 (entsel "\nSelect Area Boundary: "))
    (setq ar2 (car ar1))
    (setq tab (vlax-ename->vla-object ar2))
    (setq oba (vla-get-objectid tab))

(setq lu (getvar "lunits"))
(setq tpt (getpoint"\nSelect Area Text Point: "))
(cond
((= lu 2) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu6%qf1\">%")))
((= lu 4) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%")))
((= lu 5) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu5\">%")))
((= lu 3) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%")))
((= lu 1) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu1\">%")))
)
(command "mtext" tpt "w" "0" lin "")