Jump to content

All Activity

This stream auto-updates

  1. Past hour
  2. Recently I coded for just the same issue for PlPath that will draw paths from both sides (top+bottom)... Then you just have to remove sufficient one and leave the one that is OK... Here is the link : https://www.cadtutor.net/forum/topic/84000-create-a-new-polyline-from-two-on-a-path-of-a-polyline/?do=findComment&comment=637865
  3. Today
  4. I've got something similar that trims a polyline between points, will find it out next week
  5. greatttttt !!! and all the options will be used ? ; Brightness = 50 ; ClippingEnabled = -1 ; Contrast = 50 etc like (setq pt (vlax-get obj 'Origin)) ??? 'Brightness 'ClippingEnabled 'Contrast ???? i am going to try before your reponse sorry my bad english !! xDDD
  6. Using VL lisp you can get properties. (setq obj (vlax-ename->vla-object (car (entsel "\nSelect a object ")))) (setq pt (vlax-get obj 'Origin)) DumpIt.LSP
  7. THANKSSSSSSSSSSSSSSSSSSS !!!!! Absolutely GREAT!!!! You deserve heaven my friend!! Total perfection, just what I needed!!
  8. Whipped this up real quick. but it has two problems, well I guess 3 but could be fixed easily enough. but its the weekend. depending on if the polyline is clockwise or counter clockwise direction the start and end points could be reversed. if the polyline has arcs would need to add a bulge function if the polyline vertex 0 is inbetween points picked will draw the inverse (not the green but the purple section) entsel could be a problem to in that you can select anything. ;;----------------------------------------------------------------------------;; ;; Draw Poly Segments between points picked on an existing polyline (defun C:PS (/ pline pt1 pt2 spt ept cords ptlist i s end) (vl-load-com) (if (setq pline (car (entsel "\nPick Polyline:")) ;get entity name of polyline pt1 (getpoint "\nSelect start point: ") ;get point on polyline works best with nearest pt2 (getpoint "\nSelect end point: ") ;same as above ) (progn (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pline)))) ;Extracts the coordinates of the vertices of the selected polyline into a list (setq spt (1+ (fix (vlax-curve-getParamAtPoint Pline (vlax-curve-getClosestPointTo Pline pt1))))) ;finds the closet vertex number to pt1 (setq ept (1+ (fix (vlax-curve-getParamAtPoint pline (vlax-curve-getClosestPointTo Pline pt2))))) ;same for pt2 (if (< spt ept) ;checks to see witch is bigger # (setq s spt end ept spt pt1 ept pt2) ;if spt is smaller then ept sets Everything they way it would work (setq s ept end spt spt pt2 ept pt1) ;if spt is larger then ept revises the order so its still draw correctly ) (setq ptlist (cons spt ptlist)) ;adds spt to a list (setq i s) ;sets i to the lower value of spt or ept (while (< i end) ;loops until i isn't less then end (setq ptlist (cons (nth i cords) ptlist)) ;keeps adding poitns to the list until while loops ends (setq i (1+ i)) ;used to step to the next point ) (setq ptlist (cons ept ptlist)) ;adds the last point to the list (setq ptlist (reverse ptlist)) ;list is in revirse order so reverse it (entmake ;make a polyline with new ptlist (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length ptlist)) '(70 . 0) ) (mapcar (function (lambda (p) (cons 10 p))) ptlist) ) ) ) (prompt "Try again") ;if pline pt1 or pt2 isn't set will prompt user to try again ) (princ) ) --Edit
  9. Yesterday
  10. Hello, I'm going to explain myself. I am attaching an image for easy reference. The idea may be the one I give or something similar. What I think is, touch 2 or 3 points as seen at the top of the image I attached, and that the routine will be able to create a new poly, but only from that yellow section, as shown in the part of below the attached image. Thanks in advance for the help !!
  11. Hello Bro, thanks for responding, I have no idea how to see that image data. I'm a real newbie. I also don't know where the dumpit.lsp file is located. Do you think you could explain it to me please? Thank you !!
  12. Another lots of stuff inside if you know how to look, use dumpit.lsp ; IOdaRasterImage 8c6f5960 : TeighaX Interface for an additional Raster Image funtionality ; ; Property values : ; ; ; Height (RO) = 126.0 ; ImageHeight = 963.549313507815 ; ImageWidth = 3273.00877921702 ; Origin = (893.310512581778 -1166.27484437749 0.0) ; ScaleFactor = 36125.4520397692 ; Width (RO) = 428.0
  13. BIGAL

    Change attribute via lisp?

    Ignore multiple dwg's for moment. As you say only have title block once then its easy. (setq ss (ssget "X" '((0 . "INSERT")(cons 2 "EPCB000")))) You now have a selection set containing the block. (setq obj (vlax-ename->vla-object (ssname ss 0))) (setq atts (vlax-invoke obj 'Getattributes)) The variable atts holds all the attributes. You can then say change the value in each attribute, as you want to change many it makes it easy. You can just loop trough the attributes and change the "TEXTSTRING" the value of the attribute, you can also check for a particular attribute and say change G11 to G12. Ok next question how do you propose to supply the new values ? One way is to make a list of the new values say keep the code in a lisp file and just change the 1 line with the new answers, or keep the values in a text file change it and then run on multiple dwg's if required. This is the type of question linked to excel which can read say a row of details. The excel containing multiple dwg names.
  14. Cad64

    Hatch patterns not printing in PDF

    The problem is that your hatches have their color property overidden to 255, which means they will print white. If you change your hatch color to bylayer or some other color, they should print fine.
  15. I've been working on a project where I have used various hatch patterns to indicate sidewalks, bicycle paths and water. It shows up in my AutoCAD as shown on the screenshot, but the patterns are not appearing in either the print previews or the pdf's. Only one hatch pattern ends up showing up in the PDF, the diagonal lines underneath the street. I've tried changing "HPmaxlines" to 1000000, tried various plotters of AutoCAD and Adobe, reset AutoCAD settings. Nothing seems to work and I cannot understand why, as it shows up right there when I'm working on the file. Could anybody please take a look at the attached files and perhaps notice anything I've been missing? It would be much appreciated. The used Hatch patterns are ANSI31 scale 1 in gray (working) ANSI31 scale 1 in white (Not working), AR-HBONE scale 0.01 white (Not working), NET3 scale 1 in white (Not working) and a custom downloaded one which I applied in a second version. The issues were already there before I used the downloaded hatch pattern. Doorsnede Laan op Zuid Eindopdracht poging 1.pdf Doorsnede Laan op Zuid Eindopdracht 2 v1.dwg
  16. Friend, almost a year later, I noticed that you had responded to me, how sorry I feel for you, I simply abandoned the idea that the XREF thing could be done. I apologize because I had not seen it. These days I will be reviewing the code. And I reiterate my APOLOGIES, please!! I forgot to mark FOLLOW TOPIC!! I am very stupid!!
  17. Brooooo, you got it right!!!! That is the solution !! Is there a way to send you a small donation? I'm not wealthy, but I want to acknowledge your help!! You are great bro!!!
  18. marko_ribar

    PLINETOOLS

    Version 1.0.0

    3 downloads

    Just a link for topic where PLINETOOLS.ZIP is publicly posted... HTH. Regards, M.R.
  19. PlPath-t+b.lsp (top + bottom) is part of PLINETOOLS archive, so I am posting link where routine is posted publicly in code tag... Link : HTH. Regards; M.R.
  20. One option would be to use a 3-point arc along with a dashed linetype.
  21. [XDrX-PlugIn(156)] Keep the blocks on the polyline and delete other blocks with. (theswamp.org) https://www.theswamp.org/index.php?topic=59504.msg620549#msg620549 (defun c:xdtb_pl_tolerase (/ E typ blkname ss fence-box plane) (xd::doc:getdouble (xdrx-string-multilanguage "\n搜索范围" "\nSearch range tolerance" ) "#xd-var-global-search-tol" (xd::doc:getpickboxheight) ) (xd::doc:getdouble (xdrx-string-multilanguage "\n点线容差精度" "Point and line tolerance" ) "#xd-var-global-tol-dist" (xdrx-getvar "equalpoint") ) (if (and (setq e (car (xdrx-entsel (xdrx-string-multilanguage "\n拾取特征图元类型<退出>:" "\nPick feature entity type<Exit>:" ) ) ) ) (setq typ (assoc 0 (entget e)) blkname (xdrx-getpropertyvalue e "name") ) (setq ss (xdrx-ssget (xdrx-string-multilanguage "\n选择多段线<退出>:" "\nSelect Polyline<Exit>:" ) '((0 . "*polyline")) ) ) ) (progn (xdrx-begin) (mapcar '(lambda (x) (if (and (setq fence-box (xdrx-getpropertyvalue x "tofence" #xd-var-global-search-tol 1 ) ) (setq fence-box (xdrx-getsamplept fence-box)) (setq ss1 (ssget "cp" fence-box (list typ) ) ss2 (ssget "f" (xdrx-getsamplept x) (list typ)) ) ) (progn (setq nums 0 plane (xdrx-getpropertyvalue x "plane" t) ) (mapcar '(lambda (y) (setq position (xdrx-getpropertyvalue y "position" ) closest (xdrx-getpropertyvalue x "getclosestpointto" position ) position (xdrx-point-orthoproject position plane) closest (xdrx-point-orthoproject closest plane) ) (if (not (equal closest position #xd-var-global-tol-dist)) (progn (setq nums (1+ nums)) (xdrx-entity-delete y) ) ) ) (xdrx-ss->ents ss1) ) (xdrx-prompt (xdrx-string-formatex (xdrx-string-multilanguage "\n共删除了 %d 个容差范围内的不在多段线线上的图块." "\nA total of %d tiles matching the feature criteria were deleted." ) nums ) ) ) ) ) (xdrx-ss->ents ss) ) (xdrx-end) ) ) (princ) ) ==================== The above code uses XDRX API, download link: https://github.com/xdcad https://sourceforge.net/projects/xdrx-api-zip/ http://bbs.xdcad.net
  22. SLW210

    3D AutoCAD welding

    No weld tool, I just extrude a triangle or sometimes Chamfer or Filet to smooth the connection.
  23. nonifo

    Change attribute via lisp?

    I have my block EPCB000, which is my title block. I want to change all the text inside this block to new text. The drawing is a copy of an electric cabinet, but it needs new text details as it's for a new customer. Inside my block EPCB000, there are a few attributes: D12, D13, GODK_DAT, and so on. I want to update the value of those tags in bulk, and apply a few rules, such as using today's date. For example, if D12 holds the value "G11 This is a drawing", I want to update it to G12, and so on. However, I can't figure out how to read and write to those values.
  24. Hello, I’m working on this project. I’m so glad I found this thread because I was having some trouble getting started. So far I’m almost done and I think it’s going well. I’m a little stuck on making the dimensions, I can’t seem to be able to make the arched and dash lines for the dimensions. If I could get some help I know this is old but if anyone could help I would appreciate it.
  25. Can only be obtained using ARX’s AcApDocument class XDrx API provides two functions to obtain the program name and path of the currently loaded LISP and ARX Command: (xdrx-document-loadedlisplist) ("acetDelayLoad.fas" "xd-lisp-lib.vlx" "xdtb_init.vlx" "xdob_lib.vlx" "xdtb_main.vlx" "xdrx.lsp" "acad2025.LSP" "acad2025doc.LSP" "xdsoft.mnl") Command: (xdrx-document-loadedlisplist t) ("C:\\Program Files\\Autodesk\\AutoCAD 2025\\Express\\acetDelayLoad.fas" "D:\\mydevlop\\baidusyncdisk\\xdrx-20160405\\xdrx_api\\release\\sys64\\xd-lisp-lib.vlx" "D:\\XDSoft\\lisp\\xdtb_init.vlx" "D:\\XDSoft\\lisp\\xdob_lib.vlx" "D:\\XDSoft\\lisp\\xdtb_main.vlx" "D:\\mydevlop\\baidusyncdisk\\xdrx-20160405\\xdrx_api\\release\\sys64\\xdrx.lsp" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\Support\\acad2025.LSP" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\Support\\en-us\\acad2025doc.LSP" "D:\\XDSoft\\SYS\\xdsoft.mnl") Command: (xdrx-document-loadedarxlist) ("acapp.arx" "acapp.crx" "acautoloader.arx" "acautoloader.crx" "acblock.crx" "acblockplace.crx" "acbr25.dbx" "acconnectwebservices.arx" "accoremgd.dll" "accounting.arx" "accounting.crx" "acdim.arx" "acdim.crx" "acexperience.arx" "acfdui.arx" "acgeomentobj.dbx" "acgsconfig.arx" "acgsconfig.crx" "acismobj25.dbx" "acismui.crx" "acjscorestub.crx" "acmgd.dll" "acmpolygonobj25.dbx" "acobjclassimp.arx" "acocschemautil.arx" "acopm.arx" "acopmext.arx" "acpexctl.arx" "acpi.arx" "acsceneoe.dbx" "acsearchservice.crx" "acshareviewpropsaca.dbx" "acshareviewpropspe.dbx" "acsign.arx" "acsmnav.arx" "actable.arx" "actable.crx" "acvmtools.crx" "acxdiff.arx" "acxdiff.crx" "aecarchbase.dbx" "aecbase.dbx" "aecbaseex.dbx" "aeccore.crx" "aecloader.arx" "aecmodeler.dbx" "aecprojectbase.dbx" "aecschedule.dbx" "appload.arx" "opendcl.x64.25.arx" "rectang.crx" "units.arx" "units.crx" "vl.arx" "vl.crx" "xdrx.2025.x64.arx") Command: (xdrx-document-loadedarxlist t) ("C:\\Program Files\\Autodesk\\AutoCAD 2025\\acapp.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acapp.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acautoloader.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acautoloader.crx" "c:\\program files\\autodesk\\autocad 2025\\acblock.crx" "c:\\program files\\autodesk\\autocad 2025\\acblockplace.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acbr25.dbx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acconnectwebservices.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\accoremgd.dll" "c:\\program files\\autodesk\\autocad 2025\\accounting.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AcCounting.crx" "c:\\program files\\autodesk\\autocad 2025\\acdim.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acdim.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acexperience.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AcFdUi.arx" "c:\\program files\\autodesk\\autocad 2025\\acgeomentobj.dbx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acgsconfig.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acgsconfig.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acismobj25.dbx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acismui.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AcJsCoreStub.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acmgd.dll" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AcMPolygonObj25.dbx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acobjclassimp.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AcOcSchemaUtil.arx" "c:\\program files\\autodesk\\autocad 2025\\acopm.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acopmext.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AcPEXCtl.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AcPi.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AcSceneOE.dbx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acsearchservice.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acshareviewpropsaca.dbx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AcShareViewPropsPE.dbx" "c:\\program files\\autodesk\\autocad 2025\\acsign.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acsmnav.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\actable.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\actable.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acvmtools.crx" "c:\\program files\\autodesk\\autocad 2025\\acxdiff.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\acxdiff.crx" "c:\\program files\\autodesk\\autocad 2025\\aecarchbase.dbx" "c:\\program files\\autodesk\\autocad 2025\\aecbase.dbx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AecBaseEx.dbx" "c:\\program files\\autodesk\\autocad 2025\\aeccore.crx" "c:\\program files\\autodesk\\autocad 2025\\aecloader.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AecModeler.dbx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AecProjectBase.dbx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\AecSchedule.dbx" "c:\\program files\\autodesk\\autocad 2025\\appload.arx" "d:\\xdsoft\\sys\\opendcl\\opendcl.x64.25.arx" "c:\\program files\\autodesk\\autocad 2025\\rectang.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\units.arx" "c:\\program files\\autodesk\\autocad 2025\\units.crx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\vl.arx" "C:\\Program Files\\Autodesk\\AutoCAD 2025\\vl.crx" "d:\\mydevlop\\baidusyncdisk\\xdrx-20160405\\xdrx_api\\release\\sys64\\xdrx.2025.x64.arx") ============================================== XDrx API Download Link: https://github.com/xdcad https://sourceforge.net/projects/xdrx-api-zip/
  26. I think this will help you: (defun c:pp() (setq ed (entget (car (entsel "select image ")))) (strcat " X= " (rtos (cadr (assoc 10 ed))) " Y= " (rtos (caddr (assoc 10 ed))) " dX= " (rtos (* (cadr (assoc 11 ed)) (cadr (assoc 13 ed)))) " dY= " (rtos (* (caddr (assoc 12 ed)) (caddr (assoc 13 ed))))) )
  27. Try this mod. It should draw both top and bottom... Then you can select what is sufficient and remove what is undesirable... If you want pick with mouse for side - it has the same effect like selecting opposition - it has equal steps for working drawing situation... (defun c:PlPath-t+b ( / *error* PlPath-foo rlw ListClockwise-p AssocOn MR:GetVertices MR:GetBulges _intl prelst suflst _buildlist osm sp spp ep epp opt ss ss1 ss2 plstart plend plx hpllst rpllst pts+buls ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun *error* ( m ) (if osm (setvar (quote osmode) osm) ) (if m (prompt m) ) (princ) ) (defun PlPath-foo ( opt pl ss / _while a b bb ab lst lstab ii ent pln ret pls bls ptlst ptbulg pttbulg ) (defun _while ( i loop ) (while loop (setq i (1+ i)) (setq pls (_buildlist (setq sp (list (car sp) (cadr sp))) (nth i lst))) (foreach pt pls (setq bls (cons (assocon pt (nth i lstab) (function car) 1e-6) bls)) ) (setq bls (reverse bls)) (if (nth (1+ i) lst) (if (vl-member-if (function (lambda ( x ) (equal (list (car ep) (cadr ep)) x 1e-6))) (if (/= i (atoi (rtos (/ (length lst) 2.0)))) (prelst pls (car (_intl pls (nth (1+ i) lst)))) (if (equal (nth i lst) (last lst)) (last lst) (prelst pls (last (_intl pls (nth (1+ i) lst)))) ) )) (setq sp (list (car ep) (cadr ep)) loop nil) (if (/= i (atoi (rtos (/ (length lst) 2.0)))) (setq sp (car (_intl pls (nth (1+ i) lst)))) (setq sp (last (_intl pls (nth (1+ i) lst)))) ) ) (setq sp (list (car ep) (cadr ep)) loop nil) ) (setq pls (prelst pls sp)) (setq bls (prelst bls (assocon sp (nth i lstab) (function car) 1e-6))) (setq ptlst (append ptlst pls)) (setq ptbulg (append ptbulg bls)) (setq pls nil bls nil) ) (list ptlst ptbulg) ) (while ss (gc) (if (and (= opt 1) (= (cdr (assoc 0 (entget pl))) "POLYLINE")) (progn (setq hpllst (cons pl hpllst)) (vl-cmdf "_.convertpoly" "_l" pl "") (entupd pl) ) ) (if (= opt 1) (if (not (ListClockwise-p (MR:GetVertices pl))) (progn (setq rpllst (cons pl rpllst)) (rlw pl) ) ) (if (ListClockwise-p (MR:GetVertices pl)) (progn (setq rpllst (cons pl rpllst)) (rlw pl) ) ) ) (setq a (MR:GetVertices pl)) (setq b (MR:GetBulges pl)) (if (= opt 1) (if (not (ListClockwise-p a)) (setq a (reverse a) b (reverse (mapcar (function (lambda ( x ) (* (- 1.0) x))) b)) bb (cdr b) b (append bb (list (car b))) ab (mapcar (function (lambda ( x y ) (cons x y))) a b)) (setq ab (mapcar (function (lambda ( x y ) (cons x y))) a b)) ) (if (ListClockwise-p a) (setq a (reverse a) b (reverse (mapcar (function (lambda ( x ) (* (- 1.0) x))) b)) bb (cdr b) b (append bb (list (car b))) ab (mapcar (function (lambda ( x y ) (cons x y))) a b)) (setq ab (mapcar (function (lambda ( x y ) (cons x y))) a b)) ) ) (setq lst (cons a lst) lstab (cons ab lstab)) (setq ss (vl-remove pl ss)) (repeat (setq ii (length ss)) (setq ent (nth (setq ii (1- ii)) ss)) (if (not (vl-catch-all-error-p (vl-catch-all-apply (function safearray-value) (list (vl-catch-all-apply (function variant-value) (list (vla-intersectwith (vlax-ename->vla-object pl) (vlax-ename->vla-object ent) AcExtendNone))))))) (setq pln ent) ) ) (if pln (setq pl pln)) ) (setq lst (reverse lst) lstab (reverse lstab)) (if (and (cdr (reverse lst)) (cdr (reverse lstab))) (setq lst (append lst (cdr (reverse lst))) lstab (append lstab (cdr (reverse lstab)))) ) (setq ret (_while -1 t)) (setq ptlst (car ret)) (setq ptbulg (cadr ret)) (setq ptlst (append ptlst (list (list (car ep) (cadr ep))))) (setq ptbulg (append ptbulg (list (assocon (list (car ep) (cadr ep)) (reverse (apply (function append) (reverse lstab))) (function car) 1e-6)))) (if (vl-some (function (lambda ( x ) (null x))) ptlst) (setq ptlst (vl-remove nil ptlst)) ) (if (vl-some (function (lambda ( x ) (null x))) ptbulg) (setq ptbulg (vl-remove nil ptbulg)) ) (if (vl-some (function (lambda ( x ) (equal (cdr x) nil))) ptbulg) (mapcar (function (lambda ( x ) (if (equal (cdr x) nil) (setq pttbulg (cons 0.0 pttbulg)) (setq pttbulg (cons (cdr x) pttbulg))))) ptbulg) (setq pttbulg (mapcar (function cdr) (reverse ptbulg))) ) (list (setq ptlst (mapcar (function (lambda ( x ) (list (car x) (cadr x)))) ptlst)) (setq pttbulg (reverse pttbulg)) ) ) (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 ) ;; by ElpanovEvgeniy ;; reverse lwpolyline (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE") (progn (foreach a1 e (cond ( (= (car a1) 10) (setq x2 (cons a1 x2)) ) ( (= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)) ) ( (= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)) ) ( (= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)) ) ( (= (car a1) 210) (setq x6 (cons a1 x6)) ) ( t (setq x1 (cons a1 x1)) ) ) ) (entmod (append (reverse x1) (append (apply (function append) (apply (function mapcar) (cons (function list) (list x2 (cdr (reverse (cons (car x3) (reverse x3)))) (cdr (reverse (cons (car x4) (reverse x4)))) (cdr (reverse (cons (car x5) (reverse x5)))) ) ) ) ) x6 ) ) ) (entupd lw) ) ) ) (defun ListClockwise-p ( lst / z vlst ) (vl-catch-all-apply (function minusp) (list (if (not (equal 0.0 (setq z (apply (function +) (mapcar (function (lambda ( u v ) (- (* (car u) (cadr v)) (* (car v) (cadr u))) ) ) (setq vlst (mapcar (function (lambda ( a b ) (mapcar (function -) b a)) ) (mapcar (function (lambda ( x ) (car lst))) lst) (cdr (reverse (cons (car lst) (reverse lst)))) ) ) (cdr (reverse (cons (car vlst) (reverse vlst)))) ) ) ) 1e-6 ) ) z (progn (prompt "\n\nChecked vectors are collinear - unable to determine clockwise-p of list") (exit) ) ) ) ) ) (defun assocon ( searchterm lst func fuzz ) (car (vl-member-if (function (lambda ( pair ) (equal searchterm (apply func (list pair)) fuzz)) ) lst ) ) ) (defun MR:GetVertices ( ent / lst ) (if ent (setq lst (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget ent)))) ) ) (defun MR:GetBulges ( ent / lst ) (if ent (setq lst (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) (entget ent)))) ) ) (defun _intl ( l1 l2 / ll1 ll2 a ls1 ls2 ) (setq ll1 l1 ll2 l2 ) (while (setq a (car ll2)) (while ll1 (if (equal a (car ll1) 1e-8) (setq ls1 (append ls1 (list a)) ll1 (cdr ll1) ) (setq ll1 (cdr ll1)) ) ) (setq ll2 (cdr ll2) ll1 (vl-remove a l1) ) ) (setq ll1 l1 ll2 l2 ) (while (setq a (car ll1)) (while ll2 (if (equal a (car ll2) 1e-8) (setq ls2 (append ls2 (list a)) ll2 (cdr ll2) ) (setq ll2 (cdr ll2)) ) ) (setq ll1 (cdr ll1) ll2 (vl-remove a l2) ) ) (if (< (length ls1) (length ls2)) ls1 ls2) ) (defun prelst ( lst el / f ) (vl-remove-if (function (lambda ( a ) (or f (setq f (equal a el 1e-8))))) lst) ) (defun suflst ( lst el ) (cdr (vl-member-if (function (lambda ( a ) (equal a el 1e-8))) lst)) ) (defun _buildlist ( sp lst ) (append (list sp) (suflst lst sp) (prelst lst sp)) ) (setq osm (getvar (quote osmode))) (setvar (quote osmode) 1) (setq sp (getpoint "\nSelect Start Point : ")) (setq ep (getpoint sp "\nSelect End Point : ")) (setq ss (ssget (list (cons 0 "*POLYLINE") (cons -4 "<or") (cons 70 0) (cons 70 1) (cons 70 128) (cons 70 129) (cons -4 "or>") (cons 410 (if (= 1 (getvar (quote cvport))) (getvar (quote ctab)) "Model"))))) (setq ss1 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss)))) (setq ss2 ss1) (setq plstart (car (nentselp sp)) plend (car (nentselp ep))) (setq sp (trans sp 1 plstart) ep (trans ep 1 plend)) (setq spp (list (car sp) (cadr sp)) epp (list (car ep) (cadr ep))) (setq opt 0) (repeat 2 (setq opt (1+ opt)) (setq sp spp ep epp) (setq pts+buls (PlPath-foo opt plstart ss1)) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (assoc 38 (setq plx (entget plstart))) (cons 90 (length (car pts+buls))) (cons 70 (if (= 1 (getvar (quote plinegen))) 128 0 ) ) ) (apply (function append) (mapcar (function (lambda ( p b ) (list (cons 10 p) (cons 42 b)))) (car pts+buls) (cadr pts+buls))) (list (assoc 210 plx)) ) ) ) (foreach pl rpllst (rlw pl) ) (foreach pl hpllst (vl-cmdf "_.convertpoly" "_h" pl "") (entupd pl) ) (*error* nil) ) HTH. M.R.
  1. Load more activity
×
×
  • Create New...