Jump to content

Leaderboard

  1. Lee Mac

    Lee Mac

    Trusted Member


    • Points

      3

    • Posts

      21,014


  2. GLAVCVS

    GLAVCVS

    Community Member


    • Points

      2

    • Posts

      673


  3. Saxlle

    Saxlle

    Community Member


    • Points

      2

    • Posts

      187


  4. Steven P

    Steven P

    Trusted Member


    • Points

      2

    • Posts

      2,826


Popular Content

Showing content with the highest reputation on 03/21/2025 in Posts

  1. Where layer transparency is concerned, this may be of interest - https://www.theswamp.org/index.php?topic=52473.msg574001#msg574001
    3 points
  2. In numerical functions, this: ;; TEXT ((equal (cdr (assoc 0 edata)) "TEXT") (setq val (cdr (assoc 1 edata)))) ;; MTEXT ((equal (cdr (assoc 0 edata)) "MTEXT") (setq str1 (cdr (assoc 1 edata))) (setq str3 (cdr (assoc 3 edata))) (setq val (strcat str1 str3)) ) could probably be just ;; TEXT ((equal (cdr (assoc 0 edata)) "*TEXT") (setq val (cdr (assoc 1 edata))) ) reason being in text. assoc 3 comes into things if the text string is over 256 characters long... which is a very very big number.
    1 point
  3. Nikon, you forgot to add open and closing brackets for v1 and v2... Like I said it should be : (atof v1) and (atof v2)...
    1 point
  4. After the layer is created add this line to set 30% transparency: (entmod (append (entget (tblobjname "layer" lay)) '((-3("AcCmTransparency" (1071 . 33554610))))))
    1 point
  5. you may also consider using a simple block first , just a rectangle , that way routine might run faster. After you're done , replace simple blocks with actual 3D chairs.
    1 point
  6. Whereever in the code occurs v1 or v2, change them to (atof v1) and (atof v2)...
    1 point
  7. Since it's not a text string and you want to concatenate it with '(cdr (assoc 1 edata))', it gets 'indigestible' and 'erupts': stringp nil'
    1 point
  8. You need to use Code Tags (<> in the editor toolbar) for your Code, not Quote Tags!
    1 point
  9. Hey @PGia, Try the modified code from last post. I updated code about an 1 hour ago. Maybe you tried unupdated version.
    1 point
  10. Just wondering how many churches you lay out like this. If it is just the one I would be tempted to fill the rows with a basic polar array, probably quicker than writing and testing a LISP. If you are doing this multiple times then LISP makes sense though
    1 point
  11. Hi @PGia Can you attach a larger drawing? I need to run some tests.
    1 point
  12. (defun c:pl_area (/ bb e h ll lst lst2 pt pts n nv q r ss sst str ta ur v raycast plineoff) ;;LeeMac (defun raycast ( p l ) (= 1 (logand 1 (length (vl-remove 'nil (mapcar '(lambda ( a b ) (inters p (mapcar '+ p '(1e8 0.0)) a b)) (cons (last l) l) l ) ) ) ) ) ) (defun plineoff (v off Out / e eng pts vs) (setq e (vlax-vla-object->ename v) eng (entget (vlax-vla-object->ename (car (vl-sort (setq vs (mapcar 'car (list (vlax-invoke v 'offset off) (vlax-invoke v 'offset (- off))))) '(lambda (x y) ((if out > <) (vla-get-area x) (vla-get-area y)) ) ) ) ) ) pts (mapcar '(lambda (x)(trans (cdr x) e 1)) (vl-remove-if-not '(lambda (x) (eq (car x) 10)) eng)) ) (mapcar 'vla-delete vs) pts ) (if (setq e (car (entsel "\nSelect largest polyline: "))) (progn (setq v (vlax-ename->vla-object e) ta (vla-get-area v) bb (plineoff v 1.0 T) ss (ssget "wp" bb '((0 . "LWPOLYLINE"))) sst (ssget "cp" bb '((0 . "MTEXT,TEXT"))) ) (if (eq (sslength ss)(sslength sst)) (progn (repeat (setq n (sslength ss)) (setq n (1- n) e (ssname ss n) v (vlax-ename->vla-object e) a (vla-get-area v) lst (cons (cons a e) lst) ) ) (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y)))) q 0 r (length lst)) (repeat (setq n (sslength sst)) (setq n (1- n) e (ssname sst n) v (vlax-ename->vla-object e) lst2 (cons (cons v (vlax-get v 'insertionpoint)) lst2) ) ) (foreach a lst (setq q (1+ q) eng (entget (cdr a)) pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) eng)) str (rtos (if (not (eq q r)) (car a) ta) 2 4) ta (- ta (car a)) ) (foreach pt lst2 (if (raycast (cdr pt) pts) (progn (if (eq (vla-get-objectname (car pt)) "AcDbMText") (vlax-put (car pt) 'textstring (strcat (vlax-get (car pt) 'textstring) "\\P= " str) ) (progn (setq nv (vla-copy (car pt)) h (* 1.3333 (vla-get-height nv))) (vlax-put nv 'textstring str) (vlax-put nv 'insertionpoint (list (car (cdr pt)) (- (cadr (cdr pt)) h) (caddr (cdr pt)))) ) ) (setq lst2 (vl-remove pt lst2)) ) ) ) ) ) (prompt "\nPolyline and text counts do not match. Check selection.") ) ) ) (princ) ) here's my latest revision as well.
    1 point
  13. Hey @PGia, Try this new one: ; **************************************************************************************** ; Functions : UMTXT ; Description : Adding an Area value to the label/text of each closed polyline ; Author : SAXLLE ; Date : March 20, 2025 ; Update 1.0 : Added a substraction to get a total value of largest closed polyline ; Update date : March 21, 2025 ; **************************************************************************************** (prompt "\nTo run a LISP type: UMTXT") (princ) (defun c:UMTXT ( / old_nomutt ss len i area_with_entity_list area area_with_entity len_area_with_entity_list j max_val substracted_area total_area ptlist select_text data_text new_txt k) (setq old_nomutt (getvar 'nomutt)) ;; Get a value from 'nomutt (setvar 'nomutt 1) ;; Set a value to be "1" to "supress" the default "Select objects:" from ssget (princ "\nSelect closed POLYLINES:") (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))) ;; Select ONLY POLYLINES which are closed! "1" means "1 = Closed" len (sslength ss) ;; Length of selection set i 0 ;; 1. iterator area_with_entity_list (list) ;; In this list will be stored joined value of an Area and entity (e.g. (500 . <Entity name: 2ed1289fd60>)) ) (while (< i len) (setq area (vlax-get-property (vlax-ename->vla-object (ssname ss i)) 'Area) ;; Get an Area from closed POYLINE area_with_entity (cons area (ssname ss i)) ;; Join the value of Area with entity name area_with_entity_list (cons area_with_entity area_with_entity_list) ;; Create a list of value with Area and entity name ) (setq i (1+ i)) ;; Adding 1+ to iterator "i" to repeat iterating through selection set "ss" ) (setq area_with_entity_list (vl-sort area_with_entity_list (function (lambda (x1 x2) (< (car x1) (car x2))))) ;; Sorting list from MIN to MAX area with entity len_area_with_entity_list (length area_with_entity_list) ;; Length of elements in the variable "area_with_entity_list" j 0 ;; 2. iterator with FIX value "0" ) (setq max_val (car (nth 0 area_with_entity_list))) ;; Get the first value as MAX value of an Area (repeat (setq len_max (length area_with_entity_list)) ;; Finding a MAX value of an Area from variable "area_with_entity_list" (if (<= max_val (car (nth (1- len_max) area_with_entity_list))) (setq max_val (car (nth (1- len_max) area_with_entity_list)) len_max (1- len_max) ) (setq max_val max_val) ) ) (setq substracted_area 0) ;; Set "substracted_area" to 0 (repeat (setq len_max (length area_with_entity_list)) ;; Finding a "substracted_area" from variable "area_with_entity_list" which are going to be substracted from variable "max_val" (if (> max_val (car (nth (1- len_max) area_with_entity_list))) (setq result (+ substracted_area (car (nth (1- len_max) area_with_entity_list))) substracted_area result len_max (1- len_max) ) (setq len_max (1- len_max)) ) ) (setq total_area (- max_val substracted_area)) ;; This is a total area for the largest closed polyline, where the rest Area from closed poylines substracted from variable "max_val" (repeat len_area_with_entity_list (setq ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (cdr (nth j area_with_entity_list))))) ;; Get a vertices from closed POLYLINE select_text (ssget "_WP" ptlist '((0 . "*TEXT,MTEXT"))) ;; Select ONLY TEXT or MTEXT entities ) (if (/= select_text nil) ;; 1. progn with WINDOW POLYGON "_WP" (progn ;; start cond (cond ;;1. cond ((= (sslength select_text) 1) ;; If the length of selected TEXT or MTEXT equal to 1 (setq data_text (cdr (assoc 1 (entget (ssname select_text 0))))) ;; Get a data from TEXT or MTEXT entity (if (wcmatch data_text "*=*") ;; Check if text contain "=" (nil) (progn (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos (car (nth j area_with_entity_list)) 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text 0)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued ) ) ) ;; end 1. cond ;;2. cond ((>= (sslength select_text) 2) ;; If the length of selected TEXT or MTEXT are greater or equal to 2 (setq k (- (sslength select_text) 1)) ;; 3. iterator (repeat (sslength select_text) (if (/= k -1) (progn (setq data_text (cdr (assoc 1 (entget (ssname select_text k))))) ;; Get a data from TEXT or MTEXT entity (if (wcmatch data_text "*=*") ;; Check if text contain "=" (setq k (1- k)) (progn (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos total_area 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text k)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value (setq k (1- k)) ;; Reduce 1- to iterator "k" to repeat iterating through selection set "select_text" ) ) ) ) ) (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued ) ;; end 2. cond ) ;; end cond ) ;; end 1. progn ;; 2. progn with FENCE "_F" (progn (setq select_text (ssget "_F" ptlist '((0 . "*TEXT,MTEXT")))) ;; Select ONLY TEXT or MTEXT entities ;; start cond (cond ;;1. cond ((= (sslength select_text) 1) ;; If the length of selected TEXT or MTEXT equal to 1 (setq data_text (cdr (assoc 1 (entget (ssname select_text 0))))) ;; Get a data from TEXT or MTEXT entity (if (wcmatch data_text "*=*") ;; Check if text contain "=" (nil) (progn (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos (car (nth j area_with_entity_list)) 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text 0)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued ) ) ) ;; end 1. cond ;;2. cond ((>= (sslength select_text) 2) ;; If the length of selected TEXT or MTEXT are greater or equal to 2 (setq k (- (sslength select_text) 1)) ;; 3. iterator (repeat (sslength select_text) (if (/= k -1) (progn (setq data_text (cdr (assoc 1 (entget (ssname select_text k))))) ;; Get a data from TEXT or MTEXT entity (if (wcmatch data_text "*=*") ;; Check if text contain "=" (setq k (1- k)) (progn (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos total_area 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text k)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value (setq k (1- k)) ;; Reduce 1- to iterator "k" to repeat iterating through selection set "select_text" ) ) ) ) ) (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued ) ;; end 2. cond ) ;; end cond ) ;; end 2. progn ) ;; end if ) ;; end repeat (setvar 'nomutt old_nomutt) ;; Restore old value to 'nomutt (prompt "\nAdding area to the labels has been done!") (princ) ) I'v been tested this new one lisp on the both drawing which are you uploaded, and get great result (picture 1 and picture 2). Picture 1. Picture 2. I hope you will get satisfied. Notice: It will only concate the label/text value of closed polyline with an Area of that closed polyline, for opened polylines, nothing is going to happen. Best regards.
    1 point
×
×
  • Create New...