Command: SUMA (Sum Area)
Measures total area of selected objects and copies it to clipboard (hatches, polylines, regions etc.). Value can be then pasted into another program by CTRL+V. Objects can be preselected, the application filters then objects without area property.Command: SUML (Sum Length)
As above but measures total length.
Supported object types of autocad and autocads verticals:
line, spline, lwpolyline, polyline, arc, circle, ellipse, aecb_ductflex, aecb_pipefitting, aecb_pipe, aecb_duct, aecb_ductfitting, aecb_pipecustomfitting, aecb_ductcustomfitting, aec_wall, aecb_conduitfitting, aecb_cabletray, aecb_conduit, aecb_cabletrayfitting, aecb_wire, aecb_schematic, aecb_schematicsymbol, aecb_schematic_pipe, aecb_schematicpipefitting
Function excludes objects that do not match any of mentioned above types.
Command: SUMSETTINGS
Opens dialog windows with options to set and save default decimal simbol of the value returned by SUMA and SUML commands and DivideBy / MultiplyBy Factor.The user can also specify if the objects should be highlighted on exit.
Code:
;;; =================================================
;;; SUMAREA_SUMLEN_v3_01.LSP
;;;
;;; Written by Andrzej Kalinowski, www.autolisps.blogspot.com
;;; v1.00 - 05.11.2015-first release
;;; [...]- misc updates
;;; v2.06 - 21.04.2019 - combining two functions into one routine, added Sumsettings command
;;; v2.07 - 22.04.2019 - added DivideBy / MultiplyBy Factor in Sumsettings dialog window
;;; v2.08 - 16.02.2021 - separated Multiply Factor for Area and Length
;;; v3.00 - 27.02.2021 - separated multiply function for SUMA and SUML in settings, added error section, active excluding incompatibile objects while selecting, added highlightning objects on exit. Added information about Multiply factor in command result in commandline.
;;; v3.01 - 08.07.2022 - fixed bug with highlightning objects on locked layers.
;;;
;;; Command: SUMA (Sum Area)
;;; Measures total area of selected objects and copies it to clipboard (hatches, polylines, regions etc.).
;;; Value can be then pasted into another program by CTRL+V. Objects can be preselected, the application filters then objects without area property.
;;;
;;; Command: SUML (Sum Length)
;;; As above but measures total length.
;;; Supported object types of autocad and autocads verticals:
;;; line, spline, lwpolyline, polyline, arc, circle, ellipse, aecb_ductflex, aecb_pipefitting, aecb_pipe, aecb_duct, aecb_ductfitting, aecb_pipecustomfitting, aecb_ductcustomfitting, aec_wall, aecb_conduitfitting, aecb_cabletray, aecb_conduit, aecb_cabletrayfitting, aecb_wire, aecb_schematic, aecb_schematicsymbol, aecb_schematic_pipe, aecb_schematicpipefitting
;;; Function excludes objects that do not match any of mentioned above types.
;;;
;;; Command: SUMSETTINGS
;;; Opens dialog windows with options to set and save default decimal simbol of the value returned by SUMA and SUML commands and DivideBy / MultiplyBy Factor.
;;; The user can also specify if the objects should be highlighted on exit.
;;; =================================================
(vl-load-com)
(defun c:SUMA () (SUM_COMMON 0) );defun
(defun c:SUML () (SUM_COMMON 1) );defun
;;; =================================================
(defun SUM_COMMON (mode1 / sset1 param1 i1 paramN yesno1 i2 elem1 gr1 typLst FctInf); pt1 pt2)
;-----------------------------------------
;error section
;-----------------------------------------
(defun *error* (msg) (princ "error: ") (princ msg) (princ) )
(defun errtrap1 (errormsg1 / i3)
(setq *error* temperr)
(repeat (setq i3 (sslength sset2))
(if (getcname "-DWGUNITS");checks if Autocad or Gstarcad. In Gstarcad dwgunits is unavailable. This condition prevents error in Gstarcad: ActiveX server returned an error: Exception occurred. We have to redraw the selection instead of invoking highlight methode.
(vlax-invoke-method (vlax-ename->vla-object (ssname sset2 (setq i3 (1- i3))) ) 'Highlight :vlax-false)
(if (/=(vla-get-lock (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) )(vla-get-layer (vlax-ename->vla-object (ssname get_sset i9))))):vlax-false )
(vlax-invoke-method (vlax-ename->vla-object (ssname sset2 (setq i3 (1- i3))) ) 'Highlight :vlax-false)
);if
);if
);repeat
(setq sset2 nil temperr nil)
(if (and errormsg1 (not (wcmatch (strcase errormsg1) "*BREAK*,*CANCEL*,*QUIT*") ) )
(prompt (strcat "\nError: " errormsg1) );then
);if
(princ)
);defun err
;-----------------------------------------
;setting variables
;-----------------------------------------
(setq temperr *error* )
(setq *error* errtrap1 )
;-----------------------------------------
;all environment variables can be found at \HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R22.0\ACAD-1006:409\FixedProfile\General
(if (= (getenv "AK_SUM_DecSym") nil) (setenv "AK_SUM_DecSym" ",") )
(if (= (getenv "AK_SUM_HIGHL") nil) (setenv "AK_SUM_HIGHL" "0") )
(if (= (getenv "AK_SUML_MULTDIV") nil) (setenv "AK_SUML_MULTDIV" "2") )
(if (= (getenv "AK_SUMA_MULTDIV") nil) (setenv "AK_SUMA_MULTDIV" "2") )
(if (= (getenv "AK_SUML_FACTOR") nil) (setenv "AK_SUML_FACTOR" "1") )
(if (= (getenv "AK_SUMA_FACTOR") nil) (setenv "AK_SUMA_FACTOR" "1") )
;-----------------------------------------
;object selection
;-----------------------------------------
(if (not (setq sset2 (ssget "_I") ) );checks if there is anything selected
(progn
(if (= mode1 1)
(setq sset2 (ssget '((0 . "LINE,SPLINE,LWPOLYLINE,POLYLINE,ARC,CIRCLE,ELLIPSE,AECB_DUCTFLEX,AECB_PIPEFITTING,AECB_PIPE,AECB_DUCT,AECB_DUCTFITTING,AECB_PIPECUSTOMFITTING,AECB_DUCTCUSTOMFITTING,AEC_WALL,AECB_CONDUITFITTING,AECB_CABLETRAY,AECB_CONDUIT,AECB_CABLETRAYFITTING,AECB_WIRE,AECB_SCHEMATIC,AECB_SCHEMATICSYMBOL,AECB_SCHEMATIC_PIPE,AECB_SCHEMATICPIPEFITTING" ))))
(progn
(setvar "ERRNO" 0)
(setq sset2 (ssadd))
(while (/= gr1 52)
(setq sset1 (ssget "_:S" ) )
(setq gr1 (getvar "ERRNO") )
(if sset1
(repeat (setq i1 (sslength sset1))
(setq elem1 (ssname sset1 (setq i1 (1- i1))) )
(if (vlax-property-available-p (vlax-ename->vla-object elem1) 'Area)
(progn
(if (/= (sslength sset2) 0)
(repeat (setq i2 (sslength sset2))
(if (= elem1 (ssname sset2 (setq i2 (1- i2))) ) (setq yesno1 1) )
);repeat
);if
(if (= yesno1 nil) (setq sset2 (ssadd elem1 sset2)) )
(setq yesno1 nil)
);progn
);if
);repeat
);if
(if (/= (sslength sset2) 0)
(repeat (setq i2 (sslength sset2))
(if (=(vla-get-lock (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ) (vla-get-layer (vlax-ename->vla-object (ssname get_sset i9))))):vlax-false )
(if (getcname "-DWGUNITS");checks if Autocad or Gstarcad. In Gstarcad dwgunits is unavailable. This condition prevents error in Gstarcad: ActiveX server returned an error: Exception occurred. We have to redraw the selection instead of invoking highlight methode.
(vlax-invoke-method (vlax-ename->vla-object (ssname get_sset i9)) 'Highlight :vlax-true);autocad
(redraw (ssname get_sset i9) 3);gstarcad
);if
);if
(vlax-invoke-method (vlax-ename->vla-object (ssname sset2 (setq i2 (1- i2))) ) 'Highlight :vlax-true)
);repeat
);if
);while
);progn
);if
);progn
(progn
(if (= mode1 1)
(repeat (setq i2 (sslength sset2))
(setq elem1 (ssname sset2 (setq i2 (1- i2))) )
(if (not (member (cdr (assoc 0 (entget elem1))) (list "LINE" "SPLINE" "LWPOLYLINE" "POLYLINE" "ARC" "CIRCLE" "ELLIPSE" "AECB_DUCTFLEX" "AECB_PIPEFITTING" "AECB_PIPE" "AECB_DUCT" "AECB_DUCTFITTING" "AECB_PIPECUSTOMFITTING" "AECB_DUCTCUSTOMFITTING" "AEC_WALL" "AECB_CONDUITFITTING" "AECB_CABLETRAY" "AECB_CONDUIT" "AECB_CABLETRAYFITTING" "AECB_WIRE" "AECB_SCHEMATIC" "AECB_SCHEMATICSYMBOL" "AECB_SCHEMATIC_PIPE" "AECB_SCHEMATICPIPEFITTING" ) ) )
(ssdel elem1 sset2)
);if
);repeat
(repeat (setq i2 (sslength sset2))
(setq elem1 (ssname sset2 (setq i2 (1- i2))) )
(if (not (vlax-property-available-p (vlax-ename->vla-object elem1) 'Area) )
(ssdel elem1 sset2)
);if
);repeat
);if
);progn
);if
(if (= sset2 nil) (exit))
;-----------------------------------------
(repeat (setq i2 (sslength sset2))
(vlax-invoke-method (vlax-ename->vla-object (ssname sset2 (setq i2 (1- i2))) ) 'Highlight :vlax-false)
);repeat
(setq param1 0.0)
(if sset2
(if (= mode1 0)
(progn
(repeat (setq i1 (sslength sset2))
(setq elem1 (ssname sset2 (setq i1 (1- i1))) )
(setq param1 (+ param1 (vla-get-area (vlax-ename->vla-object elem1)) ) )
);repeat
(setq paramN "\nTotal area = ")
);progn
(progn
(repeat (setq i1 (sslength sset2))
(setq elem1 (ssname sset2 (setq i1 (1- i1))) )
(setq param1 (+ param1 (vlax-curve-getDistAtParam elem1 (vlax-curve-getEndParam elem1))) )
);repeat
(setq paramN "\nTotal length = ")
);progn
);if)
);if
(if (= mode1 0)
(if (= (getenv "AK_SUMA_MULTDIV") "1")
(setq param1 (* param1 (atof (getenv "AK_SUMA_FACTOR") ) ) )
(setq param1 (/ param1 (atof (getenv "AK_SUMA_FACTOR") ) ) )
);if
(if (= (getenv "AK_SUML_MULTDIV") "1")
(setq param1 (* param1 (atof (getenv "AK_SUML_FACTOR") ) ) )
(setq param1 (/ param1 (atof (getenv "AK_SUML_FACTOR") ) ) )
);if
);if
;-----------------------------------------
(setq param1 (rtos param1))
(if (= (getenv "AK_SUM_DecSym") ".")
(setq param1 (vl-string-subst "." "," param1) )
(setq param1 (vl-string-subst "," "." param1) )
);if
(if (= mode1 0)
(if (= (getenv "AK_SUMA_MULTDIV") "1")
(setq FctInf (strcat "Multiply factor = " (getenv "AK_SUMA_FACTOR") ) )
(setq FctInf (strcat "Divide factor = " (getenv "AK_SUMA_FACTOR") ) )
);if
(if (= (getenv "AK_SUML_MULTDIV") "1")
(setq FctInf (strcat "Multiply factor = " (getenv "AK_SUML_FACTOR") ) )
(setq FctInf (strcat "Divide factor = " (getenv "AK_SUML_FACTOR") ) )
);if
);if
;-----------------------------------------
(if (= (getenv "AK_SUM_HIGHL") "1")
(progn
(setq i2 0)
(repeat (sslength sset2)
(vlax-invoke-method (vlax-ename->vla-object (ssname sset2 i2)) 'Highlight :vlax-true)
(setq i2 (1+ i2))
)
(sssetfirst nil)
(sssetfirst nil sset2)
);progn
(sssetfirst nil nil)
);if
;-----------------------------------------
(TXTTOCLIPBOARD param1);copies to clipboard content of param1. it has to be text string
(setq sset2 nil temperr nil)
(princ (strcat paramN param1 " is copied to clipboard. " FctInf " Setting available under SUMSETTINGS command."))
(princ)
);defun
;;; =======================================================
;;; TXTTOCLIPBOARD
;;; =======================================================
(defun TXTTOCLIPBOARD (txtstr1 / htmlfl PrntWndw CBdata)
(setq
htmlfl (vlax-create-object "HTMLfile");starts application
PrntWndw (vlax-get-property htmlfl 'ParentWindow)
CBdata (vlax-get-property PrntWndw 'ClipBoardData)
);setq
;(vlax-dump-object CBdata t);->displays supported methods: -> for ClipboardData: clearData, GetData and SetData
(vlax-invoke CBdata 'setData "TEXT" txtstr1)
(vlax-release-object htmlfl)
);defun
;;; ==================================================================
; SUMSETTINGS
;;; ==================================================================
(defun c:SUMSETTINGS (/ VFMinish1)
(setq VFMinish1 (SUMSETTINGS_DCL) )
(while (= VFMinish1 nil);makes program loop when choosing system and units in dcl
(setq VFMinish1 (SUMSETTINGS_DCL) )
);while
(princ)
);defun
(defun SUMSETTINGS_DCL (/ tmpfpath1 infile1 dcl_id VFMinish1)
(if (= (getenv "AK_SUM_DecSym") nil) (setenv "AK_SUM_DecSym" ",") )
(if (= (getenv "AK_SUM_HIGHL") nil) (setenv "AK_SUM_HIGHL" "0") )
(if (= (getenv "AK_SUML_MULTDIV") nil) (setenv "AK_SUML_MULTDIV" "2") )
(if (= (getenv "AK_SUMA_MULTDIV") nil) (setenv "AK_SUMA_MULTDIV" "2") )
(if (= (getenv "AK_SUML_FACTOR") nil) (setenv "AK_SUML_FACTOR" "1") )
(if (= (getenv "AK_SUMA_FACTOR") nil) (setenv "AK_SUMA_FACTOR" "1") )
(setq tmpfpath1 (strcat (getvar "MYDOCUMENTSPREFIX") "\\TEMP1DCL.DCL") )
(setq infile1 (open tmpfpath1 "w") )
(write-line
"dialog1 : dialog
{ label = \"SUMAREA SUMLEN SETTINGS v3.01\";
:row
{
: boxed_radio_column
{
label =\"Decimal Symbol:\";
: radio_button {key = AK_SUM_DecPt_key; label = \". - Point\" ; " infile1) (if (= (getenv "AK_SUM_DecSym") ".") (write-line "value = 1 ;" infile1 ) ) (write-line " }
: radio_button {key = AK_SUM_DecComa_key; label = \", - Coma\" ; " infile1) (if (= (getenv "AK_SUM_DecSym") ",") (write-line "value = 1 ;" infile1 ) ) (write-line " }
}
: text {label =\"\"; }
: column
{
label =\"SUMAREA Multiply / Divide by:\";
: radio_button {key = AK_SUMA_Multiply_key; label = \"Multiply by\" ; " infile1) (if (= (getenv "AK_SUMA_MULTDIV") "1") (write-line "value = 1 ;" infile1 ) ) (write-line " }
: radio_button {key = AK_SUMA_Divide_key; label = \"Divide by\" ; " infile1) (if (= (getenv "AK_SUMA_MULTDIV") "2") (write-line "value = 1 ;" infile1 ) ) (write-line " }
: edit_box { label =\"Factor:\"; key = Factor_sumA_key; edit_width = 4; allow_accept = true; }
: text {label =\"\"; }
}
: text {label =\"\"; }
: column
{
label =\"SUMLENGTH Multiply / Divide by:\";
: radio_button {key = AK_SUML_Multiply_key; label =\"Multiply by\" ; " infile1) (if (= (getenv "AK_SUML_MULTDIV") "1") (write-line "value = 1 ;" infile1 ) ) (write-line " }
: radio_button {key = AK_SUML_Divide_key; label =\"Divide by\" ; " infile1) (if (= (getenv "AK_SUML_MULTDIV") "2") (write-line "value = 1 ;" infile1 ) ) (write-line " }
: edit_box { label =\"Factor:\"; key = Factor_sumL_key; edit_width = 4; allow_accept = true; }
: text {label =\"\"; }
}
}
: text {label =\"\"; }
: toggle
{
label =\"Highlight objects on exit. \";
key = HighL_key;
" infile1) (if (= (getenv "AK_SUM_HIGHL") "1") (write-line "value = 1 ;" infile1 ) )(write-line "
}
: text {label =\"\"; }
: row
{
: button { key = updates_key; label = \"Check for updates\"; width = 2 ;fixed_width = true;}
ok_cancel;
}
: text {label =\"autolisps.blogspot.com\"; }
}"
infile1
);write line
(close infile1)
(setq dcl_id (load_dialog tmpfpath1) )
(if (new_dialog "dialog1" dcl_id)
(progn
(set_tile "Factor_sumL_key" (getenv "AK_SUML_FACTOR") )
(set_tile "Factor_sumA_key" (getenv "AK_SUMA_FACTOR") )
(set_tile "HighL_key" (getenv "AK_SUM_HIGHL") )
(mode_tile "Factor_sumL_key" 2);robi okno do wpisu na aktywne
(mode_tile "Factor_sumA_key" 2);robi okno do wpisu na aktywne
(action_tile "accept" "(setq VFMinish1 (SUMSETTING_accept)) (done_dialog)")
(action_tile "cancel" "(done_dialog) (setq dclexit1 1)")
(action_tile "updates_key" "(startapp \"explorer\" \"http://autolisps.blogspot.com/p/sumarea-sumlen-toclipboard_2.html\")")
(start_dialog);displays dialog box
(unload_dialog dcl_id)
(vl-file-delete tmpfpath1)
(if (= dclexit1 1) (progn (setq dclexit1 nil) (exit) ) )
);progn
(exit);else
);if
VFMinish1
);defun
(defun SUMSETTING_accept ( / )
(cond ;we need to separate conditions becouse Cond function after it finds matching one, doesn't check next conditions
( (= "1" (get_tile "AK_SUM_DecPt_key") ) (setenv "AK_SUM_DecSym" ".") )
( (= "1" (get_tile "AK_SUM_DecComa_key") ) (setenv "AK_SUM_DecSym" ",") )
);cond
(cond
( (= "1" (get_tile "AK_SUML_Multiply_key") ) (setenv "AK_SUML_MULTDIV" "1") )
( (= "1" (get_tile "AK_SUML_Divide_key") ) (setenv "AK_SUML_MULTDIV" "2") )
);cond
(cond
( (= "1" (get_tile "AK_SUMA_Multiply_key") ) (setenv "AK_SUMA_MULTDIV" "1") )
( (= "1" (get_tile "AK_SUMA_Divide_key") ) (setenv "AK_SUMA_MULTDIV" "2") )
);cond
(if (= "1" (get_tile "HighL_key") ) (setenv "AK_SUM_HIGHL" "1") (setenv "AK_SUM_HIGHL" "0"))
(if (not (numberp (read (get_tile "Factor_sumL_key") ) ) )
(setq VFMinish1 nil)
(progn
(setenv "AK_SUML_FACTOR" (get_tile "Factor_sumL_key") )
(setq VFMinish1 1)
);progn
);if
(if (not (numberp (read (get_tile "Factor_sumA_key") ) ) )
(setq VFMinish1 nil)
(progn
(setenv "AK_SUMA_FACTOR" (get_tile "Factor_sumA_key") )
(setq VFMinish1 1)
);progn
);if
VFMinish1
);defun
;;; ================================================
; FLTRBY_HIGHLIGHSEL
;;; ================================================
;highlights selectionset
(defun SUMA_HIGHLIGHSEL ( get_sset / i9 MyLayers1)
(setq i9 0)
(setq MyLayers1 (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ))
(repeat (sslength get_sset)
(if (=(vla-get-lock (vla-item MyLayers1(vla-get-layer (vlax-ename->vla-object (ssname get_sset i9))))):vlax-true )
(if (getcname "-DWGUNITS");checks if Autocad or Gstarcad. In Gstarcad dwgunits is unavailable. This condition prevents error in Gstarcad: ActiveX server returned an error: Exception occurred. We have to redraw the selection instead of invoking highlight methode.
(vlax-invoke-method (vlax-ename->vla-object (ssname get_sset i9)) 'Highlight :vlax-true);autocad
(redraw (ssname get_sset i9) 3);gstarcad
);if
(vlax-invoke-method (vlax-ename->vla-object (ssname get_sset i9)) 'Highlight :vlax-true)
);if
(setq i9 (1+ i9))
)
(sssetfirst nil)
(sssetfirst nil get_sset)
);defun
Example:
Version history:
1.00 - 05.11.2015-first release
[...] - misc updates
2.06 - 21.04.2019 - combining SUMA and SUML into one routine, adding Sumsettings command
2.07 - 22.04.2019 - adding DivideBy / MultiplyBy Factor in Sumsettings dialog window
2.08 - 16.02.2021 - separated Multiply Factor for Area and Length
3.00 - 27.02.2021 - separated multiply function for SUMA and SUML in settings, added error section, active excluding incompatibile objects while selecting, added highlightning objects on exit. Added information about Multiply factor in command result in commandline.
3.01 - 08.07.2022 - fixed bug with highlightning objects on locked layers.
Compatibility:
-All Autocad versions
Download file: SUMAREA_SUMLEN_toCLIPBOARD_v3_01.FAS
No comments:
Post a Comment