Jump to content
jvelasco

Please Help to Modify Code to Allow Select Various Objects

Recommended Posts

jvelasco
Posted (edited)

Can any of yall wise members of the forum give me a hand?

 

The goal it is modify this code to allow me to select several objects at the same time.

 

This is a LISP that creates dimensions around polylines under some parameters.  My problem is that only lets me select 1 object (polyline) at a time.

 

I would like the program to ask me for "select objects" (plural)  in the first place.

 

My name is Juan,  and I would really apreciate your help  :)

 


 

(defun c:ADIM (/       *error* mid     add:dim calc:p  calc:ang
           add:arc add:raddim      s       l       p       ol
           fl      cm      os      cen
          )
  (MSM:STARTUNDOMARK)
  (defun *error* (msg)
    (if    os
      (setvar 'osmode os)
    )
    (if    cm
      (setvar 'cmdecho cm)
    )
    (MSM:ENDUNDOMARK)
    (if    (not
      (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*erased")
    )
      (princ "\nStatus = Function Cancelled")
    )
    (princ)
  )
  (defun mid (p1 p2)
    (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
  )
  (defun add:dim (p1 p2 p3 / e d)
    (setq e (entlast))
    (command "DIMALIGNED" p1 p2 p3)
    (if    (and (setq d (entlast))
         (/= e d)
         (setq d (vlax-ename->vla-object d))
         (wcmatch (vla-get-objectname d) "*Dimension")
    )
      (progn
    (vla-put-layer d "AUTO DIM")
    (if (tblsearch "dimstyle" "Standard")
      (vla-put-stylename d "DIM")
    )
      )
    )
  )
  (defun calc:p    (p1 p2 b / a c r)
    (setq a (* 2 (atan b))
      r (/ (distance p1 p2) 2 (sin a))
      c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r)
    )
    (if    (minusp b)
      (list c (angle c p2) (angle c p1) (abs r))
      (list c (angle c p1) (angle c p2) (abs r))
    )
  )
  (defun calc:ang (pnt / an)
    (if    (setq an (angle cen pnt))
      (cond ((<= (* pi 0.25) an (* pi 0.75)) (* pi 0.5))
        ((<= (* pi 0.75) an (* pi 1.25)) pi)
        ((<= (* pi 1.25) an (* pi 1.75)) (* pi 1.5))
        ((<= (* pi 1.75) an (* pi 2.0)) 0.0)
        ((<= 0.0 an (* pi 0.25)) 0.0)
      )
    )
  )
  (defun add:arc (p1 p2 b)
    (entmakex
      (cons '(0 . "ARC")
        (mapcar 'cons
            '(10 50 51 40)
            (calc:p p1 p2 b)
        )
      )
    )
  )
  (defun add:raddim (p1 p2 b / e d arc p3)
    (if    (setq arc (add:arc p1 p2 b))
      (progn
    (setq e (entlast))
    (setq arc (vlax-ename->vla-object arc))
    (setq p3
           (vlax-curve-getpointatdist e (/ (vla-get-arclength arc) 2.))
    )
    (command "DIMRADIUS"
         (list (vlax-vla-object->ename arc) p3)
         (vlax-get arc 'center)
    )
    (setq d (entlast))
    (if (and (/= e d)
         (setq d (vlax-ename->vla-object d))
         (wcmatch (vla-get-objectname d) "*Dimension")
        )
      (progn
        (vla-put-layer d "AUTO DIM")
        (if    (tblsearch "dimstyle" "Standard")
          (vla-put-stylename d "DIM")
        )
        (vla-put-arrowheadtype d 0)
        (vla-put-arrowheadsize d 1.7)
      )
    )
    (vla-delete arc)
    d
      )
    )
  )
  (cond
    ((not (setq s (car (entsel "\nSelect Polyline : "))))
     (alert "Nothing selected.")
    )
    ((not
       (wcmatch (cdr (assoc 0 (setq s (entget s)))) "*POLYLINE")
     )
     (alert "Please select Polyline object.")
    )
    (t
     (setq cm (getvar 'cmdecho)
       os (getvar 'osmode)
     )
     (setvar 'cmdecho 0)
     (setvar 'osmode 0)
     (if (not (tblsearch "LAYER" "AUTO DIM"))
       (MSM:LAYER "AUTO DIM" 0 7 "Continuous")
     )
     (setq cen (LM:PolyCentroid (cdr (assoc -1 s))))
     (setq l (vl-remove-if-not
           '(lambda    (x)
          (member (car x) '(10 42))
        )
           s
         )
     )
     (if (eq (cdr (assoc 70 s)) 1)
       (setq
     l (reverse (cons (cons 42 0.0) (cons (car l) (reverse l))))
       )
     )
     (setq s (vlax-ename->vla-object (cdr (assoc -1 s))))
     (setq p (vl-remove    nil
            (mapcar
              '(lambda (x y z)
                 (if (eq (car x) 10)
                   (list x y z)
                 )
               )
              l
              (cdr l)
              (cddr l)
            )
         )
     )
     (setq
       ol (mapcar '(lambda (x)
             (if (zerop (cdr (cadr x)))
               (MSM:LINE (vla-get-layer s)
                 (vla-get-color s)
                 (cdr (car x))
                 (cdr (caddr x))
               )
               (progn
             (add:raddim
               (cdr (car x))
               (cdr (caddr x))
               (cdr (cadr x))
             )
             "F"
               )
             )
           )
          p
      )
     )
     (if (member "F" ol)
       (progn
     (setq
       fl (mapcar
        '(lambda (x y z)
           (if (eq y "F")
             (list x y z)
           )
         )
        ol
        (reverse (cons (car ol) (reverse (cdr ol))))
        (reverse
          (cons (cadr ol) (cons (car ol) (reverse (cddr ol))))
        )
          )
     )
     (foreach x fl
       (command "chamfer" (car x) (caddr x))
     )
       )
     )
     (mapcar
       '(lambda    (x / x1 x2 xa xp)
      (if (and (/= (type x) 'STR)
           (setq x1 (cdr (assoc 10 (entget x))))
           (setq x2 (cdr (assoc 11 (entget x))))
           (> (distance x1 x2) 20.)
          )
        (progn
          (setq xa (angle x1 x2))
          (setq xp (mid x1 x2))
          (setq xp (polar xp (calc:ang xp) 3.7))
          (add:dim x1 x2 xp)
        )
      )
    )
       ol
     )
     (vla-delete s)
     (setvar 'osmode os)
     (setvar 'cmdecho cm)
    )
  )
  (MSM:ENDUNDOMARK)
  (princ)
)
(VL-LOAD-COM)
(PRINC)
(PRINC
  (STRCAT
    "\n:: Add Dimensions_V1.lsp ::"
    "\n:: Created by Satish Rajdev | "
    (MENUCMD "M=$(edtime,$(getvar,date),DDDD\",\" D MONTH YYYY)"
    )
    " ::"
    "\n:: Type \"ADIM\" to Invoke ::"
  )
)
(SETQ MSM:ACAD    (VLAX-GET-ACAD-OBJECT)
      MSM:ACDOC    (VLA-GET-ACTIVEDOCUMENT MSM:ACAD)
      MSM:MODEL    (VLA-GET-MODELSPACE MSM:ACDOC)
)
(DEFUN MSM:STARTUNDOMARK ()
  (MSM:ENDUNDOMARK)
  (VLA-STARTUNDOMARK MSM:ACDOC)
)
(DEFUN MSM:ENDUNDOMARK ()
  (VLA-ENDUNDOMARK MSM:ACDOC)
)
(DEFUN MSM:LINE    (LAYER COLOR STARTPOINT ENDPOINT)
  (ENTMAKEX (LIST '(0 . "LINE")
          '(100 . "AcDbEntity")
          (CONS 8 LAYER)
          (CONS 62 COLOR)
          (CONS 100 "AcDbLine")
          (CONS 10 STARTPOINT)
          (CONS 11 ENDPOINT)
        )
  )
)
(DEFUN MSM:LAYER (NAME FLAG COLOR LINETYPE)
  (ENTMAKE (LIST
         '(0 . "LAYER")
         (CONS 100 "AcDbSymbolTableRecord")
         (CONS 100 "AcDbLayerTableRecord")
         (CONS 2 NAME)
         (CONS 70 FLAG)
         (CONS 62 COLOR)
         (CONS 6 LINETYPE)
       )
  )
)
(defun LM:PolyCentroid (e / l)
  (foreach x (setq e (entget e))
    (if    (= 10 (car x))
      (setq l (cons (cdr x) l))
    )
  )
  (
   (lambda (a)
     (if (not (equal 0.0 a 1e-8))
       (trans
     (mapcar
       '/
       (apply
         'mapcar
         (cons '+
           (mapcar
             (function
               (lambda (a b)
             (
              (lambda (m)
                (mapcar
                  (function
                (lambda (c d) (* (+ c d) m))
                  )
                  a
                  b
                )
              )
               (- (* (car a) (cadr b)) (* (car b) (cadr a)))
             )
               )
             )
             l
             (cons (last l) l)
           )
         )
       )
       (list a a)
     )
     (cdr (assoc 210 e))
     0
       )
     )
   )
    (* 3.0
       (apply '+
          (mapcar
        (function
          (lambda (a b)
            (- (* (car a) (cadr b)) (* (car b) (cadr a)))
          )
        )
        l
        (cons (last l) l)
          )
       )
    )
  )
)
(PRINC)


 

Edited by jvelasco

Share this post


Link to post
Share on other sites
rlx


(defun c:ADIM  (/ *error* mid add:dim calc:p calc:ang add:arc add:raddim s l p ol fl cm os cen ss)
  (MSM:STARTUNDOMARK)
  (defun *error* (msg) (if os (setvar 'osmode os)) (if cm (setvar 'cmdecho cm)) (MSM:ENDUNDOMARK)
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*erased"))(princ "\nStatus = Function Cancelled"))(princ))
  (defun mid (p1 p2) (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2))
  (defun add:dim (p1 p2 p3 / e d)(setq e (entlast))(command "DIMALIGNED" p1 p2 p3)
    (if (and (setq d (entlast))(/= e d)(setq d (vlax-ename->vla-object d))(wcmatch (vla-get-objectname d) "*Dimension"))
      (progn (vla-put-layer d "AUTO DIM")(if (tblsearch "dimstyle" "Standard")(vla-put-stylename d "DIM")))))
  (defun calc:p (p1 p2 b / a c r)(setq a (* 2 (atan b)) r (/ (distance p1 p2) 2 (sin a)) c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r))
    (if (minusp b)(list c (angle c p2) (angle c p1) (abs r))(list c (angle c p1) (angle c p2) (abs r))))
  (defun calc:ang  (pnt / an) (if (setq an (angle cen pnt))(cond ((<= (* pi 0.25) an (* pi 0.75)) (* pi 0.5))
    ((<= (* pi 0.75) an (* pi 1.25)) pi)((<= (* pi 1.25) an (* pi 1.75)) (* pi 1.5))((<= (* pi 1.75) an (* pi 2.0)) 0.0)
      ((<= 0.0 an (* pi 0.25)) 0.0))))
  (defun add:arc (p1 p2 b)(entmakex (cons '(0 . "ARC")(mapcar 'cons '(10 50 51 40) (calc:p p1 p2 b)))))
  (defun add:raddim  (p1 p2 b / e d arc p3)
    (if (setq arc (add:arc p1 p2 b))
      (progn (setq e (entlast))(setq arc (vlax-ename->vla-object arc))
             (setq p3 (vlax-curve-getpointatdist e (/ (vla-get-arclength arc) 2.)))
             (command "DIMRADIUS" (list (vlax-vla-object->ename arc) p3)(vlax-get arc 'center))
             (setq d (entlast))
             (if (and (/= e d)(setq d (vlax-ename->vla-object d))(wcmatch (vla-get-objectname d) "*Dimension"))
               (progn (vla-put-layer d "AUTO DIM")(if (tblsearch "dimstyle" "Standard")(vla-put-stylename d "DIM"))
                      (vla-put-arrowheadtype d 0)(vla-put-arrowheadsize d 1.7)))(vla-delete arc) d)))
  (cond
    ;((not (setq s (car (entsel "\nSelect Polyline : ")))) (alert "Nothing selected."))
    ;((not (wcmatch (cdr (assoc 0 (setq s (entget s)))) "*POLYLINE"))(alert "Please select Polyline object."))
    ((not (setq ss (ssget '((0 . "*POLYLINE")))))(alert "No polylines were selected"))
    (t
     (setq cm (getvar 'cmdecho) os (getvar 'osmode))(setvar 'cmdecho 0)(setvar 'osmode 0)
     (if (not (tblsearch "LAYER" "AUTO DIM"))(MSM:LAYER "AUTO DIM" 0 7 "Continuous"))
     (foreach s (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       (setq s (entget s) cen (LM:PolyCentroid (cdr (assoc -1 s))))
       (setq l (vl-remove-if-not '(lambda (x) (member (car x) '(10 42))) s))
       (if (eq (cdr (assoc 70 s)) 1)(setq l (reverse (cons (cons 42 0.0) (cons (car l) (reverse l))))))
       (setq s (vlax-ename->vla-object (cdr (assoc -1 s))))
       (setq p (vl-remove nil (mapcar '(lambda (x y z)(if (eq (car x) 10)(list x y z))) l (cdr l)(cddr l))))
       (setq ol (mapcar '(lambda (x) (if (zerop (cdr (cadr x))) (MSM:LINE (vla-get-layer s)(vla-get-color s)(cdr (car x))(cdr (caddr x)))
                           (progn (add:raddim (cdr (car x))(cdr (caddr x))(cdr (cadr x))) "F"))) p))
       (if (member "F" ol)
         (progn (setq fl (mapcar '(lambda (x y z)(if (eq y "F")(list x y z))) ol (reverse (cons (car ol) (reverse (cdr ol))))
                       (reverse (cons (cadr ol) (cons (car ol) (reverse (cddr ol))))))) (foreach x fl (command "chamfer" (car x) (caddr x)))))
       (mapcar '(lambda (x / x1 x2 xa xp)
         (if (and (/= (type x) 'STR)(setq x1 (cdr (assoc 10 (entget x))))(setq x2 (cdr (assoc 11 (entget x))))(> (distance x1 x2) 20.))
           (progn (setq xa (angle x1 x2))(setq xp (mid x1 x2))(setq xp (polar xp (calc:ang xp) 3.7))(add:dim x1 x2 xp)))) ol)
       (vla-delete s)
     )
     (setvar 'osmode os)(setvar 'cmdecho cm)
   ); end t
  ); end cond
  (MSM:ENDUNDOMARK)
  (princ)
)

(VL-LOAD-COM)(PRINC)(PRINC (STRCAT "\n:: Add Dimensions_V1.lsp ::\n:: Created by Satish Rajdev | "
          (MENUCMD "M=$(edtime,$(getvar,date),DDDD\",\" D MONTH YYYY)") " ::\n:: Type \"ADIM\" to Invoke ::"))
(SETQ MSM:ACAD  (VLAX-GET-ACAD-OBJECT) MSM:ACDOC (VLA-GET-ACTIVEDOCUMENT MSM:ACAD) MSM:MODEL (VLA-GET-MODELSPACE MSM:ACDOC))
(DEFUN MSM:STARTUNDOMARK ()(MSM:ENDUNDOMARK)(VLA-STARTUNDOMARK MSM:ACDOC))
(DEFUN MSM:ENDUNDOMARK () (VLA-ENDUNDOMARK MSM:ACDOC))
(DEFUN MSM:LINE (LAYER COLOR STARTPOINT ENDPOINT)(ENTMAKEX (LIST '(0 . "LINE") '(100 . "AcDbEntity")
  (CONS 8 LAYER)(CONS 62 COLOR)(CONS 100 "AcDbLine")(CONS 10 STARTPOINT)(CONS 11 ENDPOINT))))
(DEFUN MSM:LAYER  (NAME FLAG COLOR LINETYPE)(ENTMAKE (LIST '(0 . "LAYER")(CONS 100 "AcDbSymbolTableRecord")
  (CONS 100 "AcDbLayerTableRecord")(CONS 2 NAME)(CONS 70 FLAG)(CONS 62 COLOR)(CONS 6 LINETYPE))))
(defun LM:PolyCentroid  (e / l)
  (foreach x  (setq e (entget e))(if (= 10 (car x))(setq l (cons (cdr x) l))))
  ((lambda (a)
     (if (not (equal 0.0 a 1e-8))
       (trans (mapcar '/ (apply 'mapcar (cons '+ (mapcar (function (lambda (a b)((lambda (m)(mapcar (function (lambda (c d) (* (+ c d) m)))
          a b))(- (* (car a) (cadr b))(* (car b) (cadr a)))))) l (cons (last l) l))))(list a a)) (cdr (assoc 210 e)) 0)))
    (* 3.0 (apply '+ (mapcar (function (lambda (a b) (- (* (car a) (cadr b)) (* (car b) (cadr a))))) l (cons (last l) l))))))
(PRINC)

 

Share this post


Link to post
Share on other sites
dlanorh

Beaten to it :P :beer: 

(defun c:ADIM (/       *error* mid     add:dim calc:p  calc:ang
           add:arc add:raddim      s       l       p       ol
           fl      cm      os      cen     ss      cnt
          )
  (MSM:STARTUNDOMARK)
  (defun *error* (msg)
    (if    os
      (setvar 'osmode os)
    )
    (if    cm
      (setvar 'cmdecho cm)
    )
    (MSM:ENDUNDOMARK)
    (if    (not
      (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*erased")
    )
      (princ "\nStatus = Function Cancelled")
    )
    (princ)
  )
  (defun mid (p1 p2)
    (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
  )
  (defun add:dim (p1 p2 p3 / e d)
    (setq e (entlast))
    (command "DIMALIGNED" p1 p2 p3)
    (if    (and (setq d (entlast))
         (/= e d)
         (setq d (vlax-ename->vla-object d))
         (wcmatch (vla-get-objectname d) "*Dimension")
    )
      (progn
    (vla-put-layer d "AUTO DIM")
    (if (tblsearch "dimstyle" "Standard")
      (vla-put-stylename d "DIM")
    )
      )
    )
  )
  (defun calc:p    (p1 p2 b / a c r)
    (setq a (* 2 (atan b))
      r (/ (distance p1 p2) 2 (sin a))
      c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r)
    )
    (if    (minusp b)
      (list c (angle c p2) (angle c p1) (abs r))
      (list c (angle c p1) (angle c p2) (abs r))
    )
  )
  (defun calc:ang (pnt / an)
    (if    (setq an (angle cen pnt))
      (cond ((<= (* pi 0.25) an (* pi 0.75)) (* pi 0.5))
        ((<= (* pi 0.75) an (* pi 1.25)) pi)
        ((<= (* pi 1.25) an (* pi 1.75)) (* pi 1.5))
        ((<= (* pi 1.75) an (* pi 2.0)) 0.0)
        ((<= 0.0 an (* pi 0.25)) 0.0)
      )
    )
  )
  (defun add:arc (p1 p2 b)
    (entmakex
      (cons '(0 . "ARC")
        (mapcar 'cons
            '(10 50 51 40)
            (calc:p p1 p2 b)
        )
      )
    )
  )
  (defun add:raddim (p1 p2 b / e d arc p3)
    (if    (setq arc (add:arc p1 p2 b))
      (progn
    (setq e (entlast))
    (setq arc (vlax-ename->vla-object arc))
    (setq p3
           (vlax-curve-getpointatdist e (/ (vla-get-arclength arc) 2.))
    )
    (command "DIMRADIUS"
         (list (vlax-vla-object->ename arc) p3)
         (vlax-get arc 'center)
    )
    (setq d (entlast))
    (if (and (/= e d)
         (setq d (vlax-ename->vla-object d))
         (wcmatch (vla-get-objectname d) "*Dimension")
        )
      (progn
        (vla-put-layer d "AUTO DIM")
        (if    (tblsearch "dimstyle" "Standard")
          (vla-put-stylename d "DIM")
        )
        (vla-put-arrowheadtype d 0)
        (vla-put-arrowheadsize d 1.7)
      )
    )
    (vla-delete arc)
    d
      )
    )
  )
  (prompt "\nSelect Polylines : ")
  (setq ss (ssget '((0 . "*POLYLINE"))))
  
  (cond
    (ss
      (setq cm (getvar 'cmdecho)
            os (getvar 'osmode)
      )
      (setvar 'cmdecho 0)
      (setvar 'osmode 0)
      (if (not (tblsearch "LAYER" "AUTO DIM"))
        (MSM:LAYER "AUTO DIM" 0 7 "Continuous")
      )
      (repeat (setq cnt (sslength ss))
        (setq s (ssname ss (setq cnt (1- cnt)))
              cen (LM:PolyCentroid s)
              s (entget s)
              l (vl-remove-if-not '(lambda (x) (member (car x) '(10 42))) s)
        )
        (if (eq (cdr (assoc 70 s)) 1)
          (setq l (reverse (cons (cons 42 0.0) (cons (car l) (reverse l)))))
        )
        (setq s (vlax-ename->vla-object (cdr (assoc -1 s))))
        (setq p (vl-remove nil
          (mapcar
            '(lambda (x y z)
              (if (eq (car x) 10)
                (list x y z)
              )
            )
            l
            (cdr l)
            (cddr l)
          )
         )
        )
        (setq ol
          (mapcar '
            (lambda (x)
              (if (zerop (cdr (cadr x)))
                (MSM:LINE (vla-get-layer s)
                  (vla-get-color s)
                  (cdr (car x))
                  (cdr (caddr x))
                )
                (progn
                  (add:raddim
                    (cdr (car x))
                    (cdr (caddr x))
                    (cdr (cadr x))
                  )
                  "F"
                )
              )
            )
            p
          )
        )
        (if (member "F" ol)
          (progn
            (setq fl  (mapcar '(lambda (x y z) (if (eq y "F") (list x y z))) ol
                        (reverse (cons (car ol) (reverse (cdr ol))))
                        (reverse (cons (cadr ol) (cons (car ol) (reverse (cddr ol)))))
                      )
            )
            (foreach x fl
              (command "chamfer" (car x) (caddr x))
            )
          )
        )
        (mapcar
          '(lambda (x / x1 x2 xa xp)
            (if (and  (/= (type x) 'STR)
                      (setq x1 (cdr (assoc 10 (entget x))))
                      (setq x2 (cdr (assoc 11 (entget x))))
                      (> (distance x1 x2) 20.)
                )
              (progn
                (setq xa (angle x1 x2))
                (setq xp (mid x1 x2))
                (setq xp (polar xp (calc:ang xp) 3.7))
                (add:dim x1 x2 xp)
              )
            )
          )
          ol
        )
        (vla-delete s)
      )
      (setvar 'osmode os)
      (setvar 'cmdecho cm)
    )
  )
  (MSM:ENDUNDOMARK)
  (princ)
)

(VL-LOAD-COM)
(PRINC)
(PRINC
  (STRCAT
    "\n:: Add Dimensions_V1.lsp ::"
    "\n:: Created by Satish Rajdev | "
    (MENUCMD "M=$(edtime,$(getvar,date),DDDD\",\" D MONTH YYYY)"
    )
    " ::"
    "\n:: Type \"ADIM\" to Invoke ::"
  )
)
(SETQ MSM:ACAD    (VLAX-GET-ACAD-OBJECT)
      MSM:ACDOC    (VLA-GET-ACTIVEDOCUMENT MSM:ACAD)
      MSM:MODEL    (VLA-GET-MODELSPACE MSM:ACDOC)
)
(DEFUN MSM:STARTUNDOMARK ()
  (MSM:ENDUNDOMARK)
  (VLA-STARTUNDOMARK MSM:ACDOC)
)
(DEFUN MSM:ENDUNDOMARK ()
  (VLA-ENDUNDOMARK MSM:ACDOC)
)
(DEFUN MSM:LINE    (LAYER COLOR STARTPOINT ENDPOINT)
  (ENTMAKEX (LIST '(0 . "LINE")
          '(100 . "AcDbEntity")
          (CONS 8 LAYER)
          (CONS 62 COLOR)
          (CONS 100 "AcDbLine")
          (CONS 10 STARTPOINT)
          (CONS 11 ENDPOINT)
        )
  )
)
(DEFUN MSM:LAYER (NAME FLAG COLOR LINETYPE)
  (ENTMAKE (LIST
         '(0 . "LAYER")
         (CONS 100 "AcDbSymbolTableRecord")
         (CONS 100 "AcDbLayerTableRecord")
         (CONS 2 NAME)
         (CONS 70 FLAG)
         (CONS 62 COLOR)
         (CONS 6 LINETYPE)
       )
  )
)
(defun LM:PolyCentroid (e / l)
  (foreach x (setq e (entget e))
    (if    (= 10 (car x))
      (setq l (cons (cdr x) l))
    )
  )
  (
   (lambda (a)
     (if (not (equal 0.0 a 1e-8))
       (trans
     (mapcar
       '/
       (apply
         'mapcar
         (cons '+
           (mapcar
             (function
               (lambda (a b)
             (
              (lambda (m)
                (mapcar
                  (function
                (lambda (c d) (* (+ c d) m))
                  )
                  a
                  b
                )
              )
               (- (* (car a) (cadr b)) (* (car b) (cadr a)))
             )
               )
             )
             l
             (cons (last l) l)
           )
         )
       )
       (list a a)
     )
     (cdr (assoc 210 e))
     0
       )
     )
   )
    (* 3.0
       (apply '+
          (mapcar
        (function
          (lambda (a b)
            (- (* (car a) (cadr b)) (* (car b) (cadr a)))
          )
        )
        l
        (cons (last l) l)
          )
       )
    )
  )
)
(PRINC)

 

Share this post


Link to post
Share on other sites
rlx
1 minute ago, dlanorh said:

Beaten to it :P :beer: 

 

 

haha , fortunately its not a contest , just helping others to find freeware 🤣

Share this post


Link to post
Share on other sites
marko_ribar

To both :

Probably you wanted to code :

(setq ss (ssget '((0 . "LWPOLYLINE"))))

 

For "*POLYLINE" CAD will look and for heavy and for 3d polylines, and in both cases it will fail - only with LWPOLYLINEs I suppose should be well and correct...

Share this post


Link to post
Share on other sites
rlx
Posted (edited)
59 minutes ago, marko_ribar said:

To both :

Probably you wanted to code :

(setq ss (ssget '((0 . "LWPOLYLINE"))))

 

For "*POLYLINE" CAD will look and for heavy and for 3d polylines, and in both cases it will fail - only with LWPOLYLINEs I suppose should be well and correct...

 

not really ... but then I never / rarely use heavy or 3d poly's  😁 so good to know 🤓

 

thanx marko :beer:

Edited by rlx

Share this post


Link to post
Share on other sites
BIGAL
Posted (edited)

rlx if you do a get coordinates it will return X Y X Y for 2D and X Y Z X Y Z for 3D polys, if your making lists will screw up. do a loop 2 or loop 3.

Edited by BIGAL

Share this post


Link to post
Share on other sites
rlx
4 hours ago, BIGAL said:

rlx if you do a get coordinates it will return X Y X Y for 2D and X Y Z X Y Z for 3D polys, if your making lists will screw up. do a loop 2 or loop 3.

 

Good to know Bigal :thumbsup:

Share this post


Link to post
Share on other sites
jvelasco

thank you for your help. I didnt realized you guys responded, I was waiting for a notification in my mail.

I really apreciate it!!  :)

Share this post


Link to post
Share on other sites
Cad64
12 minutes ago, jvelasco said:

I didnt realized you guys responded, I was waiting for a notification in my mail.

 

Go to your Account Settings and check your Notification Settings.

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...