Recent Posts

Pages: 1 2 [3] 4 5 ... 10
21
AutoLISP (Vanilla / Visual) / Re: Polyline and Circle to one polyline
« Last post by Lee Mac on February 19, 2017, 06:33:35 pm »
Superb coding Stefan! - I particularly like the simplicity of your get_partial_bulge to 'scale' the bulge in proportion to the length of the sagitta.

I have a minor suggestion for your m2p function  :-)
Code - Auto/Visual Lisp: [Select]
  1. (defun m2p ( a b )
  2.    (if (numberp a) (/ (+ a b) 2.0) (mapcar 'm2p a b))
  3. )
22
AutoLISP (Vanilla / Visual) / Re: Polyline and Circle to one polyline
« Last post by Stefan on February 19, 2017, 04:52:51 pm »
Hi Coder,
Try this lisp. The circles are positioned to the "right" of the polyline. For a clockwise closed polyline, that would be inside...
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ( / e p d q a b f b1 b2)
  2.  (or *diam* (setq *diam* 100.0))
  3.  (if
  4.    (and
  5.      (setq e (car (entsel)))
  6.      (setq *diam* (cond ((getdist (strcat "\nSpecify circle diameter<" (rtos *diam*) ">: "))) (*diam*)))
  7.      (setq e (vlax-ename->vla-object e)
  8.            d *diam*
  9.      )
  10.    )
  11.    (while (setq p (getpoint "\nSpecify insertion point: "))
  12.            q (vlax-curve-getparamatpoint e p)
  13.            a (fix q)
  14.            b (vla-getbulge e a)
  15.            f (- (angle '(0 0) (vlax-curve-getfirstderiv e q)) (/ pi 2.0)))
  16.      (if
  17.        (equal b 0.0 1e-8)
  18.        (setq b1 nil b2 nil)
  19.        (setq b1 (get_partial_bulge e b a q)
  20.              b2 (get_partial_bulge e b q (+ 1 a))
  21.        )
  22.      )
  23.      (add_vertex e (+ 1 a) p)
  24.      (add_vertex e (+ 2 a) (polar p f d))
  25.      (add_vertex e (+ 3 a) p)
  26.      (vla-setbulge e (+ 1 a) 1.0)
  27.      (vla-setbulge e (+ 2 a) 1.0)
  28.      (if b1 (vla-setbulge e (+ 0 a) b1))
  29.      (if b2 (vla-setbulge e (+ 3 a) b2))
  30.    )
  31.  )
  32.  (princ)
  33. )
  34.  
  35. (defun m2p (a b)
  36.  (if
  37.    (numberp a)
  38.    (/ (+ a b) 2.0)
  39.    (mapcar '(lambda (a b) (/ (+ a b) 2.0)) a b)
  40.  )
  41. )
  42.  
  43. (defun add_vertex (e a p)
  44.      (vlax-make-safearray vlax-vbDouble '(0 . 1))
  45.      (list (car p) (cadr p))
  46.    )
  47.  )
  48. )
  49.  
  50. (defun get_partial_bulge (e b a1 a2 / p1 p2 p3 p4 b1)
  51.  (if
  52.    (equal a1 a2 1e-8)
  53.    b
  54.          p2 (vlax-curve-getpointatparam e a2)
  55.          p3 (vlax-curve-getpointatparam e (m2p a1 a2))
  56.          p4 (m2p p1 p2)
  57.          b1 (/
  58.               (distance p3 p4)
  59.               (distance p1 p4)
  60.               (/ b (abs b))
  61.             )
  62.    )
  63.  )
  64. )

23
AutoLISP (Vanilla / Visual) / Re: Polyline and Circle to one polyline
« Last post by Coder on February 19, 2017, 12:46:55 pm »
Thank you Marko for your beautiful codes, I like that.

You assumed that the polyline is with two end points although its not in my drawing and that just an example in my above images. sorry for that confusion.

Some polylines might have arcs or more than ten segments of each polyline. !

Any other way just to modify the recent polyline with two bulges that represents a circle shape?

Many thanks
24
AutoLISP (Vanilla / Visual) / Re: Polyline and Circle to one polyline
« Last post by ribarm on February 19, 2017, 12:26:16 pm »
I still stay with my statement that that's quite impossible... Try this code and when LWPOLYLINE is created, try to zoom to touching point - you'll see 2 close points, then make line between those points and finally stretch them with grips so that they are coincident with mid point of just created small line... Now when you zoom out, you'll see that circle disappeared leaving just line - so conclusion is that with the code you can make just as close as this one, but touching is not possible...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:lwcitanli ( / p1 p2 li ci osm p d gr pp r c1 c2 c cix li1 li2 par s pea lw lwx )
  2.  (setq p1 (getpoint "\nPick or specify first point : "))
  3.  (setq p2 (getpoint p1 "\nPick or specify second point : "))
  4.  (setq li (entmakex (list '(0 . "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans p2 1 0)) '(62 . 1))))
  5.  (setq ci (entmakex (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") '(10 0.0 0.0 0.0) '(40 . 0.0) '(62 . 1))))
  6.  (setq osm (getvar 'osmode))
  7.  (setvar 'osmode 512)
  8.  (setq p (getpoint "\nPick or specify point on drawn red LINE : "))
  9.  (setvar 'osmode osm)
  10.  (initget 7)
  11.  (setq d (getdist "\nPick or specify diameter of CIRCLE : "))
  12.  (while (/= 3 (car (setq gr (grread t))))
  13.    (setq pp (cadr gr))
  14.    (setq r (/ d 2.0))
  15.    (setq c1 (polar p (+ (angle p1 p2) (* 0.5 pi)) r))
  16.    (setq c2 (polar p (- (angle p1 p2) (* 0.5 pi)) r))
  17.    (if (< (distance pp c1) (distance pp c2))
  18.      (setq cix (list (cons -1 ci) (cons 10 (setq c c1)) (cons 40 r)))
  19.      (setq cix (list (cons -1 ci) (cons 10 (setq c c2)) (cons 40 r)))
  20.    )
  21.    (entupd (cdr (assoc -1 (entmod cix))))
  22.  )
  23.  (entdel ci)
  24.  (command "_.BREAK" "_non" p "_non" p)
  25.  (setq li1 li)
  26.  (setq li2 (entlast))
  27.  (entdel ci)
  28.  (setq p1 (vlax-curve-getpointatparam ci (- par (cvunit 0.01 "degree" "radian"))))
  29.  (setq p2 (vlax-curve-getpointatparam ci (+ par (cvunit 0.01 "degree" "radian"))))
  30.  (entdel li1)
  31.  (entdel li2)
  32.  (command "_.BREAK" "_non" (trans p1 0 1) "_non" (trans p2 0 1))
  33.  (entdel li1)
  34.  (entdel li2)
  35.  (entupd (cdr (assoc -1
  36.    (entmod
  37.      (cond
  38.        ( (equal (assoc 10 (entget li1)) (cons 10 p) 1e-6)
  39.          (subst (cons 10 (if (< (distance p1 (cdr (assoc 11 (entget li1)))) (distance p2 (cdr (assoc 11 (entget li1))))) p1 p2)) (assoc 10 (entget li1)) (entget li1))
  40.        )
  41.        ( (equal (assoc 11 (entget li1)) (cons 11 p) 1e-6)
  42.          (subst (cons 11 (if (< (distance p1 (cdr (assoc 10 (entget li1)))) (distance p2 (cdr (assoc 10 (entget li1))))) p1 p2)) (assoc 11 (entget li1)) (entget li1))
  43.        )
  44.      )
  45.    )
  46.  )))
  47.  (entupd (cdr (assoc -1
  48.    (entmod
  49.      (cond
  50.        ( (equal (assoc 10 (entget li2)) (cons 10 p) 1e-6)
  51.          (subst (cons 10 (if (< (distance p1 (cdr (assoc 11 (entget li2)))) (distance p2 (cdr (assoc 11 (entget li2))))) p1 p2)) (assoc 10 (entget li2)) (entget li2))
  52.        )
  53.        ( (equal (assoc 11 (entget li2)) (cons 11 p) 1e-6)
  54.          (subst (cons 11 (if (< (distance p1 (cdr (assoc 10 (entget li2)))) (distance p2 (cdr (assoc 10 (entget li2))))) p1 p2)) (assoc 11 (entget li2)) (entget li2))
  55.        )
  56.      )
  57.    )
  58.  )))
  59.  (setq s (ssadd))
  60.  (ssadd li1 s)
  61.  (ssadd li2 s)
  62.  (ssadd ci s)
  63.  (setq pea (getvar 'peditaccept))
  64.  (setvar 'peditaccept 1)
  65.  (command "_.PEDIT" "_M" s "" "_J" "_J" "_E" 0.0 "")
  66.  (setvar 'peditaccept pea)
  67.  (setq lw (entlast))
  68.  (setq lwx (entget lw))
  69.  ;|
  70.   (entupd (cdr (assoc -1 (entmod (setq lwx (subst (cons 10 p) (cons 10 p1) lwx))))))
  71.   (entupd (cdr (assoc -1 (entmod (setq lwx (subst (cons 10 p) (cons 10 p2) lwx))))))
  72.   |;
  73.  (entupd (cdr (assoc -1 (entmod (subst '(62 . 3) '(62 . 1) lwx)))))
  74.  (princ)
  75. )
  76.  

BTW. If you remove comment to 2 lines that were commented at the end of code, CAD won't (entmod) LWPOLYLINE like it's expected... So even CAD knows when it's much, it's too much...
25
AutoLISP (Vanilla / Visual) / Re: Polyline and Circle to one polyline
« Last post by ribarm on February 19, 2017, 10:36:58 am »
Not exactly what you're looking for, but it's close to it... And I am not sure if your example is actually possible to make with LWPOLYLINE...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:lwcitanli ( / p1 p2 li ci gr p pp r c cix )
  2.  
  3.  
  4.  (setq p1 (getpoint "\nPick or specify first point : "))
  5.  (setq p2 (getpoint p1 "\nPick or specify second point : "))
  6.  (setq li (entmakex (list '(0 . "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans p2 1 0)) '(62 . 1))))
  7.  (setq ci (entmakex (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") '(10 0.0 0.0 0.0) '(40 . 0.0) '(62 . 1))))
  8.  (while (/= 3 (car (setq gr (grread t))))
  9.    (setq p (trans (cadr gr) 1 0))
  10.      (progn
  11.        (setq r (/ (distance p pp) 2.0))
  12.        (setq c (mapcar '/ (mapcar '+ p pp) (list 2.0 2.0 2.0)))
  13.        (setq cix (list (cons -1 ci) (cons 10 c) (cons 40 r)))
  14.        (entupd (cdr (assoc -1 (entmod cix))))
  15.      )
  16.    )
  17.  )
  18.  (entdel li)
  19.  (entdel ci)
  20.    (list
  21.      '(0 . "LWPOLYLINE")
  22.      '(100 . "AcDbEntity")
  23.      '(100 . "AcDbPolyline")
  24.      '(90 . 5)
  25.      (cons 70 (* (getvar 'plinegen) 128))
  26.      '(38 . 0.0)
  27.      (cons 10 (trans p1 1 0))
  28.      (cons 10 pp)
  29.      (cons 42 1.0)
  30.      (cons 10 p)
  31.      (cons 42 1.0)
  32.      (cons 10 pp)
  33.      (cons 10 (trans p2 1 0))
  34.      (list 210 0.0 0.0 1.0)
  35.      '(62 . 3)
  36.    )
  37.  )
  38.  (princ)
  39. )
  40.  
26
AutoLISP (Vanilla / Visual) / Re: Attributes and Fields
« Last post by Grrr1337 on February 19, 2017, 10:09:13 am »
I have some experience with fields, and I keep such subfunction somewhere in my library, although I've forgot to use it.
Thanks again! :)
Hopefully this thread will help for anyone that gets stuck on the same problem.
27
AutoLISP (Vanilla / Visual) / Re: Polyline and Circle to one polyline
« Last post by Coder on February 19, 2017, 09:26:29 am »
Thank you David for your inputs.

I am happy that it is doable and the direction of circle is not that important.
Can you please give any example ?

Thanks.
28
AutoLISP (Vanilla / Visual) / Re: Attributes and Fields
« Last post by Lee Mac on February 19, 2017, 09:03:13 am »
I'm glad you were able to find the source of the problem. :-)

Be careful when using this technique to obtain the ObjectID when working with 32-bit/64-bit systems, as alternative methods must be used to obtain the ObjectID in order to account for the 32-bit upper limit for signed integers in AutoLISP. You may wish to refer to my LM:objectid function as part of my Area Field to Attribute program as an example of how I account for this.
29
.NET / Re: CIVIL 3D - Get profile full contour elevation into plan view
« Last post by jcoon on February 19, 2017, 08:40:46 am »
Jeff,

It looks like one of my posts didn't work. not sure why.

Wow, this a lot more complex than I was thinking. It's certainly a lot of work. It's going to take me some time to convert from C so I can use it. Still haven't learned C. I don't do enough apps work now to justify it. Thanks so much, Let me give this a try. Your a great help!

John
30
AutoLISP (Vanilla / Visual) / Re: Attributes and Fields
« Last post by Grrr1337 on February 19, 2017, 08:26:51 am »
Thanks for the input, Lee...
However that was not the problem - I did found the solution:
Code - Auto/Visual Lisp: [Select]
  1. (vla-put-TextString dAtt (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vlax-get sAtt 'ObjectId)) ">%).TextString>%")) ; doesn't work
Code - Auto/Visual Lisp: [Select]
  1. (vla-put-TextString dAtt (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectId sAtt)) ">%).TextString>%")) ; works
Seems like vlax-get/vlax-put must be avoided when populating with FIELDS, and use vla-get-*/vla-put-* instead.
Pages: 1 2 [3] 4 5 ... 10