Author Topic: Help with Lisp Take the polyline adjacent to the boundary  (Read 6243 times)

0 Members and 1 Guest are viewing this topic.

anhquang1989

  • Newt
  • Posts: 74
Help with Lisp Take the polyline adjacent to the boundary
« on: August 29, 2017, 10:08:44 AM »
I was able to Convert from A to B but I can not switch from A to C with Test.lisp. :idiot2:
 Please help me. Thank
« Last Edit: August 29, 2017, 10:16:10 AM by anhquang1989 »

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #1 on: August 29, 2017, 12:00:38 PM »

Not exactly sure what you're asking but:

This will select red lines: (ssget '((0 . "line") (62 . 1)))
This will select green lines: (ssget '((0 . "line") (62 . 3)))

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

anhquang1989

  • Newt
  • Posts: 74
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #2 on: August 29, 2017, 12:10:36 PM »
Hi. Ronjonp
I just changed the colors for easy identification of more problems. The fact that they are the same color and layer

anhquang1989

  • Newt
  • Posts: 74
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #3 on: August 29, 2017, 12:43:05 PM »
My problem is I work on land management. I want to export the boundary information of a parcel of land including the polyline adjacent to that boundary for documentation.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #4 on: August 29, 2017, 12:51:49 PM »
If you can extract from A to B, then you can check for all intersections of B with rest of lines of A and take only those that return intersections to get C from B... Seek for IntersectWith method of 2 VLA-OBJECTs... BTW. you'll probably have to iterate through every pair of B and A to get those needed for C...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

VovKa

  • Water Moccasin
  • Posts: 1626
  • Ukraine
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #5 on: August 29, 2017, 02:08:29 PM »
simple but unreliable
Code: [Select]
(setq e (bpoly (getpoint "Pick point: ")))
(vl-remove e (ss2ents (ssget "_CP" (getcoords e))))

anhquang1989

  • Newt
  • Posts: 74
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #6 on: August 30, 2017, 07:56:33 AM »
The problem was solved with Lisp (new) but I had a new problem that it only caught adjacent objects as line. For other objects it's not perfect yet
The direction of the evening's solution is:
+ Create boundary new outside of boundary old
+ Trim objects outside of bowndary new
However, with lisp (new) the objects are not deleted outside bowndary new but rather delete objects between bowndary new and bowndary old.
Help me!

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #7 on: August 30, 2017, 09:36:27 AM »
Try this:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ ap e fz p pts)
  2.   (setq e (entlast))
  3.   (setq fz 1)
  4.   (if (and (setq p (getpoint "\nPick internal point: "))
  5.       (not (command "_.-boundary" "a" "o" "p" "" p ""))
  6.       (not (equal e (entlast)))
  7.       )
  8.     (progn
  9.       (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget (entlast)))))
  10.       (entdel (entlast))
  11.       (setq ap (mapcar '(lambda (x) (/ x (length pts))) (apply 'mapcar (cons '+ pts))))
  12.       (sssetfirst
  13.    nil
  14.    (ssget "_CP" (mapcar '(lambda (x) (polar ap (angle ap x) (+ fz (distance ap x)))) pts))
  15.       )
  16.     )
  17.   )
  18.   (princ)
  19. )
« Last Edit: August 30, 2017, 09:47:08 AM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

anhquang1989

  • Newt
  • Posts: 74
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #8 on: August 30, 2017, 10:27:52 AM »
I tried it and it looks like my case. It's not really effective with other objects like polyline ...

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #9 on: August 30, 2017, 10:32:08 AM »
I tried it and it looks like my case. It's not really effective with other objects like polyline ...
I don't understand what you want .. sorry. If you want the boundary to remain, remove (endel (entlast)).

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #10 on: August 30, 2017, 10:49:21 AM »
That is some stuff. Pretty Cool. Great job Ron.
Civil3D 2020

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #11 on: August 30, 2017, 11:20:29 AM »
That is some stuff. Pretty Cool. Great job Ron.
:)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

anhquang1989

  • Newt
  • Posts: 74
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #12 on: August 30, 2017, 11:53:51 AM »
Sorry you did not understand the problem. Maybe my presentation is not correct. My main goal is from Figure A to create C. There may be many different ways. I just need 1 idea.
Foo.lisp has performed very well. But it's not perfect with objects like Polyline, Arc, Spline .... Because it's beyond the scope of my profile presentation. I need something like the image below.
Thank you very much for your help.

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #13 on: August 31, 2017, 10:57:22 PM »
There is a another post at cadtutor almost identical, Ronjop almost there, problem is adjoining objects are plines but you only want answer as lines, it may be faster to pick lot copy all adjoining objects to somewhere then offset lot twice 1st offset is trim line 2nd offset is the points you pick for trim, (add a few more pts is good idea for odd shapes) erase the two offsets, this is something I have used for  similar problem. Did a manual check and worked.

I used bpoly to find the lot via a text located in the lot so would go away and do all in one go. It makes sense also to add a layout automatically that matches the title block creating the correct mview as it goes. This is what the cadtutor post should do.

http://www.cadtutor.net/forum/showthread.php?101504-To-save-with-specific-portion-from-1000-same-dwgs-which-same-as-mentioned-dwg-No.
A man who never made a mistake never made anything

anhquang1989

  • Newt
  • Posts: 74
Re: Help with Lisp Take the polyline adjacent to the boundary
« Reply #14 on: September 01, 2017, 02:08:47 AM »
Code: [Select]
(defun SS-enlst (ss / c L)
  (setq c -1)
  (repeat (sslength ss)
(setq L (cons (ssname ss (setq c (1+ c))) L))
  )
  (reverse L)
)
;;;---------------------- -
(defun Text (model str po h ang / obj)
  (setq obj (vla-AddText
    *Model*
    str
    (vlax-3d-point po)
    h
  )
  )
  (vla-put-Alignment obj acAlignmentTopCenter)
  (vla-put-TextAlignmentPoint obj (vlax-3d-point po))
)
;;;====================================================================
(defun break_with (Lstent enL / lst masterlist ss oc break_obj intpts)
  (princ "\nCalculating Break Points, Please Wait.\n")
 
  ;;========================================
  ;; Break entity at break points in list
  ;;========================================
  (defun break_obj (ent brkptlst   /    brkobjlst  en
   enttype maxparam   closedobj  minparam
   obj obj2break  p1param  p2param
   brkpt2 dlst    idx  brkptS
   brkptE brkpt  result  result
   ignore dist    tmppt  #ofpts
   enddist lastent obj2break  stdist
      )
  (setq obj2break ent
brkobjlst (list ent)
enttype   (dxf 0 ent)
  )
(if (not (or (eq (dxf 0 obj2break) "TEXT")
   (eq (dxf 0 obj2break) "MTEXT")
  )
)
  (setq closedobj (vlax-curve-isclosed obj2break))
)
(setq spt (vlax-curve-getstartpoint ent)
   ept (vlax-curve-getendpoint ent)
   brkptlst (vl-remove-if
    '(lambda (x)
   (or (< (distance x spt) 0.0001)
    (< (distance x ept) 0.0001)
   )
    )
    brkptlst
  )
)
;)
(if (and brkptlst
  (not (or (eq (dxf 0 obj2break) "TEXT")
    (eq (dxf 0 obj2break) "MTEXT")
)
  )
)
  (progn
(setq brkptlst
    (mapcar
   '(lambda (x)
  (list
    x
    (vlax-curve-getdistatparam
   obj2break
   (cond
  ((vlax-curve-getparamatpoint obj2break x)
  )
  ((vlax-curve-getparamatpoint
    obj2break
    (vlax-curve-getclosestpointto
      obj2break
      x
    )
  )
  )
   )
    )
  )
)
   brkptlst
    )
)
(setq
   brkptlst (vl-sort brkptlst
    '(lambda (a1 a2) (< (cadr a1) (cadr a2)))
  )
)
(foreach brkpt (reverse brkptlst)
  (setq brkptS (car brkpt)
brkptE brkptS
  )
   ;; get last entity created via break in case multiple breaks
   (if brkobjlst
  (progn
    (setq tmppt brkptS) ; use only one of the pair of breakpoints
    ;; if pt not on object x, switch objects
    (if (not (numberp (vl-catch-all-apply
  'vlax-curve-getdistatpoint
  (list obj2break tmppt)
)
      )
)
  (progn   ; find the one that pt is on
(setq idx (length brkobjlst))
(while
  (and (not (minusp (setq idx (1- idx))))
(setq obj (nth idx brkobjlst))
(if (numberp (vl-catch-all-apply
  'vlax-curve-getdistatpoint
  (list obj tmppt)
      )
    )
  (null (setq obj2break obj))
  ; switch objects, null causes exit
  t
)
  )
)
  )
    )
  )
   ); end (if brkobjlst
 
   ;;; Handle any objects that can not be used with the Break Command
   ;;; using one point, gap of 0.000001 is used
   (if (not (or (eq (dxf 0 obj2break) "TEXT")
      (eq (dxf 0 obj2break) "MTEXT")
  )
    )
  (setq closedobj (vlax-curve-isclosed obj2break))
   )
;;; single breakpoint ----------------------------------------------------
  (if
    (and closedobj
  (not (setq
  brkptE (vlax-curve-getPointAtDist
    obj2break
    (+ (vlax-curve-getdistatparam
  obj2break
  (cond
    ((vlax-curve-getparamatpoint
      obj2break
      brkpts
    )
    )
    ((vlax-curve-getparamatpoint
      obj2break
      (vlax-curve-getclosestpointto
        obj2break
        brkpts
      )
    )
    )
  )
      )
      0.00001
    )
  )
   )
  )
    )
    (setq
   brkptE (vlax-curve-getPointAtDist
  obj2break
  (- (vlax-curve-getdistatparam
      obj2break
      (cond ((vlax-curve-getparamatpoint
  obj2break
  brkpts
      )
      )
      ((vlax-curve-getparamatpoint
  obj2break
  (vlax-curve-getclosestpointto
    obj2break
    brkpts
  )
      )
      )
      )
    )
    0.00001
  )
   )
    ); end setq brkptE
  ); end fi (and closedobj
   ;; (if (null brkptE) (princ)) ; debug
   (setq LastEnt (GetLastEnt))
   (if (not (or (eq (dxf 0 obj2break) "TEXT")
      (eq (dxf 0 obj2break) "MTEXT")
  )
    )
  (command "._break"
    obj2break
    "_non"
    (trans brkptS 0 1)
    "_non"
    (trans brkptE 0 1)
  )
   )
   (and (= "CIRCLE" enttype) (setq enttype "ARC"))
   (if (and (not closedobj) ; new object was created
  (not (equal LastEnt (entlast)))
    )
  (setq brkobjlst (cons (entlast) brkobjlst))
   ); end (if (and
); end (foreach brkpt
  );end progn brkptlst
); end if brkptlst
  ); defun break_obj
  ;;====================================
  ;; CAB - get last entity in datatbase
  (defun GetLastEnt (/ ename result)
(if (setq result (entlast))
  (while (setq ename (entnext result))
(setq result ename)
  )
)
result
  )
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ;; S T A R T          S U B R O U T I N E          H E R E
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(if (and Lstent enL)
(progn
  ;; CREATE a list of entity & it's break points
  (foreach en Lstent
  ; check each object in Lstent
(if (not (acet-layer-locked (dxf 8 en)))
   (progn
  (setq lst nil)
  ;; check for break pts with other objects in Lstentwith
  (if (and (not (equal en enint))
    (setq intpts (acet-geom-intersectwith en enL 0))
  )
    (setq lst (append intpts lst))
  ; entity w/ break points
  )
  (if lst
    (setq masterlist
    (cons (cons en lst) masterlist)
    )
  )
   )
)
  )
  (princ "\nBreaking Objects.\n")
  (if masterlist
(progn
   (acet-ui-progress "hoan thanh %" (length masterlist))
   (foreach obj2brk masterlist
  (break_obj (car obj2brk) (cdr obj2brk))
  (acet-ui-progress -1)
   )
   (acet-ui-progress)
)
  )
)
  )
);end break_with
;;===========================================================================
;; get all objects touching entities in the sscross
;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
;; returns a list of enames
;;===========================================================================
(defun gettouching (en / ss lst lstb lstc objl)
  (and
(setq objl (vlax-ename->vla-object en))
(setq
  ss
    (ssget
  "_A"
  (list
(cons 0
   "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
)
(cons 410 (getvar "ctab"))
  )
    )
)
(setq lst (SS-enlst ss)
  lst (mapcar 'vlax-ename->vla-object lst))
(mapcar
  '(lambda (x)
  (if (not
    (vl-catch-all-error-p
   (vl-catch-all-apply
  '(lambda ()
    (vlax-safearray->list
   (vlax-variant-value
  (vla-intersectwith objl x acextendnone)
   )
    )
  )
   )
    )
  )
(setq lstc (cons (vlax-vla-object->ename x) lstc))
  )
    )
  lst
)
  )
  lstc
)
;;;------------------------------------------------
(defun LWP (Lpoint *Model* / PntArr)
  (setq PntArr (vlax-make-safearray
   vlax-vbDouble
   (cons 0 (1- (length Lpoint)))
    )
  )
  (vlax-safearray-fill PntArr Lpoint)
  (vla-AddLightWeightPolyline *Model* PntArr)
)
;;;------------------------------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;============================================================
;;;=======================MAIN LISP============================
;;;============================================================
(defun c:test (/ ActDoc *Model* ss encur lsten p1 p2 p3 LenssBR lstp objCE)
  (setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
  )
  (setq bit1 (cond (bit1)
("Boundary")
  )
  )
  (vla-StartUndoMark ActDoc)
  (setvar "cecolor" "104")
  (cond ((eq bit1 "Boundary")
  (setq pt (getpoint "\n Pick internal point :"))
(vl-cmdf  "-boundary" pt "")

    (setq Elast (entlast))
  (command ".scale" Elast "" (mid Elast) 1.5 "")
  (setq Elast2 (entlast))
)
 );end cond
 
  (setq ss (ssadd (entlast) (ssadd)))
  (setq p2
  (list (car pt) (cadr pt))
 
  )
  (command ".move" ss "" pt p2)
  (setq encur (entlast)
lstp (acet-geom-VERTEX-LIST encur))
  (setq ss (ssdel encur (ssget "_CP" lstp)))
  (command ".copy" ss "" p2 p2)
  (setq p3 (ACET-SS-DRAG-MOVE
  (ssadd encur ss)
  p2
  "Choose set:: "
)
  )
  (command ".move" ss encur "" p2 p3)
  (setvar "cecolor" "0")
  (setq lsten (vl-remove encur (gettouching encur)))
  (break_with  lsten encur)
  (vlax-invoke-method ActDoc 'Regen acActiveViewport)
  (vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.0001))
  (setq lstp (acet-geom-vertex-list (entlast)))
  (entdel (entlast))
  (if (equal (vlax-curve-getEndParam encur) 160 1) (entdel encur))
  (setq LenssBR (SS-enlst (ssget "F" lstp)))
  (mapcar '(lambda (x)
  (if (or (not (eq (dxf 0 x) "TEXT"))
    (not (eq (dxf 0 x) "MTEXT"))
   )
    (entdel x)
  )
)
   LenssBR
  )
  (if objCE (vla-move objCE (vlax-3d-point p1) (vlax-3d-point p3)))
  (vla-EndUndoMark ActDoc)
 (command ".erase" Elast2 "")
  (princ)
)

That's what I'm doing with my job.
After taking the polyline adjacent to the boundary. I deleted the boundary offset. and give the results as expected with test.lsp.
For a drawing there are thousands of land parcels. I still do it a craft is to extract each land one by one. And they take a lot of time to look like http://www.cadtutor.net/forum/showthread.php?101504-To-save-with-specific-portion-from-1000-same-dwgs-which-same-as- mentioned-dwg-No.
I hope they can be automated. Possible with the number of layers for example  :idiot2:
« Last Edit: September 01, 2017, 03:29:26 AM by anhquang1989 »