Topic: lwsdvts.lsp - problem with BricsCAD V23...

[ribarm]

Hello...

I have coded this lisp that should do everything like PLDiet.lsp by Kent Cooper from Autodesk site, but applicable for all LWPOLYLINE standard types : straight and arced... Test it with my DWG... But I tried it in AutoCAD 2022 - it worked; tried it in BricsCAD V21 - it worked, but in BricsCAD V23 - it removed middle vertices only on single arced one LWPOLYLINE... What am I missing here, if I am missing ? I haven't done any magic thing with variables, but I just don't know, why this happens...
Anyway, if you find the code useful, you can use it...

Code - Auto/Visual Lisp: [Select]

1. (defun c:lwsdvts ( / *error* ftoa groupbynum assocon tang prelst suflst foo process osm cmd ss ti i pl obj len )
2.  
3.   (defun *error* ( m )
4.     (if (= 8 (logand 8 (getvar (quote undoctl))))
5.       (if command-s
6.         (command-s "_.UNDO" "_E")
7.         (vl-cmdf "_.UNDO" "_E")
8.       )
9.     )
10.     (if cmd
11.       (setvar (quote cmdecho) cmd)
12.     )
13.     (if osm
14.       (setvar (quote osmode) osm)
15.     )
16.     (if m
17.       (prompt m)
18.     )
19.     (princ)
20.   )
21.  
22.   (defun ftoa ( n / m a s b )
23.     (if (numberp n)
24.       (progn
25.         (setq m (fix ((if (< n 0) - +) n 1e-8)))
26.         (setq a (abs (- n m)))
27.         (setq m (itoa m))
28.         (setq s "")
29.         (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
30.           (setq s (strcat s (itoa b)))
31.           (setq a (- (* a 10.0) b))
32.         )
33.         (if (= (type n) (quote int))
34.           m
35.           (if (= s "")
36.             m
37.             (if (and (= m "0") (< n 0))
38.               (strcat "-" m "." s)
39.               (strcat m "." s)
40.             )
41.           )
42.         )
43.       )
44.     )
45.   )
46.  
47.   (defun groupbynum ( lst n / sub lll )
48.  
49.     (defun sub ( m n / ll q )
50.       (cond
51.         ( (and m (< (length m) n))
52.           (repeat (- n (length m))
53.             (setq m (append m (list nil)))
54.           )
55.           (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m))
56.           (setq lll (cons ll lll))
57.           (setq q nil)
58.           (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n)
59.         )
60.         ( m
61.           (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m))
62.           (setq lll (cons ll lll))
63.           (setq q nil)
64.           (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n)
65.         )
66.         ( t
67.           (reverse lll)
68.         )
69.       )
70.     )
71.  
72.     (sub lst n)
73.   )
74.  
75.   (defun assocon ( searchterm lst func fuzz )
76.     (car
77.       (vl-member-if
78.         (function (lambda ( pair )
79.           (equal searchterm (func pair) fuzz)
80.         ))
81.         lst
82.       )
83.     )
84.   )
85.  
86.   (defun tang ( a )
87.     (if (not (equal (cos a) 0.0 1e-8))
88.       (/ (sin a) (cos a))
89.       (if (minusp (cos a))
90.         -1e+308
91.         1e+308
92.       )
93.     )
94.   )
95.  
96.   (defun prelst ( lst el index / f n )
97.     (vl-remove-if
98.       (function (lambda ( a )
99.         (setq n (if (not n) 0 (1+ n)))
100.         (cond
101.           ( el
102.             (if (equal a el 1e-6)
103.               (not (setq f t))
104.               f
105.             )
106.           )
107.           ( index
108.             (if (= index n)
109.               (not (setq f t))
110.               f
111.             )
112.           )
113.         )
114.       ))
115.       lst
116.     )
117.   )
118.  
119.   (defun suflst ( lst el index / f n )
120.     (setq f t)
121.     (vl-remove-if
122.       (function (lambda ( a )
123.         (setq n (if (not n) 0 (1+ n)))
124.         (cond
125.           ( el
126.             (if (equal a el 1e-6)
127.               (setq f nil)
128.             )
129.           )
130.           ( index
131.             (if (= index n)
132.               (setq f nil)
133.             )
134.           )
135.         )
136.         f
137.       ))
138.       lst
139.     )
140.   )
141.  
142.   (defun foo ( pl pt par / plx bul parp ptp bulp a1 r1 c1 parn ptn a2 r2 c2 bulpn pll pllp plls plll )
143.     (gc)
144.     (if
145.       (and
146.         pl (not (vlax-erased-p pl)) (= (type pl) (quote ename)) (= "LWPOLYLINE" (cdr (assoc 0 (setq plx (entget pl)))))
147.         pt (= (type pt) (quote list)) (vl-every (function numberp) pt)
148.         par (= (type par) (quote real))
149.         (> (length (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) plx)) 2)
150.       )
151.       (progn
152.         (setq pt (trans pt 0 pl))
153.         (setq pt (mapcar (function +) (list 0.0 0.0) pt))
154.         (setq bul (cdr (assoc 42 (vl-member-if (function (lambda ( x ) (equal x (assocon pt plx cdr 1e-6) 1e-6))) plx))))
155.         (setq parp (1- par))
156.         (setq ptp (vlax-curve-getpointatparam pl parp))
157.         (setq ptp (trans ptp 0 pl))
158.         (setq ptp (mapcar (function +) (list 0.0 0.0) ptp))
159.         (setq bulp (cdr (assoc 42 (vl-member-if (function (lambda ( x ) (equal x (assocon ptp plx cdr 1e-6) 1e-6))) plx))))
160.         (if (/= bulp 0.0)
161.           (progn
162.             (setq a1 (* 4.0 (atan bulp)))
163.             (setq r1 (/ (distance ptp pt) (* 2 (sin (* 2 (atan bulp))))))
164.             (setq c1 (polar ptp (+ (angle ptp pt) (- (/ pi 2.0) (* 2 (atan bulp)))) r1))
165.             (if (/= bul 0.0)
166.               (progn
167.                 (setq parn (+ par 1.0))
168.                 (setq ptn (vlax-curve-getpointatparam pl parn))
169.                 (setq ptn (trans ptn 0 pl))
170.                 (setq ptn (mapcar (function +) (list 0.0 0.0) ptn))
171.                 (setq a2 (* 4.0 (atan bul)))
172.                 (setq r2 (/ (distance pt ptn) (* 2 (sin (* 2 (atan bul))))))
173.                 (setq c2 (polar pt (+ (angle pt ptn) (- (/ pi 2.0) (* 2 (atan bul)))) r2))
174.                 (if (and (equal r1 r2 1e-6) (equal c1 c2 1e-6))
175.                   (setq bulpn (tang (/ (+ a1 a2) 4.0)))
176.                 )
177.               )
178.               (setq bulpn 0.0)
179.             )
180.           )
181.           (setq bulpn 0.0)
182.         )
183.         (setq pll plx)
184.         (setq pll (append (reverse (cdr (reverse (prelst pll (assocon pt pll cdr 1e-6) nil)))) (cdr ((if (assoc 91 pll) cddddr cdddr) (suflst pll (assocon pt pll cdr 1e-6) nil)))))
185.         (setq pllp (reverse (cdr (reverse (prelst pll (assocon ptp pll cdr 1e-6) nil)))))
186.         (setq plls (cdr (suflst pll (assocon ptp pll cdr 1e-6) nil)))
187.         (setq plls (subst (cons 42 (if bulpn bulpn 0.0)) (assoc 42 plls) plls))
188.         (setq plll (append pllp (list (assocon ptp pll cdr 1e-6)) plls))
189.         (if (not (equal plx plll 1e-6))
190.           (setq plll (subst (cons 90 (1- (cdr (assoc 90 plll)))) (assoc 90 plll) plll))
191.         )
192.         (entupd (cdr (assoc -1 (entmod plll))))
193.       )
194.     )
195.   )
196.  
197.   (defun process ( pl obj len / loop coords coordsn par pts f )
198.     (gc)
199.     (setq loop t)
200.     (while loop
201.       (setq coords (safearray-value (variant-value (vla-get-coordinates obj))))
202.       (setq pts (groupbynum coords 2))
203.       (setq pts (cdr (reverse (cdr (reverse pts)))))
204.       (foreach pt pts
205.         (if command-s
206.           (command-s "_.UNDO" "_G")
207.           (vl-cmdf "_.UNDO" "_G")
208.         )
209.         (vl-catch-all-apply
210.           (function foo)
211.           (list
212.             pl
213.             (trans pt pl 0)
214.             (setq par (float (fix (+ 1e-6 (vlax-curve-getparamatpoint pl (vlax-curve-getclosestpointto pl (trans pt pl 0)))))))
215.           )
216.         )
217.         (if (not (equal len (vla-get-length obj) 1e-3))
218.           (if command-s
219.             (command-s "_.UNDO" 1)
220.             (vl-cmdf "_.UNDO" 1)
221.           )
222.         )
223.       )
224.       (vla-update obj)
225.       (setq coordsn (safearray-value (variant-value (vla-get-coordinates obj))))
226.       (cond
227.         ( (/= (length coords) (length coordsn)) )
228.         ( (and (not f) (= (length coords) (length coordsn)))
229.           (setq f t)
230.         )
231.         ( t
232.           (setq loop nil)
233.         )
234.       )
235.     )
236.   )
237.  
238.   (or cad (progn (vl-load-com) (setq cad (vlax-get-acad-object))))
239.   (or doc (setq doc (vla-get-activedocument cad)))
240.   (or spc (setq spc (vla-get-block (setq alo (vla-get-activelayout doc)))))
241.   (setq osm (getvar (quote osmode)))
242.   (setvar (quote osmode) 0)
243.   (setq cmd (getvar (quote cmdecho)))
244.   (setvar (quote cmdecho) 0)
245.   (if (= 8 (logand 8 (getvar (quote undoctl))))
246.     (if command-s
247.       (command-s "_.UNDO" "_E")
248.       (vl-cmdf "_.UNDO" "_E")
249.     )
250.   )
251.   (if command-s
252.     (command-s "_.UNDO" "_M")
253.     (vl-cmdf "_.UNDO" "_M")
254.   )
255.   (prompt "\nSelect LWPOLYLINE(S) on unlocked layer(s)...")
256.   (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE"))))
257.     (progn
258.       (setq ti (car (_vl-times)))
259.       (repeat (setq i (sslength ss))
260.         (gc)
261.         (setq pl (ssname ss (setq i (1- i))))
262.         (setq obj (vlax-ename->vla-object pl))
263.         (setq len (vla-get-length obj))
264.         (process pl obj len)
265.       )
266.       (prompt "\nElapsed time : ") (princ (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
267.       (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
268.     )
269.   )
270.   (*error* nil)
271. )
272.  

Regards, M.R.

[EDIT] I just checked - it only works correct on BricsCAD V21.2.04 - for more recent versions it only clears single LWPOLY... [/EDIT]

[mhupp]

Have you asked BricsCAD? Here at work we are all on different versions. I have noticed some lisps work better on certain versions. then we use the same lisp on a different computer and it ends up crash the drawing. but only if things were done in a certain order. tried to recreate the error on the original Computer and it wouldn't crash. its probably how they are handling the lisp between version.

[ribarm]

For segmentation and for testing, here is the one that implements vertices...

Code - Auto/Visual Lisp: [Select]

1. (defun c:lwssegsavts ( / *error* add_vtx tttt wcs initvalueslst ucsf ti ss ii n dp i k lw p par )
2.  
3.   (defun *error* ( m )
4.     (if wcs
5.       (if ucsf
6.         (exe (list "_.UCS" "_P"))
7.       )
8.     )
9.     (while (= 8 (logand 8 (getvar (quote undoctl))))
10.       (if (not (exe (list "_.UNDO" "_E")))
11.         (if doc
12.           (vla-endundomark doc)
13.         )
14.       )
15.     )
16.     (if initvalueslst
17.       (mapcar (function apply_cadr->car) initvalueslst)
18.     )
19.     (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
20.       (setq fun nil)
21.     )
22.     (if doc
23.       (vla-regen doc acactiveviewport)
24.     )
25.     (if m
26.       (prompt m)
27.     )
28.     (princ)
29.   )
30.  
31.   (defun add_vtx ( ent_name par / obj bulg sw ew )
32.     (setq obj (vlax-ename->vla-object ent_name))
33.     (vla-GetWidth obj (fix par) 'sw 'ew)
34.     (vla-addVertex
35.       obj
36.       (1+ (fix par))
37.       (vlax-make-variant
38.         (vlax-safearray-fill
39.           (vlax-make-safearray vlax-vbdouble (cons 0 1))
40.           (list
41.             (car (trans (vlax-curve-getpointatparam obj par) 0 ent_name))
42.             (cadr (trans (vlax-curve-getpointatparam obj par) 0 ent_name))
43.           )
44.         )
45.       )
46.     )
47.     (setq bulg (vla-GetBulge obj (fix par)))
48.     (vla-SetBulge obj
49.       (fix par)
50.       (/
51.         (sin (/ (* 4 (atan bulg) (- par (fix par))) 4))
52.         (cos (/ (* 4 (atan bulg) (- par (fix par))) 4))
53.       )
54.     )
55.     (vla-SetBulge obj
56.       (1+ (fix par))
57.       (/
58.         (sin (/ (* 4 (atan bulg) (- (1+ (fix par)) par)) 4))
59.         (cos (/ (* 4 (atan bulg) (- (1+ (fix par)) par)) 4))
60.       )
61.     )
62.     (vla-SetWidth obj (fix par) sw (+ sw (* (- ew sw) (- par (fix par)))))
63.     (vla-SetWidth obj (1+ (fix par)) (+ sw (* (- ew sw) (- par (fix par)))) ew)
64.     (vla-update obj)
65.   )
66.  
67.   (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;
68.  
69.     (defun vl-load nil
70.       (or cad
71.         (if vlax-get-acad-object
72.           (setq cad (vlax-get-acad-object))
73.           (progn
74.             (vl-load-com)
75.             (setq cad (vlax-get-acad-object))
76.           )
77.         )
78.       )
79.       (or doc (setq doc (vla-get-activedocument cad)))
80.       (or alo (setq alo (vla-get-activelayout doc)))
81.       (or spc (setq spc (vla-get-block alo)))
82.     )
83.  
84.     ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
85.     (or (and cad doc alo spc) (vl-load))
86.  
87.     (defun exe ( tokenslist )
88.       ( (lambda ( tokenslist / ctch )
89.           (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
90.             (progn
91.               (cmderr tokenslist)
92.               (catch_cont ctch)
93.             )
94.             (progn
95.               (while (< 0 (getvar (quote cmdactive)))
96.                 (vl-cmdf "")
97.               )
98.               t
99.             )
100.           )
101.         )
102.         tokenslist
103.       )
104.     )
105.  
106.     (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
107.       (if command-s
108.         (if flag
109.           (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
110.             flag
111.             ctch
112.           )
113.           (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
114.             ctch
115.           )
116.         )
117.         (if flag
118.           (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
119.             flag
120.             ctch
121.           )
122.           (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
123.             ctch
124.           )
125.         )
126.       )
127.     )
128.  
129.     (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
130.       (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
131.     )
132.  
133.     (defun catch_cont ( ctch / gr )
134.       (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
135.       (while
136.         (and
137.           (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
138.           (setq gr (grread))
139.           (/= (car gr) 3)
140.           (not (equal gr (list 2 13)))
141.         )
142.       )
143.       (if (vl-catch-all-error-p ctch)
144.         ctch
145.       )
146.     )
147.  
148.     (defun apply_cadr->car ( sysvarvaluepair / ctch )
149.       (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
150.       (if (vl-catch-all-error-p ctch)
151.         (progn
152.           (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
153.           (catch_cont ctch)
154.         )
155.       )
156.     )
157.  
158.     (defun ftoa ( n / m a s b )
159.       (if (numberp n)
160.         (progn
161.           (setq m (fix ((if (< n 0) - +) n 1e-8)))
162.           (setq a (abs (- n m)))
163.           (setq m (itoa m))
164.           (setq s "")
165.           (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
166.             (setq s (strcat s (itoa b)))
167.             (setq a (- (* a 10.0) b))
168.           )
169.           (if (= (type n) (quote int))
170.             m
171.             (if (= s "")
172.               m
173.               (if (and (= m "0") (< n 0))
174.                 (strcat "-" m "." s)
175.                 (strcat m "." s)
176.               )
177.             )
178.           )
179.         )
180.       )
181.     )
182.  
183.     (setq sysvarpreset
184.       (list
185.         (list (quote cmdecho) 0)
186.         (list (quote 3dosmode) 0)
187.         (list (quote osmode) 0)
188.         (list (quote unitmode) 0)
189.         (list (quote cmddia) 0)
190.         (list (quote ucsvp) 0)
191.         (list (quote ucsortho) 0)
192.         (list (quote projmode) 0)
193.         (list (quote orbitautotarget) 0)
194.         (list (quote insunits) 0)
195.         (list (quote hpseparate) 0)
196.         (list (quote hpgaptol) 0)
197.         (list (quote halogap) 0)
198.         (list (quote edgemode) 0)
199.         (list (quote pickdrag) 0)
200.         (list (quote qtextmode) 0)
201.         (list (quote dragsnap) 0)
202.         (list (quote angdir) 0)
203.         (list (quote aunits) 0)
204.         (list (quote limcheck) 0)
205.         (list (quote gridmode) 0)
206.         (list (quote nomutt) 0)
207.         (list (quote apbox) 0)
208.         (list (quote attdia) 0)
209.         (list (quote blipmode) 0)
210.         (list (quote copymode) 0)
211.         (list (quote circlerad) 0.0)
212.         (list (quote filletrad) 0.0)
213.         (list (quote filedia) 1)
214.         (list (quote autosnap) 1)
215.         (list (quote objectisolationmode) 1)
216.         (list (quote highlight) 1)
217.         (list (quote lispinit) 1)
218.         (list (quote layerpmode) 1)
219.         (list (quote fillmode) 1)
220.         (list (quote dragmodeinterrupt) 1)
221.         (list (quote dispsilh) 1)
222.         (list (quote fielddisplay) 1)
223.         (list (quote deletetool) 1)
224.         (list (quote delobj) 1)
225.         (list (quote dblclkedit) 1)
226.         (list (quote attreq) 1)
227.         (list (quote explmode) 1)
228.         (list (quote frameselection) 1)
229.         (list (quote ltgapselection) 1)
230.         (list (quote pickfirst) 1)
231.         (list (quote plinegen) 1)
232.         (list (quote plinetype) 1)
233.         (list (quote peditaccept) 1)
234.         (list (quote solidcheck) 1)
235.         (list (quote visretain) 1)
236.         (list (quote regenmode) 1)
237.         (list (quote celtscale) 1.0)
238.         (list (quote ltscale) 1.0)
239.         (list (quote osnapcoord) 2)
240.         (list (quote grips) 2)
241.         (list (quote dragmode) 2)
242.         (list (quote lunits) 2)
243.         (list (quote pickstyle) 3)
244.         (list (quote navvcubedisplay) 3)
245.         (list (quote pickauto) 3)
246.         (list (quote draworderctl) 3)
247.         (list (quote expert) 5)
248.         (list (quote auprec) 6)
249.         (list (quote luprec) 6)
250.         (list (quote pickbox) 6)
251.         (list (quote aperture) 6)
252.         (list (quote osoptions) 7)
253.         (list (quote dimzin) 8)
254.         (list (quote pdmode) 35)
255.         (list (quote pdsize) -1.5)
256.         (list (quote celweight) -1)
257.         (list (quote cecolor) "BYLAYER")
258.         (list (quote celtype) "ByLayer")
259.         (list (quote clayer) "0")
260.       )
261.     )
262.     (setq sysvarlst (mapcar (function car) sysvarpreset))
263.     (setq sysvarvals (mapcar (function cadr) sysvarpreset))
264.     (setq sysvarvals
265.       (vl-remove nil
266.         (mapcar
267.           (function (lambda ( x )
268.             (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
269.           ))
270.           sysvarlst
271.         )
272.       )
273.     )
274.     (setq sysvarlst
275.       (vl-remove-if-not
276.         (function (lambda ( x )
277.           (getvar x)
278.         ))
279.         sysvarlst
280.       )
281.     )
282.     (setq initvalueslst
283.       (apply (function mapcar)
284.         (cons (function list)
285.           (list
286.             sysvarlst
287.             (mapcar (function getvar) sysvarlst)
288.           )
289.         )
290.       )
291.     )
292.     (apply (function mapcar)
293.       (cons (function setvar)
294.         (list
295.           sysvarlst
296.           sysvarvals
297.         )
298.       )
299.     )
300.     (while (= 8 (logand 8 (getvar (quote undoctl))))
301.       (if (not (exe (list "_.UNDO" "_E")))
302.         (if doc
303.           (vla-endundomark doc)
304.         )
305.       )
306.     )
307.     (if (not (exe (list "_.UNDO" "_M")))
308.       (if doc
309.         (vla-startundomark doc)
310.       )
311.     )
312.     (if wcs
313.       (if (= 0 (getvar (quote worlducs)))
314.         (progn
315.           (exe (list "_.UCS" "_W"))
316.           (setq ucsf t)
317.         )
318.       )
319.     )
320.     wcs
321.   )
322.  
323.   (setq wcs (tttt nil))
324.   (initget 7)
325.   (setq n (getint "\nSpecify number of points along each segment without start/end points that will be also processed : "))
326.   (prompt "\nSelect LWPOLYLINE(S) on unlocked layer(s)...")
327.   (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE"))))
328.     (progn
329.       (setq ti (car (_vl-times)))
330.       (repeat (setq ii (sslength ss))
331.         (setq lw (ssname ss (setq ii (1- ii))))
332.         (setq i 0 k 0)
333.         (repeat (fix (vlax-curve-getendparam lw))
334.           (setq k (1+ k))
335.           (repeat (1+ n)
336.             (setq dp (/ 1.0 (- (* k (1+ (float n))) i)))
337.             (setq p (vlax-curve-getpointatparam lw (+ i dp)))
338.             (setq par (vlax-curve-getparamatpoint lw p))
339.             (if (not (equal par (fix par) 1e-6))
340.               (progn
341.                 (add_vtx lw par)
342.                 (setq i (1+ i))
343.               )
344.               (setq i (1+ i))
345.             )
346.           )
347.         )
348.       )
349.       (prompt "\nElapsed time : ") (princ (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
350.     )
351.   )
352.   (*error* nil)
353. )
354.  

HTH.
M.R.

[ribarm]

Just to inform, lwsdvts.lsp has worked with only single pass... Just checked - after single pass it could happen that some middle vertices, or vertex remains, so I've decided to do (reversecurve lw), do another pass and put it back like it was before with another (reversecurve lw)... And after checking it worked - it removed all that should... So this routine attached to first post is better than PLDiet.lsp by Kent Cooper... So look into first post *.lsp is attached as it had more than 20000 chars...

[EDIT] I've shorten it as some things repeated - it comes less than 20000 chars, so still a file and the code fully correct [/EDIT]

Regards, M.R.

[ribarm]

Have anyone found a solution for "lwsdvts.lsp" for BricsCAD V23 (x64)...

Thanks for your opinions...

[BIGAL]

Bricscad are very helpful with problems in code I contacted support about a problem to do with Alert and they supplied a work around till next version fixed. So post to them.

Just a real guess there was an update to all the Vlax calls I have V20 and lots are missing some 200+ were added in later versions. Just a guess.

[ribarm]

Bricscad are very helpful with problems in code I contacted support about a problem to do with Alert and they supplied a work around till next version fixed. So post to them.

Just a real guess there was an update to all the Vlax calls I have V20 and lots are missing some 200+ were added in later versions. Just a guess.

I've changed initial code, but the same - BricsCAD V21 - fine, AutoCAD 2022 - fine, BricsCAD V23 - not good...
And BTW. I don't know how to contact support - perhaps someone else is capable more than me... To me here in site, everything is visible - check-able...

[danAllen]

And BTW. I don't know how to contact support - perhaps someone else is capable more than me... To me here in site, everything is visible - check-able...

Post to forum? (needs forum login)
https://forum.bricsys.com/categories/programming-and-customization

Post a support request? (needs license login)
https://www.bricsys.com/protected/support/NewSupportRequest.do

I'm still running BC v15, so can't help

[ribarm]

And BTW. I don't know how to contact support - perhaps someone else is capable more than me... To me here in site, everything is visible - check-able...

Post to forum? (needs forum login)
https://forum.bricsys.com/categories/programming-and-customization

Post a support request? (needs license login)
https://www.bricsys.com/protected/support/NewSupportRequest.do

I'm still running BC v15, so can't help

The problem was the code after all... I've updated it in the first post and reattached *.lsp...

HTH.
M.R.