+ Reply to Thread
Page 1 of 2 1 2 LastLast
Results 1 to 10 of 18
  1. #1
    Senior Member
    Using
    AutoCAD 2015
    Join Date
    Jan 2015
    Posts
    151

    Default Quote external circles

    Registered forum members do not see this ad.

    Hello guys,

    I work for a society that makes voided slabs. Circles represent voids in the slab.
    I was looking for a fast way to quote these circles.

    Currently I have a lisp that convert poly-lines to quotes.

    Code:
    (defun quote_multiple ( / oldsnap oldlayer punto_ins_A punto_ins_B indice n_punti ent coordinate *error* ss sel)
    (defun *error* ( msg )
            (princ (strcat "\nLa funzione è stata annullata"))
            (setvar 'osmode oldsnap)
            (_SetClayer oldlayer)
            (princ)
        )
    
        ;imposto variabili ambiente
    ;(setvar 'lunits 2)
      ;(setvar 'luprec 2)
      ;(setvar 'insunits 6)
    
      (setq oldlayer (getvar 'clayer))
      (_CreateLayer (dcl-Control-GetText Cobiax/Main/quota_layer) 5 "Continuous" -3 1)
      (_SetClayer (dcl-Control-GetText Cobiax/Main/quota_layer))
      (setq oldsnap (getvar 'osmode))
      (setvar 'osmode 0)
    
      (while (= 1 1)
      (setq indice 0)
      ;(_SetDimStyleCurrent "Centro Pil")
      (prompt "\nSeleziona una polilinea")
        
        (while (= nil (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE,POLYLINE")))))
      
      ;(setq ent (vlax-ename->vla-object (car (entsel))))
          )
        
        (setq ent (vlax-ename->vla-object (ssname ss 0)))
    
      (setq coordinate (vlax-safearray->list (vlax-variant-value (vlax-get-property ent 'Coordinates))))
      (vlax-invoke-method ent 'delete)
      (setq n_punti (/ (length coordinate) 2))
    
      (while (/= (1- indice) n_punti)
       
      (setq punto_ins_A (list (nth (* 2 indice) coordinate) (nth (+ (* 2 indice) 1) coordinate)))
        
        (IF (= (1+ indice) n_punti)
        
          (setq punto_ins_B (list (nth 0 coordinate) (nth 1 coordinate)))
          (setq punto_ins_B (list (nth (* 2 (1+ indice)) coordinate) (nth (+ (* 2 (1+ indice)) 1) coordinate)))
          
          )
    
      (command "_.DIMLINEAR" punto_ins_A punto_ins_B punto_ins_A)
        ;(command "_DIMALIGNED" punto_ins_A punto_ins_B punto_ins_A)
      (setq indice (1+ indice))
      )
        )
    ;;;  (_SetClayer oldlayer)
    ;;;  (setvar 'osmode oldsnap)
      )
    and this is his behavior:



    As you can see I'm interested only about the boundary quotes.

    Any idea about how to perform that task without the the polyline? Maybe by selecting all the circles the lisp is able to understand if it's internal or at boundary.

    This is an example: Test.dwg

    Thanks for the help,

    Dennis
    Attached Images

  2. #2
    Super Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2014
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    1,290

    Default

    On your posted DWG - test, this will work on simple case like in your gif, but on your bigger example in DWG it won't... So, better something than nothing, maybe it'll work on some other simple examples similar to animated gif...

    Code:
    (defun c:dimouterboundcircles ( / unique adoc dim spc s i ci p pl d plbound plboundd plround plr a plroundd pp aa plroundorth plroundorthrem )
    
      (vl-load-com)
    
      (defun unique ( l )
        (if l (cons (car l) (unique (vl-remove-if (function (lambda ( x ) (equal x (car l) 2.5e-2))) l))))
      )
    
      (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
      (if (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark adoc)
      )
      (vla-startundomark adoc)
      (setq dim (vla-get-activedimstyle adoc))
      (vla-copyfrom dim adoc)
      (setq spc (vla-get-block (vla-get-activelayout adoc)))
      (prompt "\nSelect CIRCLES...")
      (setq s (ssget '((0 . "CIRCLE"))))
      (if s
        (progn
          (repeat (setq i (sslength s))
            (setq ci (ssname s (setq i (1- i))))
            (setq p (cdr (assoc 10 (entget ci))))
            (setq pl (cons p pl))
          )
          (setq pl (mapcar (function (lambda ( p ) (trans p 0 1))) pl))
          (setq pl (vl-sort pl (function (lambda ( a b ) (if (equal (car a) (car b) 2.5e-2) (< (cadr a) (cadr b)) (< (car a) (car b)))))))
          (setq p (car pl))
          (setq d (distance p (cadr (vl-sort pl (function (lambda ( a b ) (< (distance a p) (distance b p))))))))
          (foreach p pl
            (if
              (not
                (and
                  (vl-some (function (lambda ( x ) (equal x (mapcar '+ p (list d 0 0)) 2.5e-2))) pl)
                  (vl-some (function (lambda ( x ) (equal x (mapcar '+ p (list (- d) 0 0)) 2.5e-2))) pl)
                  (vl-some (function (lambda ( x ) (equal x (mapcar '+ p (list 0 d 0)) 2.5e-2))) pl)
                  (vl-some (function (lambda ( x ) (equal x (mapcar '+ p (list 0 (- d) 0)) 2.5e-2))) pl)
                )
              )
              (setq plbound (cons p plbound))
            )
          )
          (while plbound
            (setq plbound (vl-sort plbound (function (lambda ( a b ) (if (equal (car a) (car b) 2.5e-2) (< (cadr a) (cadr b)) (< (car a) (car b)))))))
            (setq plbound (reverse (cons (car plbound) (reverse plbound))))
            (while (and (setq p (car plbound)) (not (equal p (last plround) 2.5e-2)))
              (if plround
                (setq aa (angle (car plround) p))
              )
              (if (and aa (equal aa (* 2 pi) 2.5e-2))
                (setq aa 0.0)
              )
              (setq plbound (cdr plbound))
              (setq plbound (vl-sort plbound (function (lambda ( a b ) (< (distance a p) (distance b p))))))
              (if (or (equal p (car plbound) 2.5e-2) (equal (car plbound) (car plround) 2.5e-2))
                (setq plbound (cdr (reverse (cons (car plbound) (reverse plbound)))))
              )
              (setq plboundd (vl-remove-if-not (function (lambda ( x ) (equal (distance p x) d 2.5e-2))) (vl-remove-if (function (lambda ( x ) (vl-some (function (lambda ( y ) (equal x y 2.5e-2))) plround))) plbound)))
              (setq plboundd (vl-sort plboundd (function (lambda ( a b ) (if (or (equal (angle p a) aa 2.5e-2) (and (equal (angle p a) (* 2 pi) 2.5e-2) (= aa 0.0))) t nil)))))
              (if plboundd
                (progn
                  (setq plbound (vl-remove (car plboundd) plbound))
                  (setq plbound (cons (car plboundd) plbound))
                )
              )
              (setq plround (cons p plround))
            )
            (setq plround (cons (car plbound) plround))
            (setq plbound (cdr plbound))
            (setq plround (reverse plround))
            (setq plr pl)
            (foreach p plround
              (setq plr (vl-remove p plr))
            )
            (while (setq p (car plround))
              (setq a (if (cadr plround) (angle p (cadr plround))))
              (if
                (not
                  (or
                    (equal a 0.0 2.5e-2)
                    (equal a (* 0.5 pi) 2.5e-2)
                    (equal a pi 2.5e-2)
                    (equal a (* 1.5 pi) 2.5e-2)
                    (equal a (* 2 pi) 2.5e-2)
                  )
                )
                (progn
                  (setq plroundorth (cons p plroundorth))
                  (setq plround (cdr plround))
                  (if plround
                    (progn
                      (setq plroundd (vl-sort plr (function (lambda ( a b ) (< (distance a (car plround)) (distance b (car plround)))))))
                      (setq plroundd (vl-remove-if-not (function (lambda ( x ) (equal (distance x (car plround)) d 2.5e-2))) plroundd))
                      (foreach pp plroundd
                        (setq a (angle p pp))
                        (if
                          (or
                            (equal a 0.0 2.5e-2)
                            (equal a (* 0.5 pi) 2.5e-2)
                            (equal a pi 2.5e-2)
                            (equal a (* 1.5 pi) 2.5e-2)
                            (equal a (* 2 pi) 2.5e-2)
                          )
                          (setq plround (cons pp plround))
                        )
                      )
                    )
                  )
                  (cond
                    ( (and (null a) plround)
                      (setq plroundorth (cons (car plround) plroundorth))
                      (setq plround nil)
                    )
                    ( (and (null a) (null plround))
                      (if (not (equal (distance (car plroundorth) (last plroundorth)) d 2.5e-2))
                        (progn
                          (setq plroundd (vl-sort plr (function (lambda ( a b ) (< (distance a (car plroundorth)) (distance b (car plroundorth)))))))
                          (setq plroundd (vl-remove-if-not (function (lambda ( x ) (equal (distance x (car plroundorth)) d 2.5e-2))) plroundd))
                          (foreach pp plroundd
                            (setq a (angle p pp))
                            (if
                              (or
                                (equal a 0.0 2.5e-2)
                                (equal a (* 0.5 pi) 2.5e-2)
                                (equal a pi 2.5e-2)
                                (equal a (* 1.5 pi) 2.5e-2)
                                (equal a (* 2 pi) 2.5e-2)
                              )
                              (setq plroundorth (cons pp plroundorth))
                            )
                          )
                        )
                      )
                    )
                  )
                )
                (progn
                  (setq plround (cdr plround))
                  (while (and plround (if (or (equal a 0.0 2.5e-2) (equal a (* 2 pi) 2.5e-2)) (or (equal 0.0 (angle p (car plround)) 2.5e-2) (equal (* 2 pi) (angle p (car plround)) 2.5e-2)) (equal a (angle p (car plround)) 2.5e-2)))
                    (setq pp (car plround))
                    (setq plround (cdr plround))
                  )
                  (if (or (equal a (angle p pp) 2.5e-2) (and (equal a 0.0 2.5e-2) (equal (angle p pp) (* 2 pi) 2.5e-2)) (and (equal a (* 2 pi) 2.5e-2) (equal (angle p pp) 0.0 2.5e-2)))
                    (progn
                      (if (not (vl-position p plroundorth))
                        (setq plroundorth (cons p plroundorth))
                      )
                      (setq plroundd (vl-sort plr (function (lambda ( a b ) (< (distance a pp) (distance b pp))))))
                      (setq plroundd (vl-remove-if-not (function (lambda ( x ) (equal (distance x pp) d 2.5e-2))) plroundd))
                      (foreach ppp plroundd
                        (setq aa (angle p ppp))
                        (if (and (not (equal p ppp 2.5e-2)) (not (equal pp ppp 2.5e-2)) (or (equal a aa 2.5e-2) (and (equal aa 0.0 2.5e-2) (equal a (* 2 pi) 2.5e-2)) (and (equal aa (* 2 pi) 2.5e-2) (equal a 0.0 2.5e-2))))
                          (setq plround (cons ppp plround) tst t)
                        )
                      )
                      (if (and plround (null tst))
                        (setq plround (cons pp plround))
                      )
                      (if (null plround)
                        (if (and (not (equal (angle (car plroundorth) pp) (angle (car plroundorth) (last plroundorth)) 2.5e-2)) (not (or (and (equal (angle (car plroundorth) pp) 0.0 2.5e-2) (equal (angle (car plroundorth) (last plroundorth)) (* 2 pi) 2.5e-2)) (and (equal (angle (car plroundorth) pp) (* 2 pi) 2.5e-2) (equal (angle (car plroundorth) (last plroundorth)) 0.0 2.5e-2)))) (not (vl-position pp plroundorth)))
                          (setq plround (cons pp plround))
                        )
                      )
                      (setq tst nil)
                    )
                    (progn
                      (setq plroundd (vl-sort plr (function (lambda ( a b ) (< (distance a pp) (distance b pp))))))
                      (setq plroundd (vl-remove-if-not (function (lambda ( x ) (equal (distance x pp) d 2.5e-2))) plroundd))
                      (foreach ppp plroundd
                        (setq aa (angle p ppp))
                        (if
                          (or
                            (equal aa 0.0 2.5e-2)
                            (equal aa (* 0.5 pi) 2.5e-2)
                            (equal aa pi 2.5e-2)
                            (equal aa (* 1.5 pi) 2.5e-2)
                            (equal aa (* 2 pi) 2.5e-2)
                          )
                          (setq plround (cons ppp plround))
                        )
                      )
                    )
                  )
                )
              )
            )
            (setq plroundorth (reverse plroundorth))
            (setq plroundorth (mapcar (function (lambda ( p ) (trans p 1 0))) plroundorth))
            (setq plroundorth (unique plroundorth))
            (setq plroundorthrem (vl-remove nil (mapcar (function (lambda ( a b c ) (if (equal (distance a c) (+ (distance a b) (distance b c)) 2.5e-2) b))) plroundorth (cdr (reverse (cons (car plroundorth) (reverse plroundorth)))) (cddr (reverse (cons (cadr plroundorth) (cons (car plroundorth) (reverse plroundorth))))))))
            (foreach p plroundorthrem
              (setq plroundorth (vl-remove p plroundorth))
            )
            (mapcar (function (lambda ( a b ) (vla-adddimaligned spc (vlax-3d-point a) (vlax-3d-point b) (vlax-3d-point (mapcar '/ (mapcar '+ a b) (list 2.0 2.0 2.0)))))) plroundorth (cdr (reverse (cons (car plroundorth) (reverse plroundorth)))))
            (setq plround nil plroundorth nil)
          )
        )
      )
      (vla-endundomark adoc)
      (princ)
    )
    HTH., M.R.
    Last edited by marko_ribar; 10th Jul 2018 at 11:13 pm. Reason: code finally changed...

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  3. #3
    Quantum Mechanic BIGAL's Avatar
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    10,707

    Default

    Just pondering an alternative method, select all circles, then do a ssget cp that is 2xRad of each circle, if the selection set is less than 8 then its an outside circle. Should work on test dwg as it has single row circles which stick out as well as connected together more grid like.

    Code removed as not quite what was required.
    Last edited by BIGAL; 4th Apr 2017 at 11:33 pm.
    A man who never made mistakes never made anything

  4. #4
    Super Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2014
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    1,290

    Default

    My posted code should now work with this attached DWG...
    Attached Files

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  5. #5
    Senior Member
    Using
    AutoCAD 2015
    Join Date
    Jan 2015
    Posts
    151

    Default

    Hello guys! Thank for your help, there is a lot to learn from your code!

    I've tested both of them in another DWG (later I'll try to understand each line of the code).

    test.dwg

    Code from Marko:

    works with a little strange error in the left corner.. If you select too much objects (118 in my case) autocad enters in a loop



    Code from Bigal has a strange behaviour..

    Code:
    (setq ss (ssget (list (cons 0 "Circle"))))
    (setvar "osmode" 0)
    (setq tot 0)
    (repeat (setq x (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname SS (setq x (- x 1)))))
    (setq cenpt (vlax-safearray->list (vlax-variant-value (vla-get-center obj))))
    (setq rad (* 3.2 (vla-get-radius obj)))
    (setq pt1 (polar cenpt (/ pi 4.0) rad))
    (setq pt2 (polar cenpt (* pi 1.5) rad))
    (command "_.line" pt1 pt2 "") ; for testing
    (setq ss2 (ssget "_w" pt1 pt2))
    (if (and (/= ss2 nil)(< (sslength ss2) 8))
    (setq tot (+ Tot 1)) ; this is external circles
    )
    (princ (strcat "\n" (rtos tot 2 0)))
    (setq ss2 nil)
    )

  6. #6
    Senior Member
    Using
    AutoCAD 2015
    Join Date
    Jan 2015
    Posts
    151

    Default

    Quote Originally Posted by marko_ribar View Post
    My posted code should now work with this attached DWG...
    Hello Marko! Nice to see you again

    yup the code as improved, has the little problem of the last point as in the gif I've posted (but only one error and not 2).. Try it on my last dwg... thanks for your help!

    EDIT: look at his behavior.. (I've deleted a lot of frames because it takes too long)


  7. #7
    Super Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2014
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    1,290

    Default

    Posted code finally updated... You can't select multiple groups of circles, just single group by group...

    Regards, M.R.

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  8. #8
    Senior Member
    Using
    AutoCAD 2015
    Join Date
    Jan 2015
    Posts
    151

    Default

    Quote Originally Posted by marko_ribar View Post
    Posted code finally updated... You can't select multiple groups of circles, just single group by group...

    Regards, M.R.
    Thanks Marko, very cool code! I'll start to study it right now!

    A little question.. do you think it's impossible to consider even the holes in the middle? (or ignore so I add them as in the gif)


  9. #9
    Super Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2014
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    1,290

    Default

    One selection by one... For now avoid it or do it like in your gif... You can select entire group with inner islands...


    [EDIT : Now added code for different grid dx and dy... I converted DWG with circles to block, changed Y scale factor and exploded block; result was ellipses instead of circles... Then I tested the code I'll post here...]


    Code:
    (defun c:dimouterboundellipses ( / unique adoc dim spc s i el p pp pl dx dy plbound plboundd plbounddd plround plr a plroundd aa plroundorth plroundorthrem )
    
      (vl-load-com)
    
      (defun unique ( l )
        (if l (cons (car l) (unique (vl-remove-if (function (lambda ( x ) (equal x (car l) 2.5e-2))) l))))
      )
    
      (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
      (if (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark adoc)
      )
      (vla-startundomark adoc)
      (setq dim (vla-get-activedimstyle adoc))
      (vla-copyfrom dim adoc)
      (setq spc (vla-get-block (vla-get-activelayout adoc)))
      (prompt "\nSelect ELLIPSES...")
      (setq s (ssget '((0 . "ELLIPSE"))))
      (if s
        (progn
          (repeat (setq i (sslength s))
            (setq el (ssname s (setq i (1- i))))
            (setq p (cdr (assoc 10 (entget el))))
            (setq pl (cons p pl))
          )
          (setq pl (mapcar (function (lambda ( p ) (trans p 0 1))) pl))
          (setq pl (vl-sort pl (function (lambda ( a b ) (if (equal (car a) (car b) 2.5e-2) (< (cadr a) (cadr b)) (< (car a) (car b)))))))
          (setq p (car pl))
          (setq dx (distance p (list (car (car (vl-sort (vl-remove-if (function (lambda ( x ) (equal (car x) (car p) 2.5e-2))) pl) (function (lambda ( a b ) (< (car a) (car b))))))) (cadr p) (caddr p))))
          (setq dy (distance (setq pp (car (vl-sort pl (function (lambda ( a b ) (< (cadr a) (cadr b))))))) (list (car pp) (cadr (car (vl-sort (vl-remove-if (function (lambda ( x ) (equal (cadr x) (cadr pp) 2.5e-2))) pl) (function (lambda ( a b ) (< (cadr a) (cadr b))))))) (caddr pp))))
          (foreach p pl
            (if
              (not
                (and
                  (vl-some (function (lambda ( x ) (equal x (mapcar '+ p (list dx 0 0)) 2.5e-2))) pl)
                  (vl-some (function (lambda ( x ) (equal x (mapcar '+ p (list (- dx) 0 0)) 2.5e-2))) pl)
                  (vl-some (function (lambda ( x ) (equal x (mapcar '+ p (list 0 dy 0)) 2.5e-2))) pl)
                  (vl-some (function (lambda ( x ) (equal x (mapcar '+ p (list 0 (- dy) 0)) 2.5e-2))) pl)
                )
              )
              (setq plbound (cons p plbound))
            )
          )
          (while plbound
            (setq plbound (vl-sort plbound (function (lambda ( a b ) (if (equal (car a) (car b) 2.5e-2) (< (cadr a) (cadr b)) (< (car a) (car b)))))))
            (setq plbound (reverse (cons (car plbound) (reverse plbound))))
            (while (and (setq p (car plbound)) (not (equal p (last plround) 2.5e-2)))
              (if plround
                (setq aa (angle (car plround) p))
              )
              (if (and aa (equal aa (* 2 pi) 2.5e-2))
                (setq aa 0.0)
              )
              (setq plbound (cdr plbound))
              (setq plbound (vl-sort plbound (function (lambda ( a b ) (< (distance a p) (distance b p))))))
              (if (or (equal p (car plbound) 2.5e-2) (equal (car plbound) (car plround) 2.5e-2))
                (setq plbound (cdr (reverse (cons (car plbound) (reverse plbound)))))
              )
              (setq plboundd (vl-remove-if-not (function (lambda ( x ) (or (equal (polar p 0.0 dx) x 2.5e-2) (equal (polar p pi dx) x 2.5e-2) (equal (polar p (* 0.5 pi) dy) x 2.5e-2) (equal (polar p (* 1.5 pi) dy) x 2.5e-2)))) (vl-remove-if (function (lambda ( x ) (vl-some (function (lambda ( y ) (equal x y 2.5e-2))) plround))) plbound)))
              (setq plboundd (vl-sort plboundd (function (lambda ( a b ) (if (or (equal (angle p a) aa 2.5e-2) (and (equal (angle p a) (* 2 pi) 2.5e-2) (= aa 0.0))) t nil)))))
              (setq plbounddd (vl-remove-if-not (function (lambda ( x ) (or (equal (polar (polar p 0.0 dx) (* 0.5 pi) dy) x 2.5e-2) (equal (polar (polar p 0.0 dx) (* 1.5 pi) dy) x 2.5e-2) (equal (polar (polar p pi dx) (* 0.5 pi) dy) x 2.5e-2) (equal (polar (polar p pi dx) (* 1.5 pi) dy) x 2.5e-2)))) (vl-remove-if (function (lambda ( x ) (vl-some (function (lambda ( y ) (equal x y 2.5e-2))) plround))) plbound)))
              (setq plbounddd (vl-sort plbounddd (function (lambda ( a b ) (if (not (equal (angle p a) aa 2.5e-2)) t nil)))))
              (if plboundd
                (progn
                  (setq plbound (vl-remove (car plboundd) plbound))
                  (setq plbound (cons (car plboundd) plbound))
                )
                (if plbounddd
                  (progn
                    (setq plbound (vl-remove (car plbounddd) plbound))
                    (setq plbound (cons (car plbounddd) plbound))
                  )
                )
              )
              (setq plbounddd nil)
              (setq plround (cons p plround))
            )
            (setq plround (cons (car plbound) plround))
            (setq plbound (cdr plbound))
            (setq plround (reverse plround))
            (setq plr pl)
            (foreach p plround
              (setq plr (vl-remove p plr))
            )
            (while (setq p (car plround))
              (setq a (if (cadr plround) (angle p (cadr plround))))
              (if
                (not
                  (or
                    (equal a 0.0 2.5e-2)
                    (equal a (* 0.5 pi) 2.5e-2)
                    (equal a pi 2.5e-2)
                    (equal a (* 1.5 pi) 2.5e-2)
                    (equal a (* 2 pi) 2.5e-2)
                  )
                )
                (progn
                  (setq plroundorth (cons p plroundorth))
                  (setq plround (cdr plround))
                  (if plround
                    (progn
                      (setq plroundd (vl-sort plr (function (lambda ( a b ) (< (distance a (car plround)) (distance b (car plround)))))))
                      (setq plroundd (vl-remove-if-not (function (lambda ( x ) (or (equal (polar (car plround) 0.0 dx) x 2.5e-2) (equal (polar (car plround) pi dx) x 2.5e-2) (equal (polar (car plround) (* 0.5 pi) dy) x 2.5e-2) (equal (polar (car plround) (* 1.5 pi) dy) x 2.5e-2)))) plroundd))
                      (foreach pp plroundd
                        (setq a (angle p pp))
                        (if
                          (or
                            (equal a 0.0 2.5e-2)
                            (equal a (* 0.5 pi) 2.5e-2)
                            (equal a pi 2.5e-2)
                            (equal a (* 1.5 pi) 2.5e-2)
                            (equal a (* 2 pi) 2.5e-2)
                          )
                          (setq plround (cons pp plround))
                        )
                      )
                    )
                  )
                  (cond
                    ( (and (null a) plround)
                      (setq plroundorth (cons (car plround) plroundorth))
                      (setq plround nil)
                    )
                    ( (and (null a) (null plround))
                      (if (not (equal (distance (car plroundorth) (last plroundorth)) d 2.5e-2))
                        (progn
                          (setq plroundd (vl-sort plr (function (lambda ( a b ) (< (distance a (car plroundorth)) (distance b (car plroundorth)))))))
                          (setq plroundd (vl-remove-if-not (function (lambda ( x ) (or (equal (polar (car plroundorth) 0.0 dx) x 2.5e-2) (equal (polar (car plroundorth) pi dx) x 2.5e-2) (equal (polar (car plroundorth) (* 0.5 pi) dy) x 2.5e-2) (equal (polar (car plroundorth) (* 1.5 pi) dy) x 2.5e-2)))) plroundd))
                          (foreach pp plroundd
                            (setq a (angle p pp))
                            (if
                              (or
                                (equal a 0.0 2.5e-2)
                                (equal a (* 0.5 pi) 2.5e-2)
                                (equal a pi 2.5e-2)
                                (equal a (* 1.5 pi) 2.5e-2)
                                (equal a (* 2 pi) 2.5e-2)
                              )
                              (setq plroundorth (cons pp plroundorth))
                            )
                          )
                        )
                      )
                    )
                  )
                )
                (progn
                  (setq plround (cdr plround))
                  (while (and plround (if (or (equal a 0.0 2.5e-2) (equal a (* 2 pi) 2.5e-2)) (or (equal 0.0 (angle p (car plround)) 2.5e-2) (equal (* 2 pi) (angle p (car plround)) 2.5e-2)) (equal a (angle p (car plround)) 2.5e-2)))
                    (setq pp (car plround))
                    (setq plround (cdr plround))
                  )
                  (if (or (equal a (angle p pp) 2.5e-2) (and (equal a 0.0 2.5e-2) (equal (angle p pp) (* 2 pi) 2.5e-2)) (and (equal a (* 2 pi) 2.5e-2) (equal (angle p pp) 0.0 2.5e-2)))
                    (progn
                      (if (not (vl-position p plroundorth))
                        (setq plroundorth (cons p plroundorth))
                      )
                      (setq plroundd (vl-sort plr (function (lambda ( a b ) (< (distance a pp) (distance b pp))))))
                      (setq plroundd (vl-remove-if-not (function (lambda ( x ) (or (equal (polar pp 0.0 dx) x 2.5e-2) (equal (polar pp pi dx) x 2.5e-2) (equal (polar pp (* 0.5 pi) dy) x 2.5e-2) (equal (polar pp (* 1.5 pi) dy) x 2.5e-2)))) plroundd))
                      (foreach ppp plroundd
                        (setq aa (angle p ppp))
                        (if (and (not (equal p ppp 2.5e-2)) (not (equal pp ppp 2.5e-2)) (or (equal a aa 2.5e-2) (and (equal aa 0.0 2.5e-2) (equal a (* 2 pi) 2.5e-2)) (and (equal aa (* 2 pi) 2.5e-2) (equal a 0.0 2.5e-2))))
                          (setq plround (cons ppp plround) tst t)
                        )
                      )
                      (if (and plround (null tst))
                        (setq plround (cons pp plround))
                      )
                      (if (null plround)
                        (if (and (not (equal (angle (car plroundorth) pp) (angle (car plroundorth) (last plroundorth)) 2.5e-2)) (not (or (and (equal (angle (car plroundorth) pp) 0.0 2.5e-2) (equal (angle (car plroundorth) (last plroundorth)) (* 2 pi) 2.5e-2)) (and (equal (angle (car plroundorth) pp) (* 2 pi) 2.5e-2) (equal (angle (car plroundorth) (last plroundorth)) 0.0 2.5e-2)))) (not (vl-position pp plroundorth)))
                          (setq plround (cons pp plround))
                        )
                      )
                      (setq tst nil)
                    )
                    (progn
                      (setq plroundd (vl-sort plr (function (lambda ( a b ) (< (distance a pp) (distance b pp))))))
                      (setq plroundd (vl-remove-if-not (function (lambda ( x ) (or (equal (polar pp 0.0 dx) x 2.5e-2) (equal (polar pp pi dx) x 2.5e-2) (equal (polar pp (* 0.5 pi) dy) x 2.5e-2) (equal (polar pp (* 1.5 pi) dy) x 2.5e-2)))) plroundd))
                      (foreach ppp plroundd
                        (setq aa (angle p ppp))
                        (if
                          (or
                            (equal aa 0.0 2.5e-2)
                            (equal aa (* 0.5 pi) 2.5e-2)
                            (equal aa pi 2.5e-2)
                            (equal aa (* 1.5 pi) 2.5e-2)
                            (equal aa (* 2 pi) 2.5e-2)
                          )
                          (setq plround (cons ppp plround))
                        )
                      )
                    )
                  )
                )
              )
            )
            (setq plroundorth (reverse plroundorth))
            (setq plroundorth (mapcar (function (lambda ( p ) (trans p 1 0))) plroundorth))
            (setq plroundorth (unique plroundorth))
            (setq plroundorthrem (vl-remove nil (mapcar (function (lambda ( a b c ) (if (equal (distance a c) (+ (distance a b) (distance b c)) 2.5e-2) b))) plroundorth (cdr (reverse (cons (car plroundorth) (reverse plroundorth)))) (cddr (reverse (cons (cadr plroundorth) (cons (car plroundorth) (reverse plroundorth))))))))
            (foreach p plroundorthrem
              (setq plroundorth (vl-remove p plroundorth))
            )
            (mapcar (function (lambda ( a b ) (vla-adddimaligned spc (vlax-3d-point a) (vlax-3d-point b) (vlax-3d-point (mapcar '/ (mapcar '+ a b) (list 2.0 2.0 2.0)))))) plroundorth (cdr (reverse (cons (car plroundorth) (reverse plroundorth)))))
            (setq plround nil plroundorth nil)
          )
        )
      )
      (vla-endundomark adoc)
      (princ)
    )
    M.R.
    P.S. Now you should be able to select group with empty spaces and in most cases it should dimension both outer boundary and inner boundaries fine if inner spaces aren't to close to outer boundary...
    Last edited by marko_ribar; 10th Jul 2018 at 11:14 pm. Reason: added additional code for grid points with different dx and dy...

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  10. #10
    Senior Member
    Using
    AutoCAD 2015
    Join Date
    Jan 2015
    Posts
    151

    Default

    Registered forum members do not see this ad.

    Thanks Marko, that helps me very much!
    Last edited by MastroLube; 4th Apr 2017 at 03:38 pm.

Similar Threads

  1. What's With QUOTE in the Array
    By Bill Tillman in forum AutoLISP, Visual LISP & DCL
    Replies: 1
    Last Post: 28th Jun 2016, 06:41 pm
  2. Quote request
    By joey_hv in forum AutoCAD Drawing Management & Output
    Replies: 0
    Last Post: 16th Jul 2007, 08:25 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts