Author Topic: self intersecting pt list  (Read 536 times)

0 Members and 1 Guest are viewing this topic.

domenicomaria

  • Bull Frog
  • Posts: 272
self intersecting pt list
« on: June 22, 2021, 04:59:09 PM »
I'm trying to write a routine that checks if a list of points intersects itself
. . .
and it seems to me that it works. . .
. . .
but if I remove that useless NIL from vl-some
IT DOESN'T WORK ANYMORE!

Why ?

Code - Auto/Visual Lisp: [Select]
  1. (defun :ENTMK-LWP-V-LST   (v-list / LWP-OBJ)
  2.    (entmake   (append (list '(0 . "LWPOLYLINE")
  3.                           '(100 . "AcDbEntity")
  4.                           '(100 . "AcDbPolyline")
  5.                           (cons 90 (length v-list))
  6.                     )
  7.                     (mapcar '(lambda (v) (cons 10 v)) v-list)
  8.             )
  9.    )
  10.    (setq lwp-obj (vlax-ename->vla-object (entlast)))
  11.    (if (equal (car v-list) (last v-list) 1e-6)
  12.                 (setq lwp-obj (vlax-ename->vla-object (entlast)))
  13.                 :vlax-true
  14.              )
  15.              (vla-update lwp-obj)
  16.       )
  17.    )
  18.    lwp-obj
  19. )
  20.  
  21.  
  22.  
  23.  
  24. (defun :POINT (x-pt)
  25.    (entmakex (list (cons 0 "POINT")
  26.                    (cons 10 x-pt)
  27.                    (cons 8 (getvar "clayer"))
  28.                    (cons 62 256)
  29.              )
  30.    )
  31.    x-pt
  32. )
  33.  
  34.  
  35.  
  36.  
  37. (defun :PT-LIST-SELF-INTERSECTING (pt-lst / i j kw main-seg p1 p2 p3 p4 r seg-lst x-pt)
  38.    ;   if pt-lst is open, it closes it
  39.    (if (not (equal (car pt-lst) (last pt-lst) 1e-7))
  40.       (setq pt-lst (append pt-lst (list (car pt-lst))))
  41.    )
  42.    (setq seg-lst (mapcar '(lambda (i j) (list i j) ) pt-lst (cdr pt-lst) ) )
  43.    (setq kw t)
  44.    (while kw
  45.       (setq main-seg (car seg-lst) p1 (car main-seg) p2 (cadr main-seg) )
  46.       (vl-some '(lambda (x-seg)
  47.                   (setq p3    (car x-seg)    p4 (cadr x-seg)
  48.                          x-pt   (inters p1 p2 p3 p4 t)
  49.                   )
  50.                   nil   ;   <<<< PAY ATTENTION to this NIL . . .
  51.                         ;   <<<< if I remove it, the routine does not worck ! ! !
  52.                )
  53.                (cdr seg-lst)
  54.       )
  55.  
  56.       (if(and x-pt (vl-member-if '(lambda (x) (equal x-pt x 1e-7) )  (list p1 p2 p3 p4) ) )
  57.          (setq x-pt nil)
  58.       )
  59.       (if x-pt
  60.          (setq kw nil r x-pt)
  61.          (setq seg-lst (cdr seg-lst) )
  62.       )
  63.       (if (= (length seg-lst) 1) (setq kw nil) )
  64.    )
  65.    r
  66. )
  67.  
  68. (defun C:K (/ p0 pt-lst pt-lst-s x x-pt)
  69.    (setq p0 (getpoint "\nfirst point :"))
  70.    (setq pt-lst (cons p0 pt-lst))
  71.    (while (setq x-pt (getpoint (car pt-lst) "\nnext point :"))
  72.       (setq pt-lst (cons x-pt pt-lst))
  73.    )
  74.    (setq pt-lst (reverse pt-lst))
  75.    (:ENTMK-LWP-V-LST pt-lst)
  76.    (if (setq x (:PT-LIST-SELF-INTERSECTING pt-lst))
  77.       (:POINT x)
  78.    )
  79.    x
  80. )
  81.  
  82.  

John Kaul (Se7en)

  • Administrator
  • Needs a day job
  • Posts: 9717
Re: self intersecting pt list
« Reply #1 on: June 22, 2021, 05:34:41 PM »
Guess (meaning: I didn't test your routine): Because VL-SOME will stop evaluating once the predicate function returns a non-nil value.

ref: https://www.theswamp.org/Sources/doc/avlisp/#vl-some
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

domenicomaria

  • Bull Frog
  • Posts: 272
Re: self intersecting pt list
« Reply #2 on: June 22, 2021, 05:43:26 PM »
But i continue to not understand the relation with NIL

John Kaul (Se7en)

  • Administrator
  • Needs a day job
  • Posts: 9717
Re: self intersecting pt list
« Reply #3 on: June 22, 2021, 05:53:12 PM »
As it is now, your predicate function will always return null and thus VL-SOME will continue. If you remove the nil, then your predicate function will return the value from the last statement (setq...) which will not be a null value and stop evaluating.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

domenicomaria

  • Bull Frog
  • Posts: 272
Re: self intersecting pt list
« Reply #4 on: June 23, 2021, 02:30:35 AM »
As it is now, your predicate function will always return null and thus VL-SOME will continue. If you remove the nil, then your predicate function will return the value from the last statement (setq...) which will not be a null value and stop evaluating.

Yes.
Now I understand.

With some simple modification,
without adding NIL, at the end of vl-some,
now it works well.

Thank you.

Code - Auto/Visual Lisp: [Select]
  1. (defun :PT-LIST-SELF-INTERSECTING (pt-lst / i j kw p1 p2 result seg-lst seg1)
  2.    (if (not (equal (car pt-lst) (last pt-lst) 1e-7))
  3.       (setq pt-lst (append pt-lst (list (car pt-lst))))
  4.    )
  5.    (setq seg-lst (mapcar '(lambda (i j) (list i j) ) pt-lst (cdr pt-lst) ) )
  6.    (setq kw t)
  7.    (while kw
  8.       (setq seg1 (car seg-lst) p1 (car seg1) p2 (cadr seg1) )
  9.       (vl-some '(lambda (x-seg)
  10.                   (setq p3    (car x-seg)    p4 (cadr x-seg)
  11.                          x-pt    (inters p1 p2 p3 p4 t)
  12.                   )
  13.                   (if(and x-pt (vl-member-if '(lambda (x) (equal x-pt x 1e-7) )  (list p1 p2 p3 p4) ) )
  14.                      (setq x-pt nil)
  15.                   )
  16.                   (if x-pt (setq kw nil result x-pt)   )
  17.                )
  18.                (cdr seg-lst)
  19.       )
  20.       (setq seg-lst (cdr seg-lst) )
  21.       (if (= (length seg-lst) 1) (setq kw nil) )
  22.    )
  23.    result
  24. )
  25.  
  26. (defun C:K (/ p0 pt-lst pt-lst-s x x-pt)
  27.    (setq p0 (getpoint "\nfirst point :"))
  28.    (setq pt-lst (cons p0 pt-lst))
  29.    (while (setq x-pt (getpoint (car pt-lst) "\nnext point :"))
  30.       (grdraw x-pt (car pt-lst) 230 0)
  31.       (setq pt-lst (cons x-pt pt-lst))
  32.    )
  33.    (setq pt-lst (reverse pt-lst))
  34.    (:ENTMK-LWP-V-LST pt-lst)
  35.    (if (setq x (:PT-LIST-SELF-INTERSECTING pt-lst))
  36.       (:POINT x)
  37.    )
  38.    x
  39. )
  40.  
  41.  



anyway , is there anyone who knows
any better algorithm to check
if a list of points is self-intersecting ?

Because there are particular situations
that are not easy to manage . . .

domenicomaria

  • Bull Frog
  • Posts: 272
Re: self intersecting pt list
« Reply #5 on: June 23, 2021, 02:33:43 AM »
I have found
ACET-GEOM-SELF-INTERSECT
that seems to be good.

But I prefer to be ACET-INDIPENDENT . . . !

mailmaverick

  • Bull Frog
  • Posts: 473
Re: self intersecting pt list
« Reply #6 on: June 24, 2021, 02:49:16 PM »
Hi,

What is the syntax of ACET-GEOM-SELF-INTERSECT ? From where do we get the syntaxes of all ACET functions ?

domenicomaria

  • Bull Frog
  • Posts: 272
Re: self intersecting pt list
« Reply #7 on: June 24, 2021, 03:49:36 PM »
What is the syntax of ACET-GEOM-SELF-INTERSECT ?

I tried this : (ACET-GEOM-SELF-INTERSECT pt-lst t)


From where do we get the syntaxes of all ACET functions ?

I don't know

however I got this (i don't remember, where ...)


(defun acet-error-init ( errlist /                    ;;Error Init for ET
(defun acet-error-restore ( /                         ;;Error Restore for ET
(defun acet-sysvar-set ( varlist /                    ;;Save Sysvar List
(defun acet-sysvar-restore ( /                        ;;Restore Sysvar List
(defun acet-spinner ( /                               ;;Show Spinner Sign
(defun acet-table-name-list ( tblORlist /             ;;Get Table Entries
(defun acet-table-purge ( table entry flag /          ;;Purge table entry
(defun acet::store2reg ( varname varval /             ;;Store custom data 2 Registry
(defun acet::loadreg ( varname /                      ;;Load custom from Registry
(defun acet::store2dict ( varname varval /            ;;Store custom data 2 Dict
(defun acet::loaddict ( varname /                     ;;Load custom from Dict
(defun acet-set-CmdEcho ( val                         ;;Setvar CmdEcho
(defun acet-setvar ( varlist /                        ;;Setvar Custom Var
(defun acet-group-make-anon ( enamelist desc /        ;;Create Anonymous Group
(defun acet-ucs-to-object ( ent /                     ;;Setvar UCS to Ent
(defun acet-ucs-set-z ( zvec /                        ;;Setvar UCS to Ent
(defun acet-ucs-get ( from /                          ;;get current/entity ucs
(defun acet-ucs-set ( ucs /
(defun acet-ucs-cmd ( cmdlist /                       ;;execute ucs command
(defun acet-xdata-set ( xkeylist /                    ;;Set XData Values for keys
(defun acet-xdata-get ( xkeylist /                    ;;Get XData Value for key
(defun bns_ss_mod ( ss flag pr /                      ;;Get XData Value for key
(defun acet-layer-locked ( layer /                    ;;Check Layer Locked ?
(defun acet-layer-unlock-all ( /                      ;;Unlock all layers
(defun acet-plines-rebuild ( plist /                  ;;rebuild polylines
(defun acet-pline-segment-list-apply ( na lst /       ;;re-apply pline segment width
(defun acet::apply_width_bulge ( na swlst ewlst blglst /
(defun acet-plines-explode ( ss /                     ;;explode polylines
(defun acet-pline-segment-list ( elist /              ;get pline segment data
(defun acet::plines-get-widthlist ( ename etype elist /
(defun acet::pline-explode ( ename /
(defun acet-ss-ssget-filter ( ss flt /                ;;filter selection set
(defun acet-ss-new ( ename /                          ;;Create new SelectionSet with Ent
(defun acet-ss-clear-prev ( /                         ;;Clear previous SelectionSet
(defun acet-ss-visible ( entset flag /                ;;Make Entities Visible(0)-Invisible(1)
(defun acet-ss-intersection ( ss ssmaster /           ;;SelectionSet Intersection
(defun acet-ss-filter ( filterdata /                  ;;Filter Selection Set
(defun acet-ss-flt-cspace ( /                         ;;Build filter part for current space
(defun acet-ss-remove ( ss ssmaster /                 ;;Remove Ents from SelectionSet
(defun acet-ss-union ( sslist /                       ;;Combine SelectionSets together
(defun acet-ss-redraw ( ss mode /                     ;;Redraw SelectionSet with Mode
(defun acet-list-m-assoc ( key datalist /             ;;Redraw SelectionSet with Mode
(defun acet-ss-entdel ( ss /                          ;;Entdel ss entities
(defun acet-ss-filter-current-ucs ( ss printit /      ;;filter entities on current ucs
(defun acet-ss-annotation-filter ( ss /
(defun bns_annotation_ss ( ss /                       ;;Get Attributes into ss, remove inserts
(defun acet-ss-to-list ( ss /                         ;;Convert selection-set to entities list
(defun acet-list-to-ss ( lst /                        ;;Convert entities list to selection-set
(defun acet-ss-zoom-extents ( ss /                    ;####### Punkte p1/p2 von entry ohne Z-Wert !!!
(defun acet-ss-remove-dups ( ss fuz ignore /          ;;Remove duplicate entities
(defun acet::check-identic-points ( plist1 plist2 fuz /
(defun acet-tjust-keyword ( elist /                   ;;get text justification
(defun acet-tjust ( ss tjust /                        ;;(acet-tjust (ssadd na (ssadd)) "Start") ;; then set it to start
(defun acet-insert-attrib-set ( na attlst flag / 
(defun acet-currentviewport-ename ( /                 ;get current vport entity
(defun acet-viewport-lock-set ( vpename setlocked /   ;set vport locked/unlocked
(defun acet-alert ( msg /
(defun acet-fscreen-toggle ( /
(defun acet-init-fas-lib ( flag1 flag2 /
(defun acet-block-make-anon ( ss blkname /            ;;Create anonymous block from ss
(defun acet-block-purge ( bna /                       ;;Purge Block with given name
(defun getgeomextents ( en /
(defun acet-geom-z-axis ( /
(defun acet-point-flat ( pt from to /                 ;;flat point
(defun acet-geom-midpoint ( p1 p2 /                   ;;Calculate Midpoint for P1,P2
(defun acet-geom-m-trans ( pntlst from to /           ;;Transform Pointlist
(defun acet-geom-list-extents ( pntlst /              ;;Transform Pointlist
(defun acet-geom-zoom-for-select ( pntlist /          ;;Get Zoom Points to Include Points
(defun acet-geom-view-points ( /                      ;;Get Viewport Corner Points
(defun acet-geom-pixel-unit ( /
(defun acet-geom-textbox ( txtdata offset /           ;;Get Textbox for any Text
(defun acet-geom-rect-points ( pa pb /                ;;Get 5 Rectangle Points
(defun acet-geom-self-intersect ( pointlist flag /    ;;Point Check Self-Intersection
(defun acet-geom-object-end-points ( ename /          ;;get object end points
(defun acet-geom-object-point-list ( na alt /         ;;Get Object Points Rasterized    ;; altitude may be NIL !
(defun acet::pl-point-list ( na alt /                 ;;Get Polyline/LwPolyline Points
(defun acet::arc-point-list ( p1 p2 p3 ang alt /      ;;Get Arcus Points
(defun acet::delta-ang ( r a /                        ;;Get Arcus Infos  ;returns the delta angle of an arc with the specified altitude and radius
(defun acet-geom-image-bounds ( na /                  ;;Get Image Bounds
(defun acet-geom-point-rotate ( pnt p1 ang /          ;;Rotate Point ;Rotate 'pnt' from a base point of 'p1' and through an angle of 'ang' (in radians)
(defun acet-geom-vertex-list ( na /                   ;;Get (LW)Polyline Vertexes
(defun acet-geom-delta-vector ( p1 p2 /               ;;Get Difference Vector
(defun acet-geom-vector-scale ( vec scale /           ;;Get Difference Vector
(defun acet-geom-vector-add ( vec add /               ;;Add 2 Vectors
(defun acet-geom-cross-product ( v1 v2 /              ;;Get Vector Cross Product (Normal Vector)
(defun acet-geom-unit-vector ( p1 p2 /                ;;Get Vector Normalized
(defun acet-geom-angle-trans ( ang from to /          ;;Transform Angle between Coordsys
(defun acet-geom-pline-arc-info ( p1 p2 bulge /       ;;Get Arcus Infos
(defun acet-geom-point-inside ( pt ptlist dist /      ;;Check Point inside Band along Ptlist
(defun acet-geom-vector-side ( pt pa pb /             ;;Get Side of Point rel. to Vector
(defun acet-geom-intersectwith ( ent1 ent2 flag /     ;;Get Intersection Points
(defun acet::measure-points ( object dist /           ;;Get Object points by Measure
(defun acet-geom-object-normal-vector ( ename /       ;;Get Entity's Z normal vector
(defun acet-geom-point-scale ( targetpnt frompnt scale /
(defun acet-geom-vector-parallel ( v1 v2 /            ;;Check for parallel vectors
(defun acet-geom-arc-center ( pa pb pc /              ;;Get Arc center from 3 points
(defun acet-geom-object-z-axis ( ename /              ;;Get Entity Z-Axis
(defun acet-geom-vector-d-angle ( v1 v2 /             ;;Get angle between 2 vectors
(defun acet::acos ( inval /
(defun acet-geom-object-fuz ( na /                    ;;Get object fuzz
(defun acet-ui-entsel ( sellst /                      ;;Entity Selection
(defun acet-ui-single-select ( filter flag /          ;;Single Entity Select
(defun acet-ui-fence-select ( /                       ;;Fence Selectino points
(defun acet-ui-polygon-select ( mode /                ;;Window/Crossing Polygon
(defun bns_truncate_2_view ( a b x y x2 y2 /          ;;Truncate point list
(defun bns_groups_unsel ( /                           ;;Set All Groups to Unselect
(defun bns_groups_sel ( grpenames /                   ;;Set Groups back to Select
(defun acet-blink-and-show-object ( lst /             ;;Draw a temporary polyline & let it blink
(defun bns_blink_and_show_object ( na color /         ;;Draw a temporary polyline & let it blink
(defun bns_blktbl_match ( flt /                       ;;Search all entities inside block table
(defun bns_blk_match ( blkname flt lst flag /         ;;Search all entities inside specified blocks
(defun bns_tbl_match ( tblname flt /                  ;;Search all entities inside specified blocks
(defun bns_filter_match ( e1 flt /
(defun bns_-4_match ( a e1 flt /
(defun bns_or_match ( e1 flt /
(defun bns_and_match ( e1 flt /
(defun bns_not_match ( e1 flt / lst a flag )
(defun bns_gc_match ( e1 dp opr / dp2 a b c d flag )
(defun acet-dcl-list-make ( dcltile vallist /         ;;Display List Values
(defun acet-list-put-nth ( newval datalist atidx /
(defun acet-list-remove-nth ( atidx datalist /        ;;Remove Entry at Index
(defun acet-list-assoc-remove ( key datalist /        ;;Remove all Entries by Key
(defun acet-list-remove-adjacent-dups ( datalist /    ;;Remove Duplicates from List
(defun acet-list-remove-duplicate-points ( lst fuz /  ;;Remove duplicate points from List
(defun acet-list-group-by-assoc ( lst /               ;; group data by assoc key
(defun acet-elist-add-defaults ( elist /              ;;add defaults to elist
(defun acet-str-lr-trim ( s str /                     ;;Trim Left / Right Characters
(defun acet-str-space-trim ( str /                    ;;Trim Left / Right Spaces
(defun acet-str-esc-wildcards ( str /                 ;;place escape for wildcard strings
(defun acet-str-to-list ( deli line /                 ;;Split String into List
(defun acet-str-m-find ( find str /                   ;;Find multiple Substrings
(defun acet-str-equal ( str1 str2 /                   ;;Compare Strings Insensitive
(defun acet-bs-strip ( str /                          ;;Remove backslash controls
(defun acet-filename-ext-remove ( file /              ;;Remove Extension from File
(defun acet-filename-path-remove ( file /             ;;Get Filename Without Path
(defun acet-filename-extension ( file /               ;;Get Extension from Filename
(defun acet-filename-directory ( file /               ;;Get Directory from Filename
(defun acet-filename-valid ( file /                   ;;Check for Proper Filename
(defun acet-filename-supportpath-remove ( file /      ;;Remove Path, if file is inside Supportpathes
(defun acet-file-find ( file /                        ;;Extended FindFile
(defun acet-file-find-font ( fontfile /               ;;Extended FindFile (Fonts)
(defun acet-file-find-image ( imgfile /               ;;Extended FindFile (Fonts)
(defun acet-file-backup ( file /                      ;;Create Backup file
(defun acet-file-backup-delete ( /                    ;;Delete All Backup files
(defun acet-filename-associated-app ( filename /      ;;Get Application for file
(defun get-defparts ( cmd / cmdname cmdpar idx slen )
(defun acet-arxload-or-bust ( filename /
(defun acet-autoload ( loadlist /                     ;;Test & Load function & file
(defun acet-autoload2 ( loadlist /
(defun acet-autoloadarx ( loadlist /
(defun acet-viewport-next-pickable ( /                ;;Get Next Pickable VP
(defun acet-viewport-frozen-layer-list ( ename /      ;;Get Next Pickable VP
(defun acet-calc-bitlist ( n /                        ;;Calculate Bit Values
(defun acet-calc-round ( rval rround /                ;;Round Value
(defun acet-calc-tan ( a /                            ;; Calculate Tangens
(defun acet-lwpline-make ( lst /                      ;;Create LW Polyline
(defun acet-temp-segment ( p1 p2 p3 mode /            ;;Draw tempory Segment
(defun acet-wmfin ( wmffile /                         ;;WMF IN
(defun acet-dxf ( key keylist /                       ;;Get dxf value from assoc list
(defun acet-angle-format ( ang /                      ;;format angle 0...2*PI
(defun acet-angle-equal ( a b fuz /                   ;;Compare Angles with Tolerance
(defun acet-dtor ( a /                                ;;Compare Degree <> Radians
(defun acet-rtod ( a /                               
(defun acet-dict-ename ( dictname dictentry /         ;;Get Dictionary entry
(defun acet-dict-name-list ( dictname /               ;;Get Dictionary entries
(defun acet-explode ( na /                            ;;Explode SS and return exploded entities
(defun acet-list-assoc-put ( new lst /                ;;Add / Update entry to list
(defun acet-list-assoc-append ( new lst /             ;;Append entry to list
(defun acet-pline-is-2d ( elist /                     ;;Check (LW)Polyline for 2D
(defun acet-ui-getcorner ( p1 /                       ;;Get other corner with selection rubberband
(defun acet-undo-begin ( /                            ;;undo begin
(defun acet-undo-end ( /                              ;;undo end
(defun acet-cmd-exit ( /                              ;;undo command exit
(defun acet-safe-command ( bStart bAutoEnd cmdList /  ;;execute commands in safe mode
(defun acet-pref-supportpath-list ( /                 ;;Get Support Pathes as list
(defun acet-list-isort ( plst index /                 ;;Indexed Sort
(defun acet-acad-refresh ( /
(defun acet-geom-ss-extents ( ss shrink /             ;;Get extents of selection set
(defun acet-file-find-on-path ( fna path /            ;;Find file on OS env "PATH"
(defun acet-list-is-dotted-pair ( a /                 ;;check for dotted pair
(defun acet-file-open ( fna flag /                    ;;file open
(defun acet-list-remove-duplicates ( lst fuz /        ;;remove duplicates from list
(defun acet-list-split ( lst item /                   ;;Split List at entry
(defun acet-appid-delete ( appid /                    ;;Remove APPID
(defun acet-ui-progress-init ( title maxstep /        ;;init progress bar
(defun acet-ui-progress-safe ( pos /                  ;;set progress pos
(defun acet-ui-progress-done ( /                      ;;done progress
(defun acet-ui-get-long-name ( msg /                  ;;get long keyboard input
(defun acet::getltexmsg ( msgkey defmsg /
(defun acet::expandfn ( fname fcheck /                ;;Expand & Find Filename
(defun acet::filetype ( filename /                    ;;Get File Type Only
(defun acet::pos-filetype ( filename /                ;;Get Position of Extension
(defun acet::nameonly ( filename /                    ;;Get File Without Path
(defun acet::pathonly ( filename /                    ;;Get Directory only[/font]

BIGAL

  • Swamp Rat
  • Posts: 818
  • 30 + years of using Autocad
Re: self intersecting pt list
« Reply #8 on: June 24, 2021, 08:00:44 PM »
« Last Edit: June 24, 2021, 08:05:31 PM by BIGAL »
A man who never made a mistake never made anything

mailmaverick

  • Bull Frog
  • Posts: 473
Re: self intersecting pt list
« Reply #9 on: July 03, 2021, 03:30:38 PM »