Jump to content

All Activity

This stream auto-updates

  1. Past hour
  2. SLW210

    Hybrid parallel

    And I stated as much. I did get a chance to test on AutoCAD 2000i and it worked. After today I am off work for a week until next Tuesday, I'll try to look through some more options.
  3. SLW210

    wiseysteelshapes-uk

    I also deleted your posts in the old thread you resurrected, no need for having a conversation in two separate threads.
  4. Today
  5. SLW210

    wiseysteelshapes-uk

    Where did you get the UK version? This was originally Australian and USA, it was modified in 2017 for UK by www.stylemarkdesigns.co.uk (that website is no longer active). I use the original AL's Steel Mill, the Wisey's I have was last modified in 2013, that update is missing in your version. My best guess would be there is some incomplete UK data, you should look at the Aus and USA supplied data and compare.
  6. shortkrish

    wiseysteelshapes-uk

    Just installed not working
  7. Steven P

    wiseysteelshapes-uk

    Is 'not working' a new issue or is it something that has always not worked?
  8. ReMark

    Penn Foster Structural Drafting

    You have way too many columns shown. Retain the ones in white and delete the ones in blue. You should have beams (horizontal W12x45's) running between the columns (white). And between the W12x45 beams you should have C9x20 channels running horizontally as well. See attached image below.
  9. Found it - ;; Redefine All Blocks - Lee Mac (defun c:redefall ( / bln dir doc dwg lst obj org spc ) (setq dir nil) ;; Directory of Block Library; nil to use Support Path (if dir (setq dir (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)) "\\")) (setq dir "") ) (cond ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer)))))) (princ "\nCurrent layer locked.") ) ( (setq doc (vla-get-activedocument (vlax-get-acad-object)) spc (vla-get-modelspace doc) org (vlax-3D-point 0 0) ) (vlax-for blk (vla-get-blocks doc) (if (and (= :vlax-false (vla-get-isxref blk)) (= :vlax-false (vla-get-islayout blk)) (not (wcmatch (setq bln (vla-get-name blk)) "`**,_*,*|*")) (setq dwg (findfile (strcat dir bln ".dwg"))) ) (progn (setq obj (vla-insertblock spc org dwg 1.0 1.0 1.0 0.0)) (if (= :vlax-true (vla-get-hasattributes obj)) (setq lst (vl-list* "," bln lst)) ) (vla-delete obj) ) ) ) (if lst (vl-cmdf "_.attsync" "_N" (apply 'strcat (cdr lst)))) (vla-regen doc acallviewports) ) ) (princ) ) (vl-load-com) (princ)
  10. I had written & posted a 'redefine all blocks' program here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/update-blocks-amp-attributes-lisp/m-p/4423983#M315011 But for some reason I no longer appear to be able to access that thread... I'll see if I have a copy in my library.
  11. Hi @DavidP From this part of code, you're file path is incorrect. Instend of "C:/MyBlocks/" need to be "C:/Users/"Your Name"/Desktop/MyBlocks/" or do Support File Search Path in Option -> File inside the AutoCAD to add that folder "MyBlocks". From this part of code, if I open the blank drawing where the nothing is inside, the inserted blocks "BLK1, BLK2 and BLK3" will be erased, because there isn't "oldEnt" inside the drawing. So, can you provide the drawing where you want to insert desired blocks?
  12. Dear All, Please find attached. The wisey steel shape not working only for uk shapes.2d end view is ok, But 2d plan / 2d side not working Thanks Krishna WiseySteelShapes-UK.zip
  13. No worries glad you got it working.
  14. you may try to change: (command "_.-insert" blk pt s s r) (setq newEnt (entlast)) (if (and newEnt (/= oldEnt newEnt)) (entdel newEnt) ) to (command "_.-insert" (strcat (vl-filename-base blk) "=" blk) pt) (while (> (getvar "CMDACTIVE") 0) (command "")) (entdel(entlast)) ; Delete the temp insert block This will force AutoCAD to update a block from a drawing. you will need to make sure the block name is same as the DWG's name. Since you are working wirth dynamic blocks, the safer way is to get the dynamic property values for each block reference before update it and apply the data back to blocks after the definition is updated, in case dynamic parameters may have been changed in definition.
  15. Yesterday
  16. lrm

    Hybrid parallel

    @SLW210 I tested your code on the geometry below. The solution from your code is the yellow polyline. The red lines show the correct bisector which I created from my piecemeal program mid -poly.06.lsp. Test 11-3-25.dwg
  17. I have drawing with blocks some of which have be change by the drafters... I want to re-insert & redefine the blocks from a local folder. What I'm I missing? My blocks are Dynamic blocks.
  18. MyBlocks.zip (defun c:foo ( / a1 a2 oldCMDECHO s r pt folderPath BlockNames oldEnt newEnt blk ) (setq oldCMDECHO (getvar "CMDECHO") a1 (getvar "ATTDIA") a2 (getvar "ATTREQ") pt (list 0.0 0.0) s 0.5 r 0.0) (setvar "CMDECHO" 0) (setvar "ATTDIA" 0) (setvar "ATTREQ" 0) (setq folderPath "C:/MyBlocks/" BlockNames (list "BLK1.dwg" "BLK2.dwg" "BLK3.dwg")) (setq oldEnt (entlast)) (foreach blk BlockNames (setq blk (strcat folderPath blk)) (command "_.-insert" blk pt s s r) (setq newEnt (entlast)) (if (and newEnt (/= oldEnt newEnt)) (entdel newEnt) ) ) (setvar "ATTDIA" a1) (setvar "ATTREQ" a2) (setvar "CMDECHO" oldCMDECHO) (princ "\nBlocks inserted successfully.") (princ) )
  19. SLW210

    Hybrid parallel

    I have improved mine somewhat, at least it's the same no matter the pick order. Still working on a better method for correct centerline. Looks pretty close most of the time and should work with LWPolylines and Old Style Polylines and should handle bulges. I finished this at work, so untested on AutoCAD 2000i at home, so just AutoCAD 2026. ;;; Draws a centerline between two polylines. | ;;; | ;;; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/3/#findComment-677003 | ;;; | ;;; By SLW210 (a.k.a. Steve Wilson) | ;;; | ;;;=======================================================================================| ;;; DrawCl.LSP | ;;; Create centerline between two polylines | ;;; on layer Centerline, color Blue, and linetype Center | ;;;=======================================================================================| (vl-load-com) ;;; ------------------------------- ;;; Vector midpoint ;;; ------------------------------- (defun v-mid (a b) (list (/ (+ (car a) (car b)) 2.0) (/ (+ (cadr a) (cadr b)) 2.0)) ) ;;; ------------------------------- ;;; Distance squared ;;; ------------------------------- (defun dist2 (a b) (+ (expt (- (car a) (car b)) 2) (expt (- (cadr a) (cadr b)) 2)) ) ;;; ------------------------------- ;;; Nearest point ;;; ------------------------------- (defun nearest (pt lst / best d cur) (setq best nil d 1e99) (foreach cur lst (if (< (dist2 pt cur) d) (setq d (dist2 pt cur) best cur))) best ) ;;; -------------------------------------------------- ;;; Get polyline vertices (LWPOLYLINE or old POLYLINE) ;;; -------------------------------------------------- (defun get-poly-pts (ename / elist pts cur) (setq elist (entget ename)) (cond ((= "LWPOLYLINE" (cdr (assoc 0 elist))) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) elist))) ((= "POLYLINE" (cdr (assoc 0 elist))) (setq pts '() cur (entnext ename)) (while cur (setq elist (entget cur)) (cond ((= "VERTEX" (cdr (assoc 0 elist))) (setq pts (cons (cdr (assoc 10 elist)) pts))) ((= "SEQEND" (cdr (assoc 0 elist))) (setq cur nil))) (if cur (setq cur (entnext cur)))) (reverse pts)) (T (progn (princ "\nEntity is not a polyline.") nil))) ) ;;; ----------------------------------------- ;;; Polyline length (sum of vertex distances) ;;; ----------------------------------------- (defun polyline-length (pts / total i) (if (< (length pts) 2) 0 (progn (setq total 0.0 i 0) (while (< i (1- (length pts))) (setq total (+ total (sqrt (dist2 (nth i pts) (nth (1+ i) pts))))) (setq i (1+ i))) total))) ;;; ------------------------------- ;;; Polyline selection helper ;;; ------------------------------- (defun select-polyline (pick / sel) (while (progn (setq sel (entsel pick)) (not (and sel (entget (car sel))))) (princ "\nPlease select a valid polyline.")) (car sel)) ;;; ------------------------------- ;;; Ensure Centerline Layer Exists ;;; ------------------------------- (defun ensure-centerline-layer (/ doc layers layerObj ltObj) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (setq layers (vla-get-Layers doc)) (setq ltypes (vla-get-Linetypes doc)) ;; Load CENTER linetype if needed (if (not (tblsearch "LTYPE" "CENTER")) (vl-catch-all-apply '(lambda () (vla-load ltypes "CENTER" "acad.lin")))) ;; Create layer if missing (if (not (tblsearch "LAYER" "Centerline")) (setq layerObj (vla-Add layers "Centerline")) (setq layerObj (vla-Item layers "Centerline"))) ;; Set layer properties (vla-put-Color layerObj 5) ; blue (if (tblsearch "LTYPE" "CENTER") (vla-put-Linetype layerObj "CENTER")) layerObj ) ;;; ------------------------------- ;;; Main DRAWCL command ;;; ------------------------------- (defun c:DRAWCL (/ e1 e2 pts1 pts2 ref tgt mids coords arr doc ms pline closest closed layerObj) (vl-load-com) (princ "\nStarting DRAWCL centerline routine...") ;; Select polylines (setq e1 (select-polyline "\nSelect first polyline: ")) (setq e2 (select-polyline "\nSelect second polyline: ")) ;; Get vertices (setq pts1 (get-poly-pts e1)) (setq pts2 (get-poly-pts e2)) (if (and pts1 pts2) (progn ;; Determine longer polyline as reference (if (> (polyline-length pts1) (polyline-length pts2)) (setq ref pts1 tgt pts2 eRef e1) (setq ref pts2 tgt pts1 eRef e2)) ;; Compute centerline midpoints (setq mids '()) (foreach pt ref (setq closest (nearest pt tgt)) (setq mids (cons (v-mid pt closest) mids))) (setq mids (reverse mids)) ;; Ensure Centerline layer and linetype exist (setq layerObj (ensure-centerline-layer)) ;; Create centerline polyline in model space (if (> (length mids) 1) (progn (setq coords (apply 'append (mapcar '(lambda (p) (list (car p) (cadr p))) mids))) (setq arr (vlax-make-safearray vlax-vbDouble (cons 0 (- (* 2 (length mids)) 1)))) (vlax-safearray-fill arr coords) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (setq ms (vla-get-ModelSpace doc)) (setq pline (vla-AddLightWeightPolyline ms arr)) ;; Match closed/open status (setq closed (= 1 (logand 1 (cdr (assoc 70 (entget eRef)))))) (vla-put-Closed pline (if closed :vlax-true :vlax-false)) ;; Assign layer (vla-put-Layer pline "Centerline") (princ "\nCenterline created successfully on layer 'Centerline'.")) (princ "\nNot enough points to create centerline."))) (princ "\nFailed to get polyline vertices.")) (princ) ) Most Civil software has this in it and works pretty good AFAIK most of the time, it's not using LISP. It might be the harder, but maybe for new AutoCAD using CENTERLINE command with automated trimming and Join and Close if needed might be best for accuracy.
  20. Good morning, I found this website searching for tutorials to guide me on this Structural Drafting assignment with Penn Foster. I have read through a few of the current threads, and some were helpful, but with visuals being shared that are not correct vs a lack of what it should look like, I am still lost. I wish I had known about this website during Oelson Village, I did pass that with a B on that one. However, that was easier for two reasons.. it is my daily life working with architectural plans for custom homes, so a site plan was not a stretch for me, and also it gave me a visual/goal to finish towards. I could auto-correct myself from step-by-step directions that left quite a bit out. Now I am onto the Structural Drafting assignment and am struggling more.. I was able to get to the point (of my attached images) due to some visuals and threads previously posted on here. However, when I switch to side (3D) views, it looks way off, and I am failing to see how this is all going to connect. Can anyone help me by showing me a visual of the end product that I am building..(I do not want the file, I want to build this and learn.) but a end visual of the front/side of what I am turning in helps. Or am I too soon into the steps, and should not freak out because it will all come together further along? Am I missing clear aspects like 3D measurements..details that are keeping these girders/beams I have built not architecturally correct. Please let me know if I am missing a key dimension, where I should enter that. I am taking a course to learn AutoCAD, but being asked to jump into 3D structual building after only ever doing a site plan in AutoCAD is rough. I get it..I learned a lot in the Oelson Village assignment, just by being thrown into it, but this Structural Drafting assignment is confusing for me. Thank you in advance to anyone jumping in, and sorry if you are repeating yourself. It is easy to get lost in other threads and go down a rabbit hole.
  21. Nice @BIGAL . If you don't mind, I added a few lines of code to yours to make it work properly. ; https://www.cadtutor.net/forum/topic/98797-looking-for-a-lisp-to-evenly-space-polylines-from-their-end-points/ ; paralelle lines change ; offset a pline by an amount ; by AlanH Nov 2025 (defun c:wow ( / co-ord len1 len2 lst off off2 pt1 pt2 pts) ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; Modified By Alan H July 2020 (defun AH:chkcwccw ( ent / area1 area2 dist obj objnew pointmax pointmin) ;; remove "lst" from local variables (setq obj (vlax-ename->vla-object ent)) (setq lst (vlax-get obj 'coordinates)) (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) (progn (command "pedit" ent "R" "") (setq lst (vlax-get obj 'coordinates)) ) ) lst ;; added this line to get a list of coordinates as "output" (princ) ) (defun replace-nth (lst n newVal) (cond ((null lst) nil) ((= n 0) (cons newVal (cdr lst))) (T (cons (car lst) (replace-nth (cdr lst) (1- n) newVal)))) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq off (getreal "\nEnter offset value ")) (while (setq pt1 (getpoint "\nPick 1st point outside ")) (setq pt2 (getpoint pt1 "\nPick 2nd point inward ")) (setq off2 (/ off 2.0)) (setq pts (list pt1 pt2)) (setq ss (ssget "F" pts '((0 . "LWPOLYLINE")))) (repeat (setq x (sslength ss)) (setq plent (ssname ss (setq x (1- x)))) (AH:chkcwccw plent) (setq len1 (distance (list (nth 0 lst)(nth 1 lst)) (list (nth 2 lst)(nth 3 lst)))) (setq len2 (distance (list (nth 4 lst)(nth 5 lst))(list (nth 6 lst)(nth 7 lst)))) (if (> len1 len2) (progn (setq lst (replace-nth lst 0 (+ (nth 0 lst) off2))) (setq lst (replace-nth lst 2 (+ (nth 2 lst) off2))) (setq off2 (+ off2 off)) ) (progn (setq lst (replace-nth lst 6 (- (nth 6 lst) off2))) (setq lst (replace-nth lst 4 (- (nth 4 lst) off2))) (setq off2 (+ off2 off)) ) ) (vlax-put (vlax-ename->vla-object plent) 'coordinates lst) ;; added here "(vlax-ename->vla-object plent)" instend of "obj" ) ) (setq lst nil) ;; added this line of code to "release" variable "lst" (setvar 'osmode oldsnap) (princ) ) Best regards.
  22. GLAVCVS

    Hybrid parallel

    As for the code from my first attempt, I suppose the least I should do for any “child of mine” is to make sure it can have a functional life, no matter how cross-eyed it was born: you never abandon a child. So here I leave a new version of “GLAVCVS’ cross-eyed child”, fresh out of the hospital. ;| G L A V C V S C R O S S - E Y E D C H I L D - o - ************************* G L A V C V S ************************* *************************** F E C I T ***************************|; (defun c:creAxis (/ e e1 e2 l i? l1 l2 lr p p0 p1 p2 px pm abis lii pmi pmf pi1 pi2 pf1 pf2 pc1 pc2 li1 o dameInters+Prox ordena decide sustituye damePuntos) (defun dameInters+Prox (p0 a lp / p1 px pt1 pt2 dmin d pf) (setq pt1 (polar p0 a 1e8) pt2 (polar p0 (+ a PI) 1e8)) (foreach p lp (if p1 (if (setq px (inters pt1 pt2 p1 p)) (if dmin (if (< (setq d (distance px p0)) dmin) (setq dmin d pf px)) (setq dmin (distance px p0) pf px)) ) ) (setq p1 p) ) pf ) (defun ordena (po px pm / p0 lr) (foreach p lii (if (and p0 (inters po px p0 p)) (setq lr (append lr (list pm))) ) (setq p0 p lr (append lr (list p))) ) ) (if (and (setq e1 (car (entsel "\nSelect FIRST LWPOLYLINE..."))) (= (cdr (assoc 0 (setq l1 (entget e1)))) "LWPOLYLINE") (not (redraw e1 3))) (if (and (setq e2 (car (entsel "\nSelect SECOND LWPOLYLINE..."))) (= (cdr (assoc 0 (setq l2 (entget e2)))) "LWPOLYLINE") (not (redraw e2 3))) (progn (setq lp1 (reverse (foreach l l1 (if (= (car l) 10) (setq lr (cons (cdr l) lr)) lr))) lr nil lp2 (reverse (foreach l l2 (if (= (car l) 10) (setq lr (cons (cdr l) lr)) lr))) lr nil ) (cond ((= (rem (cdr (assoc 70 l1)) 2) 1) (setq lp1 (append lp1 (list (car lp1) (cadr lp1) (caddr lp1)))) ) ((equal (car lp1) (last lp1)) (setq lp1 (append lp1 (list (cadr lp1) (caddr lp1)))) ) (T (setq pmi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car lp1) (setq pc1 (vlax-curve-getClosestPointTo e2 (car lp1)))) pmf (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (last lp1) (setq pc2 (vlax-curve-getClosestPointTo e2 (last lp1)))) ) ) ) (cond ((= (rem (cdr (assoc 70 l2)) 2) 1) (if pmi (progn (foreach p (append lp2 (list (car lp2))) (if (or (equal p pmi 1e-4) (equal p pmf 1e-4)) (setq l (if l (not (setq lr (append l (list p)))) (list (list p)))) (if l (setq l (append l (list p)))) ) ) (setq lp2 lr lr nil l nil) ) (setq lp2 (append lp2 (list (car lp2) (cadr lp2)))) ) ) ((equal (car lp2) (last lp2)) (if pc1 (progn (foreach p lp2 (if (or (equal p pc1 1e-4) (equal p pc2 1e-4)) (setq l (if l (not (setq lr (append l (list p)))) (list (list p)))) (if l (setq l (append l (list p)))) ) ) (setq lp2 lr lr nil l nil) ) (setq lp2 (append lp2 (list (cadr lp2)))) ) ) ) (redraw e1 4) (redraw e2 4) (foreach lp (list lp1 lp2) (foreach l lp (if p1 (if p2 (setq abis (+ (/ (+ (angle p1 p2) (angle p2 l)) 2) (/ PI 2.)) px (dameInters+Prox p2 abis (if o lp1 lp2)) lr nil pm (if px (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 px)) lii (if o (if pm (ordena p2 px pm) lii) (if px (append lii (list pm)) lii)) p1 p2 p2 l ) (setq p2 l) ) (setq p1 l) ) ) (if pmi (setq lii (append (list pmi) lii (list pmf)))) (setq p1 nil p2 nil lr nil o T) ) ) ) ) (entmake (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (70 . 0) (60 . 0)) (list (cons 90 (length lii))) (mapcar '(lambda (a) (cons 10 a)) lii))) (princ) )
  23. SLW210

    Hybrid parallel

    Hopefully I can get back to my LISP today. I did do some experiments with CENTERLINE command in newer AutoCAD (not sure when it was first available), if just Polylines/lines, it gets the center very accurately, good for checking a LISP IMO. This is really a job for Civil 3D/ArcGIS or similar software.
  24. GLAVCVS

    Hybrid parallel

    I also think this thread has been stimulating. The final result should be useful for other users in the future. Regarding your approach, I agree; it's the best way to achieve an axis with perfectly centered segments. All that remains is to write the code that can do all of that without Express Tools.
  25. Any one out there that Has LT2024+ etc can test the small bit of code that allows Excel to control CAD would like to know if it works.
  26. Finally had some time to do something, give this a try. (defun c:numblk ( / atts bname ent grp lst lst2 num numstr obj ss) ; ; groupby provided by Dexus (defun _groupBy (fun lst / itm old rtn) (while lst (setq itm (fun (car lst)) rtn (if (setq old (assoc itm rtn)) (subst (cons itm (cons (car lst) (cdr old))) old rtn) (cons (cons itm (list (car lst))) rtn) ) lst (cdr lst)) ) (mapcar 'cdr rtn) ) (setq bname (cdr (assoc 2 (entget (car (entsel "\nPlease slect a block for block name ")))))) (prompt "\nPlease select blocks") (setq ss (ssget (list (cons 0 "INSERT")(cons 2 bname)))) (setq lst '()) (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (1- x)))) (setq obj (vlax-ename->vla-object ent)) (setq atts (vlax-invoke obj 'Getattributes)) (setq attext (vlax-get (nth 2 atts) 'textstring)) (setq lst (cons (list attext ent) lst)) ) (setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y))))) (setq lst2 (reverse (_groupBy (lambda (e) (car e)) lst))) (setq num (getint "\nEnter start number eg 1 ")) (foreach grp lst2 (cond ((< num 10)(setq numstr (strcat "00" (rtos num 2 0)))) ((< num 100)(setq numstr (strcat "0" (rtos num 2 0)))) ((> num 99)(setq numstr (rtos num 2 0))) ) (foreach ent2 grp (setq obj (vlax-ename->vla-object (cadr ent2))) (setq atts (vlax-invoke obj 'Getattributes)) (vlax-put (nth 1 atts) 'textstring numstr) ) (setq num (1+ num)) ) (alert "Type numblk to run again ") (princ) ) (C:numblk)
  27. Last week
  28. Another version just drag over the plines left and right. https://www.cadtutor.net/forum/topic/98797-looking-for-a-lisp-to-evenly-space-polylines-from-their-end-points/ ; paralelle lines change ; offset a pline by an amount ; by AlanH Nov 2025 (defun c:wow ( / co-ord len1 len2 lst off off2 pt1 pt2 pts) ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; Modified By Alan H July 2020 (defun AH:chkcwccw (ent / area1 area2 dist lst obj objnew pointmax pointmin) (setq obj (vlax-ename->vla-object ent)) (setq lst (vlax-get obj 'coordinates)) (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) (progn (command "pedit" ent "R" "") (setq lst (vlax-get obj 'coordinates)) ) ) (princ) ) (defun replace-nth (lst n newVal) (cond ((null lst) nil) ((= n 0) (cons newVal (cdr lst))) (T (cons (car lst) (replace-nth (cdr lst) (1- n) newVal)))) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq off (getreal "\nEnter offset value ")) (while (setq pt1 (getpoint "\nPick 1st point outside ")) (setq pt2 (getpoint pt1 "\nPick 2nd point inward ")) (setq off2 (/ off 2.0)) (setq pts (list pt1 pt2)) (setq ss (ssget "F" pts '((0 . "LWPOLYLINE")))) (repeat (setq x (sslength ss)) (setq plent (ssname ss (setq x (1- x)))) (AH:chkcwccw plent) (setq len1 (distance (list (nth 0 lst)(nth 1 lst)) (list (nth 2 lst)(nth 3 lst)))) (setq len2 (distance (list (nth 4 lst)(nth 5 lst))(list (nth 6 lst)(nth 7 lst)))) (if (> len1 len2) (progn (setq lst (replace-nth lst 0 (+ (nth 0 lst) off2))) (setq lst (replace-nth lst 2 (+ (nth 2 lst) off2))) (setq off2 (+ off2 off)) ) (progn (setq lst (replace-nth lst 6 (- (nth 6 lst) off2))) (setq lst (replace-nth lst 4 (- (nth 4 lst) off2))) (setq off2 (+ off2 off)) ) ) (vlax-put obj 'coordinates lst) ) ) (setvar 'osmode oldsnap) (princ) ) (c:wow)
  1. Load more activity
×
×
  • Create New...