Leaderboard
Popular Content
Showing content with the highest reputation since 11/22/2025 in Posts
-
@PGia Thanks for the encouragement and checking the results. I measure from the vertices instead of the lines. Those are calculated and the lines are just to connect the points. So perpendicular to the middle of segments of the centerline will always be a bit off, but if you measure from the vertices it should be centered correctly. Just like @GP_ said. I kept going in the same direction and I have made some improvements and got rid of some bugginess: The centerline should be a little more accurate now because of extra measurements (blue line) Crossing polylines get sharp corners on negative side Corner checks are done on all intersections of temporary line now (red line) More error checking so it doesn't crash on some of the example lines I left all of the 'animation' code commented out so you can give it a try ;| ; Calculate centerline between two polylines - dexus ; Function checks intersections of the offsets of two lines to create a middle/avarage line. ; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/6/#findComment-677246 ; Version 0.1 - Initial release 19-11-2025 ; Version 0.2 - Added corner support on negative side of crossing polylines 27-11-2025 ; Version 0.3 - Extra check using distance between vertex and closest point 28-11-2025 ; Version 0.4 - Added error handler 28-11-2025 |; (defun c:cl (/ corners ent1 ent2 loop maxlen offset offsetdistance pts s1 s2 ss start te0 te1 te2 LM:ProjectPointToLine LM:intersections _addPoints _avarageAngle _cornerOffset _doOffset _getAnglesAtParam _getLength _polyline _side _wait *error*) (defun *error* (st) (if (wcmatch (strcase st t) "*break,*cancel*,*exit*") (redraw) (progn (vl-bt) (princ (strcat "\nOops! Something went wrong: ") st) ) ) (if (not (vlax-erased-p te0)) (entdel te0)) (if (and te1 (not (vl-catch-all-error-p te1))) (mapcar 'vla-delete te1)) (if (and te2 (not (vl-catch-all-error-p te2))) (mapcar 'vla-delete te2)) (princ) ) ;| ; Draw Polyline - dexus ; Draw a polyline from a list of points, but filter out colinear points ; @Param lst list of points ; @Returns ename of polyline |; (defun _polyline (lst closed / prev pts) (while lst (cond ( (and (cdr lst) prev (or (equal (cdr lst) prev 1e-8) ; Remove duplicate points (null (inters prev (car lst) prev (cadr lst))) ; Remove collineair points ) ) ) ((setq pts (cons (cons 10 (setq prev (car lst))) pts))) ) (setq lst (cdr lst)) ) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar 'clayer)) (cons 70 (if closed 1 0)) ) (reverse pts) ) ) ) (defun _side (pline pnt / cpt end target der) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429 (setq cpt (vlax-curve-getClosestPointTo pline pnt) end (vlax-curve-getEndParam pline) target (vlax-curve-getParamAtPoint pline cpt) der (if (and (equal target (fix target) 1e-8) (or (vlax-curve-isClosed pline) (and (not (equal (vlax-curve-getStartParam pline) target 1e-8)) (not (equal end target 1e-8))) ) ) (mapcar '- (polar cpt (angle '(0 0) (vlax-curve-getFirstDeriv pline (rem (+ target 1e-3) end))) 1.0) (polar cpt (angle (vlax-curve-getFirstDeriv pline (rem (+ (- target 1e-3) end) end)) '(0 0)) 1.0) ) (vlax-curve-getFirstDeriv pline target) ) ) (minusp (sin (- (angle cpt pnt) (angle '(0.0 0.0) der)))) ) ;; Intersections - Lee Mac ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst)) ) ) (reverse rtn) ) (defun _getLength (ent) (- (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) (vlax-curve-getDistAtParam ent (vlax-curve-getStartParam ent)) ) ) (defun _wait (msec) (not ( (lambda (start) (while (< (- (getvar 'millisecs) start) msec)) ) (getvar 'millisecs) ) ) ) (defun _addPoints (lst ent pts / len) (setq len (_getLength ent)) (setq lst (mapcar (function (lambda (pt) (list (/ (vlax-curve-getDistAtPoint ent pt) len) pt))) lst)) (setq pts (append lst pts)) ; Animation ; (setq pts (vl-sort pts (function (lambda (a b) (< (car a) (car b)))))) ; (redraw) ; ( ; (lambda (lst) ; (while (cadr lst) ; (grdraw (cadar lst) (cadadr lst) 3) ; (setq lst (cdr lst)) ; ) ; ) ; pts ; ) ; (vla-update ent) ; (_wait 40) ; End animation pts ) (defun _doOffset (offset / lst rtn) ; Global vars: pts ent1 ent2 s1 s2 te1 te2 (setq te1 nil) (setq te2 nil) (setq rtn (cond ((equal offset 0.0 1e-8) (if (setq lst (LM:intersections ent1 ent2 acExtendNone)) (setq pts (_addPoints lst ent1 pts)) ) lst ) ( (or ; Make offset (vl-catch-all-error-p (setq te1 (vl-catch-all-apply 'vlax-invoke (list ent1 'Offset (if s1 offset (- offset)))))) (vl-catch-all-error-p (setq te2 (vl-catch-all-apply 'vlax-invoke (list ent2 'Offset (if s2 offset (- offset)))))) ) (princ "\nOffset failed. ") nil ) ((setq lst (LM:intersections (car te1) (car te2) acExtendNone)) (setq pts (_addPoints lst (car te1) pts)) lst ) ) ) (if (and te1 (not (vl-catch-all-error-p te1))) (mapcar 'vla-delete te1)) (if (and te2 (not (vl-catch-all-error-p te2))) (mapcar 'vla-delete te2)) rtn ) ;| ; Project Point onto Line - Lee Mac ; @Param pt point to project ; @Param p1 first point of line ; @Param p2 second point of line ; @Returns projected point |; (defun LM:ProjectPointToLine ( pt p1 p2 / nm ) (setq nm (mapcar '- p2 p1) p1 (trans p1 0 nm) pt (trans pt 0 nm)) (trans (list (car p1) (cadr p1) (caddr pt)) nm 0) ) (defun _getAnglesAtParam (ent pa / ang1 ang2) (if (and (vlax-curve-isClosed ent) (= pa 0)) ; Special case for closed Polyline (setq ang1 (vlax-curve-getFirstDeriv ent 1e-14) ang2 (vlax-curve-getFirstDeriv ent (- (fix (vlax-curve-getEndParam ent)) 1e-14))) (setq ang1 (vlax-curve-getFirstDeriv ent (+ pa 1e-14)) ang2 (vlax-curve-getFirstDeriv ent (- pa 1e-14))) ) (if (and ang1 ang2) (list (angle '(0 0 0) ang1) (angle '(0 0 0) ang2) ) ) ) ;| ; Avarage Angle - dexus ; Get angle of a line between two angles ; @Param ang1 real - Angle in radians ; @Param ang2 real - Angle in radians ; @Returns real - Angle in radians |; (defun _avarageAngle (ang1 ang2) (if (< (rem (+ ang1 pi) (+ pi pi)) (rem (+ ang2 pi) (+ pi pi)) ) (+ (* (- ang2 ang1) 0.5) ang1) (+ (* (- ang1 ang2) 0.5) ang2) ) ) ;| ; Calculate exact offset distance on a corner - dexus ; pt1 - Point on corner ; pt2 - Point on other side ; pt3 - Center for bisector ; pt4 - Target for corner of the offset ; pt5 - Find perpendicular point for offset distance ; / ; / ; -------- pt1 pt5 ; \ / ; pt4 ; \ ; ---- pt3 ----- pt2 ----- ; ; @Param ent1 Line to check corners ; @Param ent2 Opposing line ; @Returns List of offset distances (pt1 -> pt5) to calculate |; (defun _cornerOffset (ent1 ent2 / ang1 ang2 ang3 index pt1 pt2 pt3 pt4 pt5 rtn) (setq index 0) (repeat (fix (vlax-curve-getEndParam ent1)) (and (setq pt1 (vlax-curve-getPointAtParam ent1 index)) ; Point on corner (setq ang1 (_getAnglesAtParam ent1 index)) ; Angles of pt1 (setq ang1a (_avarageAngle (car ang1) (cadr ang1))) (setq te0 (entmakex (list (cons 0 "line") (cons 10 pt1) (cons 11 (polar pt1 (- ang1a halfPi) 1))))) ; Temp line for finding the angle on the other side (foreach pt2 (LM:intersections (vlax-ename->vla-object te0) ent2 acExtendThisEntity) ; Point on other side (and (setq ang2 (_getAnglesAtParam ent2 (vlax-curve-getParamAtPoint ent2 pt2))) ; Angle of pt2 (if (equal (rem (car ang1) pi) (rem (car ang2) pi) 1e-8) ; Is parallel? (and (setq pt3 (mapcar (function (lambda (a b) (* (+ a b) 0.5))) pt1 pt2)) ; Midpoint (setq ang3 (car ang1)) ; Same angle als ang1 ) (and (setq pt3 (inters pt1 (polar pt1 (car ang1) 1) pt2 (polar pt2 (car ang2) 1) nil)) ; Find center for bisector (setq ang3 (_avarageAngle (angle pt1 pt3) (angle pt2 pt3))) ; Angle of bisector ) ) (setq pt4 (inters pt3 (polar pt3 ang3 1) pt1 (polar pt1 (+ ang1a halfPi) 1) nil)) ; Find target for corner of the offset (setq pt5 (LM:ProjectPointToLine pt4 pt1 (polar pt1 (+ (car ang1) halfPi) maxlen))) ; Find perpendicular point for offset distance (setq rtn (cons (distance pt1 pt5) rtn)) ; Return offset distance ; Animation ; (progn ; (redraw) ; (grdraw pt1 pt2 1) ; (grdraw pt4 pt5 2) ; (grdraw pt1 pt5 2) ; (vla-update ent1) ; (_wait 120) ; ) ; End Animation ) ) ) (if (not (vlax-erased-p te0)) (entdel te0)) (setq index (1+ index)) ) rtn ) (if (and (not (while (cond ((not (setq ss (ssget '((0 . "LWPOLYLINE"))))) (princ "\nNothing selected. Try again...\n") ) ((/= (sslength ss) 2) (princ "\nSelect 2 polylines! Try again...\n") ) ((and (setq ent1 (ssname ss 0)) (setq ent2 (ssname ss 1)) (setq ent1 (vlax-ename->vla-object ent1)) (setq ent2 (vlax-ename->vla-object ent2)) ) nil ; Stop loop ) ) ) ) ent1 ent2 ) (progn (setq s1 (_side ent1 (if (< ; Check closest point for edgecase with crossing lines in oposite directions (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent2)) (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2)) ) (vlax-curve-getEndPoint ent2) (vlax-curve-getStartPoint ent2) ) ) ) (setq s2 (_side ent2 (vlax-curve-getStartPoint ent1) ) ) (if (not (numberp halfPi)) (setq halfPi (* pi 0.5))) (setq maxlen (* 1.1 (max (_getLength ent1) (_getLength ent2) ( (lambda (ent1 ent2 / step de1 div p_step dis dmax) (setq step (/ (setq de1 (vlax-curve-getDistAtParam ent1 (vlax-curve-getEndParam ent1))) 500) div step dmax 0.00) (while (< div de1) (setq p_step (vlax-curve-getPointAtDist ent1 div) dis (distance p_step (vlax-curve-getClosestPointTo ent2 p_step))) (if (> dis dmax) (setq dmax dis)) (setq div (+ div step)) ) dmax ) ent1 ent2 ) ) ) ) (mapcar ; Add half distances from closest point to every vertex (function (lambda (ent1 ent2 / index pt) (setq index 0) (repeat (fix (vlax-curve-getEndParam ent1)) (setq pt (vlax-curve-getPointAtParam ent1 index) corners (cons (* (distance pt (vlax-curve-getClosestPointTo ent2 pt)) 0.5) corners) index (1+ index)) ; Animation ; (redraw) ; (grdraw pt (vlax-curve-getClosestPointTo ent2 pt) 4) ; ( ; (lambda (mid) (grdraw mid (polar mid (+ (angle pt (vlax-curve-getClosestPointTo ent2 pt)) halfPi) (car corners)) 2)) ; (mapcar (function (lambda (a b) (* (+ a b) 0.5))) pt (vlax-curve-getClosestPointTo ent2 pt)) ; ) ; (vla-update ent1) ; (_wait 120) ; End animation ) )) (list ent1 ent2) (list ent2 ent1) ) (setq corners (vl-sort (append corners (_cornerOffset ent1 ent2) (_cornerOffset ent2 ent1)) '<) offsetdistance (/ maxlen 1024.0)) (if (LM:intersections ent1 ent2 acExtendNone) ; For crossing polylines, add negative values (setq offset (- maxlen) corners (append (mapcar '- (reverse corners)) corners)) (setq offset 0.0) ) (while (progn (while (and corners (> offset (car corners))) ; Calculated offset values to check (_doOffset (car corners)) (setq corners (cdr corners)) ) (setq loop ; Incremental check (cond ((> offset maxlen) nil) ((_doOffset offset) (setq start t)) ((not start) t) (start nil) ) ) (setq offset (+ offset offsetdistance)) loop ) ) (if pts ; Draw polyline (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b) (< (car a) (car b)))))) (and (vlax-curve-isClosed ent1) (vlax-curve-isClosed ent2)) ) ) ) ) (redraw) (princ) ) And here is an animation of it working just because they are fun to look at :3 points
-
3 points
-
Since Lee's Code only has you picking a point its easy enough. Just add a call at the end of APV (line 95) to call itself again. This will force a loop that you have to hit esc to exit. - Edit This is a better option. Has undo marks. You could also set your snaps before entering the command if you want to. ;;----------------------------------------------------------------------------;; ;; Add Polyline Vertex loop ;; Dependent AddLWPolylineVertexV1-1.lsp (defun C:APVL ( / ) (vl-load-com) (princ "\nStarting Add Polyline Vertex loop. Press ESC to stop.") (vla-StartUndoMark (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))) ;(setvar 'OSMODE 3) ;End and mid point snaps (while T (C:APV) ) (princ "\nAdd Polyline Vertex Loop ended.") (vla-EndUndoMark doc) (princ) )2 points
-
1 point
-
Anyway, the result obtained by Dexus's code is one of the best (perhaps the best) I've found on the web. Thanks for that, Dexus1 point
-
Rather than explode the COGO point what are you trying to do ? I have for example write the RL of a cogo point as text next to the point. We used this as a quick reference when designing, we would select only the points that we want to see the RL. It could be expanded to say label XYZ, PtXYZD etc. The tree block should be on the correct layer according to your Description key Sets. A side note it's possible to update a cogo point dynamic block, I have something that does just that, it looks at the description, so TR6*300, dynamic block has a trunk and spread 2 objects, running my lisp would get a 6m spread with a 300 mm trunk. @Steven P the COGO points in Civ3D are proxy objects. In a dwg if labels are off can not turn on in ACAD. I am looking at talking to Bricsys about getting at "AeccXUiLand.AeccApplication." when a civ3D dwg is opened in Bricscad. Getting at CIV3D objects via lisp can be easy or difficult.1 point
-
Up load your LISP so we can have a look. I suspect you will want to explode the block and then use entlast select it ready to move it to the correct layer - that might be enough of a hint? Since you have the entity name, I would just use entmod to change the layer1 point
-
1 point
-
Hi thanks a lot. It works. how can i call multiple prior to calling APV? A friend of mine got me this vlx file but there is an annoying pop-up but it works as well addv.vlx1 point
-
...Continue from previous post, experiment with imperial mod, quotient, division. ##********************************************************************************************** ## 45 UDF/ Excel name: impaMQD() - Similar Excel MOD() function with optional parmeters, ## return quotient or division [opt_1Quotient_or_2Division]. ## ## Note: This function uses todec() & toimpa() as sub-functions. ## ## Notes with optional parameters: ## ## [opt_1Quotient_or_2Division] = 1 , Similar Excel QUOTIENT() function - Returns the integer ## portion of a division ## [opt_1Quotient_or_2Division] = 2 , division calculation (varDividend/varDivisor) ## ## Optional parameters other than 1 & 2 will return error #N/A ## ## Rev. 1.0 - 9/2/2025 ##********************************************************************************************** =LAMBDA(varDividend,varDivisor,[opt_1Quotient_or_2Division], LET(optN,IF(ISOMITTED(opt_1Quotient_or_2Division),0, IF(AND(opt_1Quotient_or_2Division<=2,opt_1Quotient_or_2Division>0),opt_1Quotient_or_2Division,NA())), varD1,todec(varDividend), varD2,todec(varDivisor), answrM,varD1-(varD2*INT(varD1/varD2)), answrQ,ROUNDDOWN(varD1/varD2,0), answrD,varD1/varD2, SWITCH(TRUE, optN=0,IF(AND(ISNUMBER(varDividend),ISNUMBER(varDivisor)),answrM,IF(OR(AND(ISTEXT(varDividend),ISTEXT(varDivisor)),ISNUMBER(varDivisor)),toimpa(answrM),"Error!")), optN=1,IF(OR(AND(ISNUMBER(varDividend),ISNUMBER(varDivisor)),AND(ISTEXT(varDividend),ISTEXT(varDivisor))),answrQ,IF(ISNUMBER(varDivisor),toimpa(answrQ),"Error!")), optN=2,IF(OR(AND(ISNUMBER(varDividend),ISNUMBER(varDivisor)),AND(ISTEXT(varDividend),ISTEXT(varDivisor))),answrD,IF(ISNUMBER(varDivisor),toimpa(answrD),"Error!")), NA() ) ) )1 point
-
You're missing the double backslash ("*\\P*") Also, note that the use of vl-string-subst with a constant starting position and wcmatch to test the content is dangerous in general as this will result in an infinite loop if the replacement string contains the find string, e.g. consider replacing "new" with "knew" - your code would loop indefinitely.1 point
-
Hi everyone, I’ve been working on a project to automate the tedious process of room quantity takeoffs (Area & Perimeter) in AutoCAD. I know how time-consuming it can be to manually measure every room and transfer data to Excel, so I developed a Lisp plugin called Quantity Surveyor Pro. It's currently v1.0 and completely free for the community. Key Features: ☻Auto-Boundary Detection: Works like the 'Boundary' command but smarter. ☻Smart Tagging: Automatically places Room Name/No tags with area & perimeter. ☻Excel Export: Exports all data to a CSV/Excel file with one click. ☻Table Generation: Creates a summary table inside AutoCAD. I would really appreciate it if you could test it and give me some feedback on how to improve it further. You can download it here: https://cadlisp.com (It supports both English and Turkish languages) Thanks in advance for your support!1 point
-
Per the documentation, (vl-string-translate) replaces by character, not by string. Hence, for the arguments you have specified, the backslash ("\\") will be replaced by the newline character ("\n") and the "P" does not have a replacement character. Instead, since you're looking to substitute one string for another, you should use the (vl-string-subst) function (in a loop so as to replace all occurrences). I have written a String Subst wrapper which you could call in the following way: (LM:stringsubst "\n" "\\P" "Abcdef\\Pghijk\\Plmnop")1 point
-
You can build a lisp function in Python that will explode the MText into fragments @Ap.Command() def doit(): try: ps, id, pnt = Ed.Editor.entSel("\nSelect: ", Db.MText.desc()) mt = Db.MText(id) frags = mt.getFragments() val = "" for frag in frags: val += ' ' val += frag[Db.MTextFragmentType.kTextValue] print(frags) print(val) except Exception: print(traceback.format_exc()) [PyGe.Point3d(18.25565516926225,16.52816695203355,0.00000000000000), PyGe.Vector3d(0.00000000000000,0.00000000000000,1.00000000000000), PyGe.Vector3d(1.00000000000000,0.00000000000000,0.00000000000000), 'Hello', None, None, PyGe.Point2d(0.63669849931787,0.20327421555252), 0.2, 1.0, 0.0, 1.0, <PyDb.EntityColor object at 0x000001AD0C1D0F90>, 0, 0, 0, 0, 0, [PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000), PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000)], [PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000), PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000)], [PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000), PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000)], 'Arial', False, False] [PyGe.Point3d(19.29427328818596,15.86150028536689,0.00000000000000), PyGe.Vector3d(0.00000000000000,0.00000000000000,1.00000000000000), PyGe.Vector3d(1.00000000000000,0.00000000000000,0.00000000000000), 'World', None, None, PyGe.Point2d(0.72960436562074,0.20327421555252), 0.2, 1.0, 0.0, 1.0, <PyDb.EntityColor object at 0x000001AD0C1D1770>, 0, 0, 0, 0, 0, [PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000), PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000)], [PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000), PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000)], [PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000), PyGe.Point3d(0.00000000000000,0.00000000000000,0.00000000000000)], 'Arial', False, False] Hello World1 point
-
I know this query is old, but... Maybe for the path to multiple locations use the Traveling Salesman Problem (TSP) algorithm. @marko_ribar has a LISP on CADTutor. Bellman-Ford algorithm can handle the shortest path from a single source to all other nodes might work.1 point
-
Try this. Note only do one direction at a time do lefts exit and repeat to do rights. ; https://www.cadtutor.net/forum/topic/98817-create-polyline-automatically/ ; Custom draw pline by Alan H Nov 2025 Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; By Alan H July 2020 ; (defun c:wow ( / co-ord ht pt0 pt1 pty1a pt2 pt2a ht oldsnap) (defun c:wow ( / ) (defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint) (setq obj (vlax-ename->vla-object ent)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (command "Pedit" ent "R" "") ) (princ) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq pt1 (getpoint "\nPick 1st point ")) (setvar 'osmode 128) (setq pt2 (getpoint pt1 "\nPick 2nd point on object ")) (setvar 'osmode 0) (setq pt0 (polar pt1 (/ pi 2.0) 4.0)) (command "pline" (setq pt1a (polar pt0 0.0 1.85)) (setq pt2a (polar pt1a (* 1.5 pi) 2.2)) (setq pt3 (polar pt2a pi 3.7)) (setq pt4 (polar pt3 (/ pi 2.0) 2.2)) "C" ) (setq ent (car (entsel "\Pick End Rectangle "))) (AH:chkcwccw ent) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq mp (mapcar '* (mapcar '+ (nth 1 co-ord) (nth 2 co-ord)) '(0.5 0.5))) (setq pt4 (polar mp (* 1.5 pi) (* 0.4 (distance (nth 0 co-ord) (nth 1 co-ord))))) (setq pt5 (mapcar '* (mapcar '+ (nth 0 co-ord) (nth 3 co-ord)) '(0.5 0.5))) (setq pt3 (list (car pt2) (cadr pt4))) (command "pline" pt0 pt1 pt2 pt3 pt4 pt5 "") (while (setq pt6 (getpoint "\nPick 1st point Enter to exit ")) (setq ang (angle pt2 pt6)) (if (and (>= ang (/ pi 2.0))(<= ang (* 1.5 pi))) (progn (setq pt0 (list (car pt6)(- (cadr pt0) 0.1))) (setq pt1 (list (car pt6)(- (cadr pt1) 0.1))) (setq pt2 (list (- (car pt2) 0.1)(- (cadr pt2) 0.1))) (setq pt3 (list (- (car pt3) 0.1)(- (cadr pt3) 0.1))) (setq pt4 (list (- (car pt4) 0.1)(- (cadr pt4) 0.1))) (setq pt5 (list (- (car pt5) 0.1)(cadr pt5))) ) (progn (setq pt0 (list (car pt6)(- (cadr pt0) 0.1))) (setq pt1 (list (car pt6)(- (cadr pt1) 0.1))) (setq pt2 (list (+ (car pt2) 0.1)(- (cadr pt2) 0.1))) (setq pt3 (list (+ (car pt3) 0.1)(- (cadr pt3) 0.1))) (setq pt4 (list (+ (car pt4) 0.1)(- (cadr pt4) 0.1))) (setq pt5 (list (+ (car pt5) 0.1)(cadr pt5))) ) ) (command "pline" (setq pt1a (polar pt0 0.0 1.85)) (setq pt2a (polar pt1a (* 1.5 pi) 2.2)) (setq pt3a (polar pt2a pi 3.7)) (polar pt3a (/ pi 2.0) 2.2) "C" ) (command "pline" pt0 pt1 pt2 pt3 pt4 pt5 "") ) (setvar 'osmode oldsnap) (princ) ) (C:wow)1 point
