HotOffTheGrill lisp

May 21

Sometimes it happens in such situations.

May 21

There is a VL function getdistatpoint so for the curved pline that part is easy provided the insertion point is on the pline.

Not sure which lisp your using, so pick line/Pline, pt1, pt2.

: (setq d1 (vlax-curve-getdistatpoint obj pt1))
87.8866210545767
: (setq d2 (vlax-curve-getdistatpoint obj pt2))
35.6222561586541
: (abs (- d1 d2))
52.2643648959226

You may need to use this also

(setq pt1 (vlax-curve-getclosestpointto obj pt1))

As sometimes the pick point is like 0.0000001 different, even with osnap on.

Edited May 21 by BIGAL

May 22

Sometimes objects(BLOCK,POINT,COGO POINT) do not coincide with the end points of the line. How can LISP do this? please see example dwg rev4 file in attached.

HotOffTheGrill _ rev4.dwg

Edited May 22 by macros55

May 23

@macros55Try this!

foo.lsp

May 23

Mr @Tsuky, Is it possible to adjust the touching distance of the object? If the object does not touch the line within 0.0000mm, the process does not occur. I think it would be better if the object's even touching distance was set to 0.05m.

Edited May 23 by macros55

May 23

On 5/22/2024 at 12:32 AM, macros55 said:

Mr Tsuky, Thank you very much for your interest, could you please make some arrangements?

Try to change the line 232 in the code to

		OK (apply 'append (mapcar '(lambda (x) (mapcar '(lambda (zx) (equal (list (car x) (cadr x)) (list (car zx) (cadr zx)) 5E-02)) l_z)) (list pt_start pt_end)))

I haven't test 'it!

May 23

Sir . I updated it, the 0.05m edge capture mode worked, but I think there is a few missing. It does not create a yellow Polyline with the Block on the polyline. When only ARC is selected, it creates a yellow ARC. Also, The lisp it doesn't recognize it only when it's Line.

There is a problem with the arrow of the slopes because the arrow always points in the same direction, also the objects show different values depending on the first and second selection -1.55% /+ 1.55%. Would changing the arrow drawing to text <<</>>> be a solution?

Thank you for your generous help

Edited May 24 by macros55

May 24

Because you want a yellow pline section working with curves in a pline it is difficult, a quick workaround is copy the pline say to right 200 then adjust the 2 points chosen points X+200, trim the pline both ends, change its layer so becomes yellow, move it back -200, all done. Removes all the headaches of trimming and remaking plines.

No Code at this stage just a suggestion. Image shows idea.

Edited May 24 by BIGAL

May 24

19 hours ago, macros55 said:

Sir . I updated it, the 0.05m edge capture mode worked, but I think there is a few missing. It does not create a yellow Polyline with the Block on the polyline. When only ARC is selected, it creates a yellow ARC. Also, The lisp it doesn't recognize it only when it's Line.

There is a problem with the arrow of the slopes because the arrow always points in the same direction, also the objects show different values depending on the first and second selection -1.55% /+ 1.55%. Would changing the arrow drawing to text <<</>>> be a solution?

Thank you for your generous help

Try this version.

Before to load it erase and purge your block "H-BLOCK" for a good execution.

foo.lsp

May 24

Mr.Tsuky,

Could you please try this drawing yourself? rev5 dwg file

Unfortunately, it did not recognize some lines.
Also, when the object selection changes its location, the direction changes, but the direction should follow the slope and always take the direction >>> towards the lower elevation.

Thank you very much.

HotOffTheGrill _ rev5.dwg

May 25

Tsuky looking at copy the line arc pline etc out of the way and trim the ends of it off, then copy it back as yellow, so does not matter what the object is. See my image above working on a better 90 trim line at intersection pt.

Code removed as it does not match latest sample dwg.

Edited May 26 by BIGAL

May 25

On 5/24/2024 at 4:26 PM, macros55 said:

Mr.Tsuky,

Could you please try this drawing yourself? rev5 dwg file

Unfortunately, it did not recognize some lines.
Also, when the object selection changes its location, the direction changes, but the direction should follow the slope and always take the direction >>> towards the lower elevation.

Thank you very much.

HotOffTheGrill _ rev5.dwg 462.92 kB · 3 downloads

I think I have resolved your wishes.
However, I noticed for example that for a polyline with overlapping vertex, the new entity is not created.
Use OVERKILL on any that might cause problems.

foo.lsp

Edited May 26 by Tsuky
Update lisp code

May 25

Mr. Tsuky,

I think there are a few comments with the yellow line.
Could you please see the attached drawing rev6?

I am grateful for your help.

foo rev6.dwg

May 26

I can see now why the approach of looking at pline bulges etc.

There is no point at the 311.3/311.0 so the slope is incorrect just a comment. May be others.

A better approach to DO ALL may be to just walk along the line/pline and find vertices then look at the blocks at ends of each segment. There is a function that when getting a param at a pt if you use like 1, 2 etc its segments but 1.5, 2.5 etc is the mid point of a segment. This is in some code I was looking at yesterday and solution by Kent Cooper over at forums/autodesk from a few years back.

I need to throw away what I did and have another think about it. I would use the segment idea and 0.5 steps. No need to work out bulges etc.

defun getplineseg ( / elst ename pt param )
(setq elst (entsel "\nSelect pline segment: "))
(setq ename (car elst))
(setq pt (cadr elst))
(setq pt (vlax-curve-getClosestPointTo ename pt))
(princ (setq param (vlax-curve-getParamAtPoint ename pt)) )
(princ (setq preparam (fix param)) )
(princ (setq postparam (1+ preparam)) )
)


(setq pt1 (vlax-curve-getPointAtParam ename preparam))
(setq ptmid (vlax-curve-getPointAtParam ename (+ 0.5 preparam)))
(setq pt2 (vlax-curve-getPointAtParam ename postparam))

(setq pt (vlax-curve-getPointAtParam ename 0)) is start point. So just need how many segments.

Ie 9 vertices so 0-8.

Can then check is there a block at the ends (ssget pt '((0 . "insert" etc.

Oh yeah do we really need the Yellow's or is that just for checking ?

Another problem but the 2 arcs are same radius. So extend 1st arc.

Ps made into 9 vertices pline for testing.

Edited May 26 by BIGAL

May 26

Found another problem with one of your plines which may explain why some get skipped, a random pick and the pline looks like its only 2 points but a list reveals 4 points, in what I am doing causes a divide by zero problem.

Lwpolyline ---------------------------------------------
                  Handle:  386B
           Current space:  Model
                   Layer:  CL
                   Color:  red
                Linetype:  ByLayer
          Polyline Flags:  Open
                    Area:  0.0000
               Perimeter:  258.0001
                Location:  X=   4706.4605  Y=   1516.2020  Z=   0.0000
                Location:  X=   4706.4605  Y=   1516.2020  Z=   0.0000
                Location:  X=   4937.2987  Y=   1400.9729  Z=   0.0000
                Location:  X=   4937.2988  Y=   1400.9729  Z=   0.0000

Try this, takes into account duplicate verices there is a bug which I will fix, ran out of time, select multiple plines. NOTE NO YELLOW linework.

(defun c:grading ( / plent ent1 ent2 ent3 obj len pt1 pt2 vo-ord obj3 obj2 atts b2str1 b2str2 b1str1 b1str1)
(defun alg-ang (obj pnt)
  (angle '(0. 0. 0.)
     (vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
         obj
         pnt
       )
     )
  )
)
(setvar 'attreq 1)
(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)
;(setq ss (ssget '((0 . "LWPOLYLINE")(cons 8 "CL"))))
;(repeat (setq j (sslength ss))
;(setq plent (ssname ss (setq j (1- j))))
(while (setq plent (car (entsel "\nPick a pline ")))
(setq obj1 (vlax-ename->vla-object plent))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent))))
(setq lst '())
(setq x 0)
(setq pt1 (nth x co-ord))
(repeat (length co-ord)
(setq pt2 (nth (setq x (1+ x)) co-ord))
(if (and (equal (car pt1)(car pt2) 1e-4)(equal  (cadr pt1)(cadr pt2) 1e-4))
(princ)
(progn
(setq lst (cons (car pt1) lst))
(setq lst (cons (cadr pt1) lst))
)
)
(setq pt1 pt2)
)
(setq lst (reverse lst))
(if (= (length co-ord)(length lst))
(princ)
(progn
(setq var (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length lst)))) lst)))
(vla-put-coordinates obj1 var)
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent ))))
)
)
(setq x 0)
(setq b1 (ssname (ssget (nth x co-ord) '((0 . "INSERT"))) 0))
(setq obj2 (vlax-ename->vla-object b1))
(setq atts (vlax-invoke obj2 'Getattributes))
(setq b1str1 (atof (vlax-get (car atts) 'Textstring)))
(setq b1str2 (atof (vlax-get (cadr atts) 'Textstring)))
(setq k 0 spc 0.5  d1 0.0)
(repeat (- (length co-ord) 1)
(setq b2 (ssname (ssget (nth (setq k (1+ k)) co-ord) '((0 . "INSERT"))) 0))
(setq obj3 (vlax-ename->vla-object b2))
(setq atts (vlax-invoke obj3 'Getattributes))
(setq b2str1 (atof (vlax-get (car atts) 'Textstring)))
(setq b2str2 (atof (vlax-get (cadr atts) 'Textstring)))
(setq d2 (vlax-curve-getdistatpoint obj1 (nth k co-ord)))
(setq ptmid (vlax-curve-getPointAtParam plent spc))
(setq ang (alg-ang obj1 ptmid))
(setq diff (- b1str2 b2str2))
(if (>= diff 0.0)
(setq arrow "> > >")
(setq arrow "< < <")
)
(if (and (> ang (* pi 0.5)) (< ang (- (* pi 0.5)))) 
(setq ang (+ ang pi))
)
(setq arrow
  (if (and (> ang (* pi 0.5)) (< ang (- (* pi 0.5))))
  	(if (eq arrow "> > >") "< < <" "> > >")
  	(if (eq arrow "> > >") "> > >" "< < <")
  )
)
(setq len (- d2 d1))
(setq perc (strcat (rtos (* 100. (/ diff len)) 2 2) "%"))
(command "-insert" "H-BLOCK" "s" 1.0 ptmid ang (rtos len 2 2) arrow perc)
(setq d1 d2)
(setq b1str2 b2str2)
(setq spc (+ spc 1))
)
)
(princ)
)
(c:grading)

Found another problem will have to look at a workaround. This part of pline has a straight but no block then is a multi arc pline. This happens in a few locations.

These drafting in consistencies make life hard. Can see why some are being labelled and others not.

Edited May 26 by BIGAL

May 26

Mr. Bigal, I tried the code you wrote, unfortunately I couldn't get the result. I shared a video and picture attached. The LISP prepared by Mr. Tsuky works exactly as I want, LISP is doing the right thing. Even though there is another block in the middle, it only adds the yellow Polyline between the two selected blocks.
But it does not do the adding a yellow polyline in some places. It would be great if adding a yellow polyline solves the problem.
And when you select "Line", sometimes the slope arrow goes in the opposite direction, up to the elevation side, but the correct arrow should be down to the elevation side.
Thank you for your interest.

Edited May 27 by macros55

May 26

@macros55

In addition to block inserts, points and circles have been added. I do not have access to COGO points so I cannot handle this case.
LWPOLYLINE,LINE and ARC are accepted
I don't have the skills to produce a SPLINE part in lisp.
I think I solved the problem of overlapping vertices to produce the polyline part.
I updated the previous code.

May 27

Tsuky when looking at object ssget etc "Aecc_Cogo_point".

Did you find any of the problems I solved helpful like the 4 point plines which should be 2.

May 30

Mr. Tsuky, Mr. BIGAL,

Thank you very much for your effort and good will.

Over time, I will report back to you the final working status using LISP.

May 30

There is a post by I think by Exceed read today to do this task hopefully he will respond.

Sign In

HotOffTheGrill lisp

Recommended Posts

macros55

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

pBe

pBe

devitg

Posted Images

BIGAL

macros55

Tsuky

macros55

Tsuky

macros55

BIGAL

Tsuky

macros55

BIGAL

Tsuky

macros55

BIGAL

BIGAL

macros55

Tsuky

BIGAL

macros55

BIGAL

Join the conversation

pBe

pBe

devitg

Tutorials

Forums

Activity