Community
It's not clear to me whether "how it needs to work" is how you think it should be working as written but it isn't, or is "how it works now" correct as written, and you are looking for a modification to make it "how it needs to work." If it's the former, without studying it too deeply, could it be simply that Object snap is on too long? Does it fix it if you move the turning off of running Osnap:
(setvar "osmode" 0)
to earlier, somewhere before the first Line command?
But I suspect it's the latter, since I don't see any 1.5 value as I would expect in the code anywhere.
EDIT: I can't test it, because you did not include a definition of the (working) function. There are some other things that seem peculiar to me, but later....
Kent Cooper, AIA 
[Still no definition of (working).]
Are the white parts in the image a Polyline? Or separate Lines? It would be far easier to Offset the Polyline [see @john.uhden's link], or to Join the Lines into a Polyline and then Offset it, than to go through all the complications you have. Adjusting the ends of the Offset result, and drawing from them to the original Polyline, should not be difficult.
An example of part of it that seems peculiar to me:
(setq xw (getdist "\nDepth of exposed slab edge <4\">: "))
(if (= xw nil)(setq xw 4.0))
; SO 'xw' WILL ALWAYS BE EITHER THE USER INPUT OR 4.0, WHICH MEANS:
(if
(or (= xw nil) (= xw "")); NEITHER OF THESE WILL EVER BE THE CASE [the 2nd one can't be anyway]
(eval nil); then ; SO IT WILL NEVER DO THIS [what would the purpose be, anyway?]
(setq w xw); else ; BUT WILL ALWAYS DO THIS
); if
So just do that last line (setq w xw) without the (if) function enclosing it.
Kent Cooper, AIA
@john.uhden wrote:
.....
I presume that you would want the bottom and sides to be on a different layer (please provide the name).
....
Already there.
Kent Cooper, AIA
Hi @DC-MWA
I'm currently at work , will try to decode your current code later today.
Some notes:
(if (= something nil)...)
;replace with
(if (null something)...)(command ".erase" (entlast) "")
;replace with
(entdel (entlast))(if (/= f1 nil).....
;replace with
(if f1 ....
;in this case I use
(if (and f1)Try to replace nested IF commands with COND since it makes code easier to follow
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@hak_vz wrote:
....
(if (/= f1 nil)..... ;replace with (if f1 .... ;in this case I use (if (and f1)....
In this case, what purpose is served by putting f1 into an (and) function? Yes, the return from line 3 will be either what's in f1 or nil, while the return from line 5 will be either T or nil. But all the (if) function cares about is whether it's nil or anything else, so it can't make any difference to the outcome.
Kent Cooper, AIA
@DC-MWA ,
I'm a bit tardy here, but I couldn't resist. It has some klunky lines (of code) as it was written for and tested in ACAD2002, but it should work. Please let me know if it doesn't, and how it doesn't.
I'm pretty sure this does what you want. Plus it ignores jagged segments outside the 1.5 unit zone.
(defun c:screed3 ( / *error* vars vals e1 obj1 e2 obj2 e3 obj3
e4 obj4 ent p1 p2 p3 p4 d)
(gc)
(vl-load-com)
(princ "SCREED3 v1.0 (c)2024, John F. Uhden for @DC-MWA.\n")
(defun *error* (err)
(mapcar 'setvar vars vals)
(vla-endundomark *doc*)
(cond
((not err))
((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
(1 (princ (strcat "\nERROR: " err)))
)
(princ)
)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
(vla-endundomark *doc*)
(vla-startundomark *doc*)
(setq vars '("cmdecho" "osmode"))
(setq vals (mapcar 'getvar vars))
(mapcar 'setvar vars '(0 0))
(command "_.expert" (getvar "expert")) ;; dummy command
(and ;; The Stephan Koster approach
(setq e1 (car (entsel "\nSelect surface LWpolyline: ")))
(setq obj1 (vlax-ename->vla-object e1))
(setq p1 (vlax-curve-getstartpoint obj1))
(setq p3 (vlax-curve-getendpoint obj1))
(or
(> (abs (apply '- (mapcar 'car (list p1 p3)))) 3)
(prompt "\nObject is not wide enough.")
)
(not (initget 6))
(or (setq d (getdist "\nDepth to bottom <4.0>: "))
(setq d 4.0)
)
(setq obj2 (vla-copy obj1))
(setq e2 (vlax-vla-object->ename obj2))
(or (vla-move obj2 (vlax-3d-point '(0 0 0))(vlax-3d-point (list 0 (- d) 0))) 1)
(setq p2 (mapcar '- p1 (list 0 d 0)))
(setq e3 (entmakex (list '(0 . "LINE")(cons 10 p1)(cons 11 p2))))
(setq obj3 (vlax-ename->vla-object e3))
(setq p4 (mapcar '- p3 (list 0 d 0)))
(setq e4 (entmakex (list '(0 . "LINE")(cons 10 p3)(cons 11 p4))))
(setq obj4 (vlax-ename->vla-object e4))
(if (> (car p3)(car p1))
(progn
(or (vla-move obj3 (vlax-3d-point '(0 0 0))(vlax-3d-point (list 1.5 0 0))) 1)
(or (vla-move obj4 (vlax-3d-point '(0 0 0))(vlax-3d-point (list -1.5 0 0))) 1)
)
(progn
(or (vla-move obj3 (vlax-3d-point '(0 0 0))(vlax-3d-point (list -1.5 0 0))) 1)
(or (vla-move obj4 (vlax-3d-point '(0 0 0))(vlax-3d-point (list 1.5 0 0))) 1)
)
)
(setq p1new (vlax-invoke obj3 'intersectwith obj1 1))
(or (vla-move obj3 (vlax-3d-point (vlax-get obj3 'startpoint))(vlax-3d-point p1new)) 1)
(setq e3 (vlax-vla-object->ename obj3))
(setq p3new (vlax-invoke obj4 'intersectwith obj1 1))
(or (vla-move obj4 (vlax-3d-point (vlax-get obj4 'startpoint))(vlax-3d-point p3new)) 1)
(setq e4 (vlax-vla-object->ename obj4))
(vl-cmdf "_.trim" e3 "" p2 "")
(vl-cmdf "_.trim" e4 "" p4 "")
(setq ent (append (entget e2) '((8 . "A-ELEV"))))
(entmod ent)
(vl-cmdf "_.pedit" e2 "_J" e3 e4 "" "")
(princ "\nDONE!")
)
(*error* nil)
)
@DC-MWA ,
I emulated your polyline and got a good result:
Yes, I had set layer "A-ELEV" to color 1. Note that if the layer had not existed that (entmod) will create it.
I am guessing there may be a difference in the TRIM command between the 2002 and more recent AutoCAD releases. So that there is no confusion, could you please post a 2000 version of your polyline dwg?
Ya know, it could be that you were zoomed in such that the endpoints were out of view. I think that AutoCAD needs to "see" the ends in order to trim them. Please try zooming out and trying again.
Yep, I just tested and what I suspect is true. So either you live with the zooming requirement or else I have to figure out a different approach. Oh, yeah. I just wrote one for the MBREAK16 routine. It contains a subfunction to zoom out prior to processing.
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
