Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 01/03/2023 in all areas

  1. Try this: (defun c:calcVR(/ sum sumCubic ss i dim m) (setq sum 0 sumCubic 0 ) (setq ss (ssget '((0 . "DIMENSION")))) (repeat (setq i (sslength ss)) (setq dim (vlax-ename->vla-object (ssname ss (setq i (1- i))))) (if (/= (vlax-get dim 'textOverride) "") (setq m (atof (vlax-get dim 'textOverride))) (setq m (atof (rtos (vlax-get dim 'measurement) 2 (vlax-get dim 'TolerancePrecision)))) ) (setq sum (+ sum m) sumCubic (+ sumCubic (expt m 3)) ) ) (alert (strcat "Vão regulador: " (rtos (sqrt (/ sumCubic sum)) 2 0))) (princ) )
    2 points
  2. You have to use ssnamex to get all the entity names (defun c:Mlabel (/ SS ent obj) (vl-load-com) (if (setq SS (ssget)) ; gets a selection set (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (redraw ent 3) ;Highlight entity that layer name will be pulled from (vl-cmdf "_.mleader" "_non" (vlax-curve-getclosestpointto (setq obj (vlax-ename->vla-object ent)) (getpoint "\nSpecify first point: ")) "\\") ;this will pick a point on the entity (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf "")) ;wait for 2nd point for mleader (vla-put-textstring (vlax-ename->vla-object (entlast)) (vlax-get-property obj 'Layer) ) (redraw ent 4) ;un-highlight entity ) ) (princ) ) --Edit Will need to add a bit more code. ill have something later tonight. needed to add redraw so the current entity would be highlighted so user can pick a point closest to it moves the leader point onto the entity waits for 2nd point cmdactive reused from original lisp. un-highlights entity so next loop the current entity will only be highlighted.
    1 point
  3. FYI You should release the clipboard interface after pasting to it. ;;Copy result to clipboard (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" (rtos textsum) ) (vlax-release-object html) http://www.theswamp.org/index.php?PHPSESSID=2aae48e2b4c9aa47e060a29940641d81&topic=44212.msg494826#msg494826
    1 point
  4. Copied and pasted from other stuff I have and probably more efficient ways to do this Commands: txtsum will display the result in the command line and copy it into the clipboard txtsumtt will ask for target text to copy the sum into I think it works with fields, can be a bit variable with summing dimension values, but should do the example above (defun txtsum ( / entlist1 entcodes1 ent1 text01 textsum acount textss) ;;Variables (setq textsum 0) (setq acount 0) ;;Select Text (princ "\nSelect numbers to sum") (setq textss (ssget '((0 . "*TEXT,DIMENSION"))) ) (while (< acount (sslength textss)) (setq ent1 (ssname textss acount)) (setq entlist1 (entget ent1)) (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text. (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string (setq textsum (+ textsum (atof text01)) ) (setq acount (+ acount 1)) ) textsum ) (defun c:txtsum ( / textsum) (setq textsum (txtsum) ) (princ "Total: ") (princ textsum) ;;Copy result to clipboard (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" (rtos textsum) ) (vlax-release-object html) (princ) ) (defun c:txtsumtt ( / textsum ent1 entlist1 entcodes1 text01) (setq textsum (txtsum) ) (if (setq ent1 (getent "\nSelect Text to Update (or escape): ")) (progn (setq entlist1 (entget ent1)) (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text. (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string (addinnewtext textsum entlist1 ent1) (command "redraw") (command "regen") ;;update it all ) ) ;;Copy result to clipboard (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" (rtos textsum) ) (vlax-release-object html) (princ) ) ;;;Sub routines (defun gettextdxfcodes ( entlist1 / dxfcodes) ;;DXF codes containing texts (setq dxfcodes (list 3 4 1 172 304)) ;;general (if (= (cdr (assoc 0 entlist1)) "DIMENSION") ;;If Dimension (progn (if (= (cdr (assoc 1 entlist1)) nil) (setq dxfcodes (list 4 42 172 304)) ;;No 3, add 42 for dimension value (if (and (= (wcmatch "<>" (cdr (assoc 1 entlist1))) nil)(= (wcmatch "\"\"" (cdr (assoc 1 entlist1))) nil) ) (setq dxfcodes (list 4 1 172 304)) ;;No 3, no 42 for dimension value (setq dxfcodes (list 4 1 42 172 304)) ;;Somehow combine 1 and 42 here, text replace and so on. ) ;end if ) ;end if ));end progn end if Dimensions (if (= (cdr (assoc 0 entlist1)) "MULTILEADER") ;;Is MultiLeader (progn (setq dxfcodes (list 304)) ));end progn end if Dimensions dxfcodes ) (defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext) ;;get dotted pairs list (setq entlist (entget ent)) (if ( = (cdr (assoc 0 entlist)) "RTEXT") (progn (setq mytext (getrtext entlist)) ) ; end progn (progn (setq enttype (cdr (assoc 0 entlist))) (setq acount 0) (while (< acount (length entlist)) (setq acounter 0) (while (< acounter (length entcodes)) (setq entcode (nth acounter entcodes)) (if (= (car (nth acount entlist)) entcode ) (progn (setq newtext (cdr (nth acount entlist))) (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) ) );end progn );end if (setq acounter (+ acounter 1)) );end while (setq acount (+ acount 1)) );end while ;;get string from dotted pair lists (if (= listorstring "astring") ;convert to text (progn (if (> (length mytext) 0) (progn (setq acount 0) (setq temptext "") (while (< acount (length mytext)) (setq temptext (cdr (nth acount mytext)) ) (if (= (wcmatch temptext "LEADER_LINE*") nil)()(setq temptext "")) ;;Fix for Multileader 'Leader_Line' Text (if (= stringtext nil) (setq stringtext temptext) (setq stringtext (strcat stringtext temptext )) );end if (setq acount (+ acount 1)) );end while );end progn );end if (if (= stringtext nil)(setq stringtext "")) (setq mytext stringtext) );end progn );end if );end progn ); end if mytext ) ;;get text as a string (defun gettextasstring ( enta entcodes / texta ) (if (= (getfroment enta "astring" entcodes) "") () (setq texta (getfroment enta "astring" entcodes)) ) texta ) (defun addinnewtext (newtext newentlist newent / ) (if (/= newtext nil) (progn (cond ( (= (cdr (assoc 0 newentlist)) "DIMENSION") (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist))) (entupd newent) );end condition ( (= (cdr (assoc 0 newentlist)) "RTEXT") (princ "\nRtext: Unwilling to update source file (") (princ (cdr (assoc 1 newentlist)) ) (princ ")") );end condition (t ;everything else ;;vla-put-text string for large text blocks + 2000 characters? (vla-put-textstring (vlax-ename->vla-object newent) newtext) );end condition ) ;end cond ) ;end progn (princ "\nSource text is not 'text'") );end if )
    1 point
  5. this is what I use to break by one point: (defun c:Brk_Fp () (if (and (setq ss (ssget ":S")) (setq pt (getpoint "\nSelect break point: ")) ) (progn (setq ename (ssname ss 0)) (command "_.break" ename "_none" pt "_none" pt) ) ) (princ) )
    1 point
×
×
  • Create New...