Author Topic: Problem with Quick Profile program  (Read 4324 times)

0 Members and 1 Guest are viewing this topic.

danglar

  • Newt
  • Posts: 161
  • Read My Li(s)(p)
Problem with Quick Profile program
« on: December 07, 2015, 04:49:03 AM »
I find very useful program here:
http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/cross-section-from-contours/m-p/5934721/highlight/false
Program creates a section profile of the terrain based on the existing contours.
My question is:
Is it possible to get layer name by picking on entity on this layer?.. probably need to change function (getstring) to something else?

...sometimes you have very very long layer names and for me it wasting time to type it all the time

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Problem with Quick Profile program
« Reply #1 on: December 07, 2015, 05:52:09 AM »
If you have doslib installed, maybe this can help :

Code: [Select]
  (setq layername
    (dos_listbox "LAYERS"
      "Please select or enter the layer name of the contours"
      (ai_table "LAYER" 4)
    )
  )
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

mailmaverick

  • Bull Frog
  • Posts: 494
Re: Problem with Quick Profile program
« Reply #2 on: December 07, 2015, 06:04:56 AM »
Following code can be used in which you can select one or more objects for contours :

Code: [Select]

;; Unique  -  Lee Mac
;; Returns a list with duplicate elements removed.
(defun LM:Unique (l / x r)
  (while l
    (setq x (car l)
  l (vl-remove x (cdr l))
  r (cons x r)
    )
  )
  (reverse r)
)

(defun getlayname (/ selset lyrset n ent)
  (setq contourstest nil)
  (while (= contourstest nil)
    (prompt "\nSelect one or more entities to get Contours Layer(s) : ")
    (setq selset (ssget "_:L" '((0 . "*LINE")))) ;(setq selset (ssget "_X" (list (cons 0 "*LINE"))))
    (setq lyrset (list))
    (repeat (setq n (sslength selset))
      (setq ent (ssname selset (setq n (1- n))))
      (setq lyrset (append lyrset (list (vla-get-layer (vlax-ename->vla-object ent)))))
    )
    (setq lyrset (LM:Unique lyrset))
    (setq contourstest
   (ssget "_X"
  (append '((0 . "*LINE") (-4 . "<OR")) (mapcar '(lambda (n) (cons 8 n)) lyrset) '((-4 . "OR>")))
   )
    )
  )
)


Two things have been done :
1.) LM:Unique function has been added. Thanks to Lee Mac
2.) 'getlayname' function has been modified.

danglar

  • Newt
  • Posts: 161
  • Read My Li(s)(p)
Re: Problem with Quick Profile program
« Reply #3 on: December 07, 2015, 06:54:49 AM »
Works PERFECT!
Thank you mailmaverick!

danglar

  • Newt
  • Posts: 161
  • Read My Li(s)(p)
Re: Problem with Quick Profile program
« Reply #4 on: December 07, 2015, 06:59:24 AM »

sanju2323

  • Newt
  • Posts: 68
Re: Problem with Quick Profile program
« Reply #5 on: December 07, 2015, 08:55:58 AM »
Try to select a single time line

danglar

  • Newt
  • Posts: 161
  • Read My Li(s)(p)
Re: Problem with Quick Profile program
« Reply #6 on: December 07, 2015, 10:02:02 AM »
Some problems with your version:
1. Technical: It seems to me, where is a problem with placement of section on the drawing (probably it's personal.. I didn't checked it yet.
2. Logical: You take into account ALL  intersections with horizontal alignment, but not all of it have topological meaning..
I think, need to take to user to choose needful topological data for his own goals.

sanju2323

  • Newt
  • Posts: 68
Re: Problem with Quick Profile program
« Reply #7 on: December 07, 2015, 10:26:37 PM »
danglar,
    Profile creates ucs a default location. If you are having problems, you can use other Lisp.
« Last Edit: December 07, 2015, 10:56:07 PM by sanju2323 »

danglar

  • Newt
  • Posts: 161
  • Read My Li(s)(p)
Re: Problem with Quick Profile program
« Reply #8 on: December 08, 2015, 01:02:41 AM »
Thank you sanju2323!

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Problem with Quick Profile program
« Reply #9 on: December 08, 2015, 01:18:04 AM »
danglar,
    Profile creates ucs a default location. If you are having problems, you can use other Lisp.

Can you please post a .LSP file , not a .VLX.

No one can learn from a compiled file.


Regards,
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

MPD

  • Mosquito
  • Posts: 5
Re: Problem with Quick Profile program
« Reply #10 on: January 17, 2021, 12:41:42 AM »
Hi
how can i draw two profiles or more at once?
i want to pick ground and then the road
 Topic: Problem with Quick Profile program  (Read 1884 times)
« Last Edit: January 17, 2021, 12:53:13 AM by MPD »

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: Problem with Quick Profile program
« Reply #11 on: January 17, 2021, 05:28:57 PM »
Not everything in life is free, do as many as you want, whatever spacing intervals extra chainages etc etc , yes you have to pay CIV3D, Civil Site design and others plenty available.

Re Fas sometimes you don't want to reveal how you worked out a method to solve a problem, I have 1 program will always supply Fas as spent to much time on getting it to work.
A man who never made a mistake never made anything

kirby

  • Newt
  • Posts: 127
Re: Problem with Quick Profile program
« Reply #12 on: January 18, 2021, 11:34:06 AM »
The red line looks like the alignment (includes a horizontal curve further 'east')
the green line looks like a station label

d2010

  • Bull Frog
  • Posts: 323
Re: Problem with Quick Profile program
« Reply #13 on: January 22, 2021, 03:17:09 AM »
The red line looks like the alignment (includes a horizontal curve further 'east')
the green line looks like a station label
Please, You fix this my-error?
I need help.inside "* pp_curbedenivel.lsp (10.22 kB")
Code: [Select]
Select one or more entities to get ContoursLayer/s:
Select objects: Specify opposite corner: 541 found
Select objects:
dfn_getlayname=[((0 . POLYLINE) (8 . Contour))]
; error: bad argument type: safearrayp nil
Code - Auto/Visual Lisp: [Select]
  1. #region
  2. dfn_listptintersect
  3.      //Md5=94e5c11736808bcf4f7cff5cffed9af3
  4. (defun dfn_listptintersect (ha ha_ename ha_object contourstest imul / $rr dof cnivel_object cnivel_ename curvas)
  5. /*c2s: listaxy=nil,
  6.        hazvalue=caddr(vlax.curve_getstartpoint(ha_object)),
  7.        curvas=contourstest,
  8.        ncurvas=sslength(curvas);
  9.        listaxy=nil;
  10.        for(counter=0;counter < ncurvas;counter= (counter+1))
  11.           {   test=nil;
  12.               interlength=rtcan;
  13.               cnivel_ename=ssname(curvas,counter);
  14.               cnivel_object=vlax.ename->vla_object(cnivel_ename);
  15.               cnivelzvalue=caddr(vlax.curve_getstartpoint(cnivel_object));
  16.               ha_entity=subst(cons(38,cnivelzvalue),assoc(38,entget(car(ha))),entget(car(ha)));
  17.               entmod(ha_entity);
  18.               intersectpt=vlax.variant_value(vlax.invoke_method(ha_object,"intersectwith",cnivel_object,acextendnone));
  19.               test=vl.catch_all_apply(read("vlax-safearray->list"),list(intersectpt));
  20.               error=vl.catch_all_error_p(test);
  21.               intersectpt=nil;
  22.               if (error != t)
  23.                 { intersectpt=vlax.safearray->list(intersectpt);
  24.                   interlength=length(intersectpt);
  25.                };
  26.          if (acand(interlength > 3,intersectpt!=nil))
  27.            for(count=0,dividelength= (interlength/3);count < interlength;)
  28.                 newpt=list(nth(count,intersectpt),nth( (count+1),intersectpt),nth( (count+2),intersectpt)),
  29.                   x=vlax.curve_getdistatpoint(ha_ename,newpt),
  30.                   z=caddr(intersectpt),
  31.                   xy=list(x, (z*imul)),
  32.                   listaxy=append(listaxy,list(xy)),
  33.                   count= (count+3);
  34.                  else
  35.                   if (intersectpt!=nil)
  36.                       x=vlax.curve_getdistatpoint(ha_ename,intersectpt),
  37.                       z=caddr(intersectpt),
  38.                       xy=list(x, (z*imul)),
  39.                       listaxy=append(listaxy,list(xy));
  40.  
  41.          ha_entity=subst(cons(38,hazvalue),assoc(38,entget(car(ha))),entget(car(ha)));
  42.          entmod(ha_entity)
  43.        };
  44.    listaxy=vl.sort(listaxy,function(lambda(e1(e2), (car(e1) <car(e2)))));
  45.     startdist=vlax.curve_getdistatpoint(ha_ename,vlax.curve_getstartpoint(ha_ename)),
  46.                  enddist=vlax.curve_getdistatpoint(ha_ename,vlax.curve_getendpoint(ha_ename));
  47.      pt1=car(car(listaxy)),pt2=car(last(listaxy));
  48.    if (startdist != pt1)
  49.          { x=startdist;
  50.            y= ( ( ( (cadr(car(listaxy))-cadr(cadr(listaxy)))/ (car(cadr(listaxy))-car(car(listaxy))))* (car(car(listaxy))-startdist))+cadr(car(listaxy)));
  51.            xy=lISt(x,y);
  52.           listaxy=append(listaxy,lISt(xy));
  53.           listaxy=vl.sort(listaxy,function(lambda(e1(e2), (car(e1) <car(e2)))));
  54.         };
  55.  if (enddist != pt1 )
  56.       { pos= (length(listaxy)-1);
  57.         x=enddist;
  58.         $rr=nth(pos-1,listaxy);
  59.         dof=nth(pos,listaxy);
  60.         y= ( ( ( (cadr(dof)-cadr($rr))/(car(dof)-car($rr)))* (enddist-car(dof)))+cadr(dof));
  61.         xy=lISt(x,y);
  62.         listaxy=append(listaxy,lISt(xy));
  63.         listaxy=vl.sort(listaxy,function(lambda(e1(e2), (car(e1)<car(e2)))));
  64.        };
  65. */
  66. $rr)
  67. %include=vl_load_com
  68. #endregion
  69.  
Colindul „Galbenă gutuie” – Corul bărbătesc Cantus Domini.
a)You open (with BrisCAD) the file "topografie_izohipsele.dwg"
b)You appload "pp_curbedenivel_jcaro10.lsp" from "topografie_izohipsele.cab"
c)You execute , with C:Q2[enter]
d)After, You got the error/s then you execute (princ setmypid)
e)You vlide the file "pp_curbedenivel.lsp"
f)You fix setmypid.error
Code: [Select]
(defun dfn_listptintersect (ha ha_ename ha_object contourstest imul / $rr dof cnivel_object cnivel_ename curvas)
  (setq;|a38908|;
listaxy nil
hazvalue (caddr (vlax-curve-getstartpoint ha_object))
curvas contourstest
ncurvas (sslength curvas)) (setq;|a38996|;
listaxy nil) (progn (setq;|a39014|;
counter 0) (while (<  counter ncurvas) (progn  (setq;|a39074|;
test nil
interlength rtcan
cnivel_ename (ssname curvas counter)
cnivel_object (vlax-ename->vla-object cnivel_ename)
cnivelzvalue (caddr (vlax-curve-getstartpoint cnivel_object))
ha_entity (subst (cons 38 cnivelzvalue) (assoc 38 (entget (car ha))) (entget (car ha)))) (entmod ha_entity) (setq;|a39310|;
intersectpt (vlax-variant-value (vlax-invoke-method ha_object "intersectwith" cnivel_object acextendnone))) (setq;|a39366|;
test (vl-catch-all-apply (read "vlax-safearray->list") (list intersectpt))) (setq;|a39414|;
error (vl-catch-all-error-p test)) (setq;|a39438|;
intersectpt nil) (if (/= error t) (progn  (setq;|a39476|;
intersectpt (vlax-safearray->list intersectpt)
interlength (length intersectpt)))) (if (and (>  interlength 3) (/= intersectpt nil)) (progn  (setq;|a39572|;
count 0
dividelength (/ interlength 3)) (while (<  count interlength) (setq;|a39642|;
newpt (list (nth count intersectpt) (nth (+ count 1) intersectpt) (nth (+ count 2) intersectpt))
x (vlax-curve-getdistatpoint ha_ename newpt)
z (caddr intersectpt)
xy (list x (* z imul))
listaxy (append listaxy (list xy))
count (+ count 3)))) (if (/= intersectpt nil) (setq;|a39930|;
x (vlax-curve-getdistatpoint ha_ename intersectpt)
z (caddr intersectpt)
xy (list x (* z imul))
listaxy (append listaxy (list xy))))) (setq;|a40066|;
ha_entity (subst (cons 38 hazvalue) (assoc 38 (entget (car ha))) (entget (car ha)))) (entmod ha_entity)) (setq;|a40182|;
counter (+ counter 1)))) (setq;|a40204|;
listaxy (vl-sort listaxy (function (lambda (e1 e2) (<  (car e1) (car e2)))))) (setq;|a40296|;
startdist (vlax-curve-getdistatpoint ha_ename (vlax-curve-getstartpoint ha_ename))
enddist (vlax-curve-getdistatpoint ha_ename (vlax-curve-getendpoint ha_ename))) (setq;|a40380|;
pt1 (car (car listaxy))
pt2 (car (last listaxy))) (if (/= startdist pt1) (progn  (setq;|a40472|;
x startdist
y (+ (* (/ (- (cadr (car listaxy)) (cadr (cadr listaxy))) (- (car (cadr listaxy)) (car (car listaxy)))) (- (car (car listaxy)) startdist)) (cadr (car listaxy)))
xy (list x y)
listaxy (append listaxy (list xy))
listaxy (vl-sort listaxy (function (lambda (e1 e2) (<  (car e1) (car e2)))))))) (if (/= enddist pt1) (progn  (setq;|a40830|;
pos (- (length listaxy) 1)
x enddist
$rr (nth (- pos 1) listaxy)
dof (nth pos listaxy)
y (+ (* (/ (- (cadr dof) (cadr $rr)) (- (car dof) (car $rr))) (- enddist (car dof))) (cadr dof))
xy (list x y)
listaxy (append listaxy (list xy))
listaxy (vl-sort listaxy (function (lambda (e1 e2) (<  (car e1) (car e2))))))))
$rr)




« Last Edit: January 22, 2021, 04:17:47 AM by d2010 »