Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 03/27/2024 in all areas

  1. It's more in how the code has been written. You've set p2 to be the polar of pt at 0 degrees. So if there's no curve along that direction, ssget cannot find any curve and returns nil, thus ssname then yields an error. I would do it this way: (defun pt-in-region (pt pts Acc / ss-member-pts pt1 ptn p at ACC AT P PT PT1 PTN PTS) ;;judge a point is in the 2D polygon , polygon given with vetexs . ;;by GSLS(SS) 2011.03.28 ;;return 0 at polygon, 1 in it, -1 out it . (defun ss-member-pts (pt ptl acc / is_go i len a b) (setq is_go T i 0 len(length ptl)) (while (and is_go (< i len)) (setq a(car ptl)ptl(cdr ptl)i(1+ i)) (if (and a (equal a pt acc)) (setq is_go nil b (cons a ptl))))) (setq pt1(list (+ (car (apply (function mapcar) (cons (function max) pts)))(abs acc)(abs acc))(cadr pt))) (mapcar(function(lambda (x y) (if(setq p (inters pt pt1 x y T)) (progn (if(equal (+(distance pt x)(distance pt y))(distance x y)acc)(setq at T)) (if(not (ss-member-pts p pts acc)) (setq ptn (cons p ptn))))))) (cons (last pts) pts) pts) (cond (at 0) ((and (not at) ptn) (if (= (rem (length ptn) 2) 1) 1 -1 )) (t -1) ) ) ;;pts pt is (defun c:test (/ is poly pt pts) (setq pt (getpoint) poly (ssget "f" (list pt (polar pt 0 10000)) '((0 . "LWPOLYLINE"))) ) (cond ((not poly) (alert "Out .")) (t (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname poly 0)) ) ) is (pt-in-region pt pts 1e-8) ) (cond ((= is -1) (alert "Out .")) ((= is 0) (alert "At .")) ((= is 1) (alert "In .")) ) ) ) (princ) ) That being said, your code still yields incorrect results sometimes... That's if there is a horizontal segment along the polyline? I guess it's just up to the function itself:
    1 point
  2. So a automatic save, have you looked at Autosave and the way it is setup to do what you want, check help.
    1 point
  3. I think we need a dwg to really see what you want a before after is needed. Can be VBA or Lisp.
    1 point
  4. This works amazingly. Just had to update my mlstyle to work with a center justification, also modified to suit my needs slightly, thank you. see below for my modification ; Routine to draw a multi-line wall with single line headers. ; Written: Jerry Fiedler - Feb 2024, Modified by EYNLLIB - FEB 2024 ; Multi-line routine Author: Lee Mac, Copyright © 2010 - www.lee-mac.com (defun c:wh (/ ptS ptE *error*) (defun *error* (msg) (if (not (member msg '("Function cancelled" "quit / exit abort" nil))) (princ (strcat "\nError: " msg)) ) (princ) ) (while t (c:mplb) (setq ptS (getvar 'lastpoint)) (setq ptE (getpoint ptS "\nEnd of header or ESC.")) (if (not ptE) (exit)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 2) (cons 70 0) (cons 8 "S - BEAMS") (cons 10 (trans ptS 1 0)) (cons 10 (trans ptE 1 0)) ) ) ) (princ) )
    1 point
  5. EYNLLIB, Here is my suggestion for doing what you want. I do not think you can easily modify Lee's routine to add a "line" header so I wrote a simple wrapper that should work for you. I only tested it with Lee's ORIGINAL routine on his website but I would think it would work with your modified version. For my test I set the multi-line justification to zero (centered) so the header (beam) will be in the center of the wall. To use this function: 1) Enter "wall-header" on the command line. 2) At the "start line" prompt enter J if you want to change the justification. Otherwise just click the start point of the wall. 3) Continue clicking points along the wall until your come to the point where you want the header. Click the point to end the wall then press <ENTER>. 4) At the prompt to select the end of the header just click the desired end point and a header will be drawn. 5) The next prompt will be for the start of the wall so just click the end of the new header and continue to draw wall segments. I could not think of a good way to stop this loop except to press <ESC> at the header end prompt. Perhaps someone can show me a better way. ; Routine to draw a multi-line wall with single line headers. ; Written: Jerry Fiedler - Feb 2024 ; Multi-line routine Author: Lee Mac, Copyright © 2010 - www.lee-mac.com (defun c:wall-header (/ ptS ptE) (while t (c:mpl) (setq ptS (getvar 'lastpoint)) (setq ptE (getpoint ptS "\nEnd of header or ESC.")) (entmake (list (cons 0 "LINE") ;(cons 8 headlyr) (cons 10 (trans ptS 1 0)) (cons 11 (trans ptE 1 0))) ) ) (princ) )
    1 point
  6. Well, try this one instead (defun C:A2S(/ ang1 ang2 len osm p1 p2 p3 p4 wid);;OK (setq *num* 2) (command "_undo" "_be") (setq osm (getvar "osmode")) (setvar "cmdecho" 0) (if (and (setq p1 (getpoint "\nLower Left corner point: ")) (setq p3 (getpoint p1 "\nUpper Right corner point: ")) (setq p2 (getpoint p3 "\nLower Right corner point: ")) (setq num (cond ((getint (strcat"\nSpecify number of subareas (Hit to accept) <"(itoa *num*)">: "))) (num))) ) (progn (setq *num* num) (setq ang1 (angle p1 p2) ang2 (angle p2 p3) len (distance p1 p2) wid (distance p2 p3) ) (setq p2 (polar p1 ang1 (/ len num))) ;;number of divisions were added (setq p4 (polar p1 ang2 wid)) (setq p3 (polar p2 ang2 wid)) (command "_pline" "_non" p1 "_non"p2 "_non"p3 "_non"p4 "_CL") (repeat (- num 1)(command "_copy" (entlast) "" "_non" p1 "_non" p2) (setq p1 p2 p2 (polar p1 ang1 (/ len num)))) ) ) (setvar "osmode" osm) (command "._undo" "_e") (princ) )
    1 point
  7. Just a quick shot on this way with no error checking (defun C:A2S(/ ang1 ang2 len osm p1 p2 p3 p4 wid) (command "_undo" "_be") (setq osm (getvar "osmode")) (setvar "cmdecho" 0) (if (and (setq p1 (getpoint "\nLower Left corner point: ")) (setq p3 (getpoint p1 "\nUpper Right corner point: ")) (setq p2 (getpoint p3 "\nLower Right corner point: "))) (progn (setq ang1 (angle p2 p1) len (distance p1 p2)) (setq p2 (polar p2 ang1 (/ len 2))) (setq p4 (polar p3 ang1 len)) (setq ang2 (angle p1 p4) wid (distance p1 p4)) (setq p3 (polar p2 ang2 wid)) (command "_pline" "_non" p1 "_non"p2 "_non"p3 "_non"p4 "_CL") (command "_copy" (entlast) "" "_non"p1 "_non"p2) ) ) (setvar "osmode" osm) (command "_undo" "_e") (princ) )
    1 point
×
×
  • Create New...