Topic: Help with Lisp Take the polyline adjacent to the boundary

[anhquang1989]

I was able to Convert from A to B but I can not switch from A to C with Test.lisp.
 Please help me. Thank

[ronjonp]

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)))

[anhquang1989]

Hi. Ronjonp
I just changed the colors for easy identification of more problems. The fact that they are the same color and layer

[anhquang1989]

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]

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...

[VovKa]

simple but unreliable

Code: [Select]

(setq e (bpoly (getpoint "Pick point: ")))
(vl-remove e (ss2ents (ssget "_CP" (getcoords e))))


[anhquang1989]

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]

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. )

[anhquang1989]

I tried it and it looks like my case. It's not really effective with other objects like polyline ...

[ronjonp]

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)).

[MSTG007]

That is some stuff. Pretty Cool. Great job Ron.

[ronjonp]

That is some stuff. Pretty Cool. Great job Ron.

[anhquang1989]

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]

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.

[anhquang1989]

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 

[VovKa]

I hope they can be automated.

then it is a good time to switch to Autocad Map 3d

[DEVITG]

Please , would you UPLOAD a true sample , just make a WBLOCK from a few samples  guess at least 10 parcel with it´s surrounding neighbor parcels .

It is hard to give a good solution if you hide your real work. 

Yours notes

I just changed the colors for easy identification of more problems. The fact that they are the same color and layer   

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.

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!

I tried it and it looks like my case. It's not really effective with other objects like polyline ...



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.

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

So please star it again , show what you real have , what do you want to have with all details,

Or migrate to a better software .


We all are   eager and ready to help , but first please help yourself , an ambiguous question , return a ambiguous answer.

Be clear and complete. From start to end .

I know that English is not you native language , neither mine.  [Spanish] 
So please try to explain ti as we can get a true way to walk.

Best regards

Gabriel
devitg-alt64- gmail.com





 

[anhquang1989]

sorry you. It's true that English is not my native language so I have difficulty presenting ideas.
And please make it clear that I do not hide my program. It is only after solving a problem that it raises a problem or a new idea to improve the program and I follow them.
The program using vietnamese language, i am afraid people do not understand the trouble again. Ok. I will upload it as soon as I can.
The last issue is that the program will automatically run all the land parcels on the drawing. (Test.dwg)
Thank you

[Ketxu]

sorry you. It's true that English is not my native language so I have difficulty presenting ideas.
And please make it clear that I do not hide my program. It is only after solving a problem that it raises a problem or a new idea to improve the program and I follow them.
The program using vietnamese language, i am afraid people do not understand the trouble again. Ok. I will upload it as soon as I can.
The last issue is that the program will automatically run all the land parcels on the drawing. (Test.dwg)
Thank you

Trên Cadviet không ai giải quyết được vấn đề của bạn à

[anhquang1989]

Hi. Ketxu. Thực sự là rất lâu rồi ḿnh không sử dụng diễn đàn cadviet. C̣n vấn đề này th́ ở việt nam đă có rất nhiều chương tŕnh làm được nó. Và hiện tại theo thông tư mới nó đă không c̣n được sử dụng. Ḿnh chỉ muốn t́m hiểu sâu hơn về nó với lisp như là 1 bài học thôi nên ḿnh luôn chọn các diễn đàn nước ngoài với sự cởi mở và thoải mái hơn thôi. Cảm ơn bạn đă quan tâm. Ketxu

[BIGAL]

Have a look at the cadtutor post by me. It uses the lot number to find all lots automatically. I doubt the code will be as complicated as already posted. I am busy at moment and this is a bigger task. I will try to do something.

1 Pick lot by text use Bpoly make a boundary
2 Offset boundary
3 Use copy with "F" option to pick all plines & lines
4 move it away from the original using a grid pattern for to be repeated for all lots
5 trim using a offset from the original created BPOLY pline offset again and use the "F" option with trim
6 erase the dummy plines
7 work out the centroid of the shape
8 go to layout add new using layout title block
9 mspace then zoom c scalefactor you should see your lot
10 back to pspace add the corner points in a table

here is a start ver 1
Ver 2 draws extra plines keep watching
Caution not tested properly 

Code: [Select]

; pline co-ords example
; By Alan H
(defun getcoords (ent)
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property
(vlax-ename->vla-object ent)
"Coordinates"
)
)
)
)
 

; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(defun co-ords2xy (co-ords / xy I )
(setq co-ordsxy '())
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth I co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)

; program starts here a test all corner points of the internal lots
(defun c:dolots2 ( / ss lay pt obj obj2 obj3 txt txtstr txtins x y co-ords2 co-ords3 co-ords4)

(setq off  (getdist "Please enter suitable offset for lines"))
(setq off2  (getdist "Please enter spacing of lots eg 2x size"))
(setq pt ( getpoint "Select a point in space for lots"))
(setq obj (vlax-ename->vla-object (car (entsel "\nPick text"))))
(setq lay (vla-get-layer obj))
(setq ss (ssget "X" (list (cons 0 "*text")(cons 8 lay))))
(repeat
(setq x (sslength ss))
(setq txt (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq txtstr (vla-get-textstring txt))
(setq txtins (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint txt))))
(setq txtins (list (- (car txtins) 0.05)(- (cadr txtins) 0.05)))
(command "bpoly" txtins "")
(setq obj2 (entlast))
(co-ords2xy (getcoords obj2))
(setq co-ords co-ordsxy)
;(setq co-ordsxy nil)
(command "offset" off obj2 (list 0 0) "")
(setq obj3 (entlast))
(co-ords2xy (getcoords obj3))
(setq co-ords2  co-ordsxy)
;(setq co-ordsxy nil)
(command "offset" off obj3 (list 0 0) "")
(setq obj4 (entlast))
(co-ords2xy (getcoords obj4))
(setq co-ords3 co-ordsxy)
;(setq co-ordsxy nil)
(command "move" obj2 obj3 obj4  "" txtins pt )
(command "zoom" "e" "zoom" "0.5XP")
(command "copy" "CP")
(while (= (getvar "cmdactive") 1 )
(foreach xy co-ords3 (command xy) )
(command "" ""  txtins pt)
)
;(command  txtins pt )
(co-ords2xy (getcoords obj4))
(setq co-ords3 co-ordsxy)
(command "erase" obj4 "")
(command "trim" obj3 "" "F")
(while (= (getvar "cmdactive") 1 )
(repeat (setq y (length co-ords3))
(command (nth (setq y (- y 1)) co-ords3))
)
(command  (nth (- (length co-ords3) 1) co-ords3))
(command  "" "")
)
(command "erase" obj2 obj3 "")
(setq pt (list (+ (car pt) off2) (cadr pt)))
)

)



[MSTG007]

That's Pretty Slick BIGAL.

[BIGAL]

I will try to add a bit more every day its just a time thing.

[VovKa]

boundary's tracing is not 100% safe
try it on this polygon

Code: [Select]

(entmakex '((0 . "LWPOLYLINE")
    (100 . "AcDbEntity")
    (100 . "AcDbPolyline")
    (90 . 9)
    (70 . 0)
    (10 27.0534 0.603842)
    (10 53.4487 1378.68)
    (10 457.5 1378.68)
    (10 416.046 -17.2896)
    (10 495.84 104.405)
    (10 556.99 1062.45)
    (10 709.271 1062.45)
    (10 709.271 -31.8694)
    (10 27.0534 0.603842)
   )
)


[BIGAL]

See code version 2 getting somewhere, needs debugging a bit more almost there see above.

[BIGAL]

See version 3 above updated very close for 1st step makes a copy of each polygon.

[anhquang1989]