Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/04/2022 in all areas

  1. The problem with this last drawing you uploaded is that zero polylines truly intersect with any circle. I moved 5 circles to truly intersect with a polyline and re-uploaded the drawing. You can find out which with my routine here below. Command SFP. (vl-load-com) ;; Intersections - Lee Mac ;; http://www.lee-mac.com/intersectionfunctions.html ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method ;; acextendnone Do not extend either object ;; acextendthisentity Extend obj1 to meet obj2 ;; acextendotherentity Extend obj2 to meet obj1 ;; acextendboth Extend both objects (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) ) ;;;;;;;;;;;;;;;;;;;; ;; how to grip elements: ;;;; make an empty pickset ;; (setq pickset1 (ssadd)) ;;;; add ssget elements 1 by one ;; (ssadd (ssname ss 1) pickset1) ;; (ssadd (ssname ss 2) pickset1) ;; ... ;;;; then grip the pickset ;; (sssetfirst nil pickset1) ;; SFP for Select Fence Problem (defun c:SFP ( / plines_3d circles i j pickset1 ins skip) (setq pickset1 (ssadd)) (princ "\nSelect 3D Polylines: ") (setq plines_3d (ssget (list (cons 0 "POLYLINE,LWPOLYLINE")))) ;; maybe add this group? ;;(setq plines_3d (ssget (list (cons 0 "POLYLINE,LWPOLYLINE") (cons 100 "AcDb3dPolyline") ))) (princ "\nSelect Circles: ") (setq circles (ssget (list (cons 0 "CIRCLE,ELLIPSE")))) ;; double loop over all 3D poly and circles. ;; check for each pair if they intersect. (setq j 0) (repeat (sslength circles) (setq skip nil) ;; once we find 1 intersect point we can skip looking at the other polylines, for that circle (setq ob2 (ssname circles j)) (setq i 0) (repeat (sslength plines_3d) (if (not skip) (progn (setq ob1 (ssname plines_3d i)) (setq ins (LM:intersections (vlax-ename->vla-object ob1) (vlax-ename->vla-object ob2) acextendnone )) ;; now if this pair intersects we add the circle to the picklist (if (> (length ins) 0) (progn (setq skip T) (ssadd (ssname circles j) pickset1) )) )) (setq i (+ i 1)) ) (setq j (+ j 1)) ) (sssetfirst nil pickset1) (princ (strcat "\n" (itoa (sslength pickset1)) " circles selected") ) (princ) ) select-fence-problem.dwg
    2 points
  2. Best way to learn is by having a go.... Taking it step by step then, start by making a LISP file - you should be able to do that and copy this into it which will allow you t select text and get the value, then can take the next step and you'll learn as you go along: (defUn c:test ( / Mytext MyTextVal ) ;;define the LISP routine. After the / are local variables used only in this LISP (princ "Select Text") ;; princ - puts a message in the command line (setq MyText (entget (ssname (ssget "_+.:E:S" '((0 . "TEXT"))) 0))) ;; Select a selection, the other parts linit this here to 1 tect object (setq MyTextVal (cdr (assoc 1 MyText))) ;; get the text from the selected text above MyTextVal ;;returns the text value from this LISP ) ;; end the routine See if this works for you then can do the next step
    1 point
  3. Reading your question as you write it, yes you can. If I read it correctly, you want to select a text, then an object and offset or move that object by the value of the text? How is your LISP programming? You can use something like (setq MyText (entget(car (entsel "Select Text")))) or (setq MyText (entget (ssname (ssget "_+.:E:S" '((0 . "TEXT"))) 0))) to get the text definition, and then use (setq MyTextVal (assoc 1 MyText)) To extract the value of the text The text value should be returned as a string, not a number. You can change a string to a number using atoi and after that apply that to the object you want to move, copy or offset. You might want to do a check that the text is a number before you do atoi else it will be an error Is that enough to give you a clue and help you work out what to do?
    1 point
  4. I'm not sure if I understand what you want. Here's a Front view. Those are (normal 2D) polylines, not 3D polylines. And the way I see it only the top circles touch the polyline. The rest don't intersect. Care to further elaborate what you want? Edit: there's a thing called apparent intersection. that's when a projection of the drawing has things intersecting. Is ahat something you want?
    1 point
  5. what is the LISP code you are using to get the selection? Post that to if you can
    1 point
  6. cad64 I think wants like solution for like match a rectang with 2 diagonals. (defun c:xxx ( / pt1 pt2 pt3 pt4) (setq pt1 (getpoint "\nPick 1st point ") pt2 (getpoint pt1 "\npick 2nd point ")) (setq pt3 (list (car pt2) (cadr pt1)) pt4 (list (car pt1) (cadr pt2))) (command "line" pt1 pt2 "") (command "line" pt3 pt4 "") (princ) ) (c:xxx) Eiler your turn now.
    1 point
  7. Instead of using a lisp routine, you can simply change the setting of PDMODE to 3 and then use the POINT command to place crosses. https://knowledge.autodesk.com/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2020/ENU/AutoCAD-Core/files/GUID-82F9BB52-D026-4D6A-ABA6-BF29641F459B-htm.html
    1 point
  8. This will do it, using regular selection like you would using the MOVE or COPY command. If the two lines are already in a group, that makes it even better because then you can just select the group in one click, but you said you've got a large number of lines, so I highly doubt you have them... Command will keep continuing until you select nothing (or 'Esc'): (defun c:foo ( / ip m p1 p2 p3 p4 ss) (defun m (a b) (mapcar '/ (mapcar '+ a b) '(2.0 2.0 2.0))) (while (setq ss (ssget '( (-4 . "<OR") (0 . "LINE") (-4 . "<AND") (0 . "LWPOLYLINE") (90 . 2) (-4 . "<NOT") (-4 . "!=") (42 . 0.0) (-4 . "NOT>") (-4 . "AND>") (-4 . "OR>") ) ) ) (if (/= (sslength ss) 2) (princ "\nSelect only two straight lines to proceed.") (progn (setq p1 (vlax-curve-getstartpoint (ssname ss 0)) p2 (vlax-curve-getendpoint (ssname ss 0)) p3 (vlax-curve-getstartpoint (ssname ss 1)) p4 (vlax-curve-getendpoint (ssname ss 1)) ) (cond ( (setq ip (inters p1 p2 p3 p4 nil)) (if (> (distance ip p1) (distance ip p2)) (mapcar 'set '(p1 p2) (list p2 p1))) (if (> (distance ip p3) (distance ip p4)) (mapcar 'set '(p3 p4) (list p4 p3))) ) ( (not (equal (angle p1 p2) (angle p3 p4) 1e-6)) (mapcar 'set '(p3 p4) (list p4 p3)) ) ) (entmake (list '(0 . "LINE") (cons 10 (m p1 p3)) (cons 11 (m p2 p4)))) ) ) ) (princ) )
    1 point
  9. I think there's a Centerline command that you can use instead of a LISP code. The only result is that it's a centerline entity and not a line entity.
    1 point
  10. Hi, here is my newer version for this kind of job... Regards, M.R. IDEA Network Topology-new-reza-all-lengths.dwg lengths_along_pipe_trees-Djikstra.lsp length_along_pipe_trees-Djikstra.lsp lengths_along_pipe_trees.lsp length_along_pipe_trees.lsp
    1 point
  11. It works, but now i got 6 decimal numbers, not 4, as before.. Did I wrote down correctly?: ;;---------------------=={ Total Area }==---------------------;; ;; ;; ;; Displays the total area of selected objects at the ;; ;; command line. The precision of the printed result is ;; ;; dependent on the setting of the LUPREC system variable. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;; ;;------------------------------------------------------------;; (defun c:tarea ( / a i s ) (if (setq s (ssget '( (0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE") (-4 . "<NOT") (-4 . "<AND") (0 . "POLYLINE") (-4 . "&") (70 . 80) (-4 . "AND>") (-4 . "NOT>") ) ) ) (progn (setq a 0.0) (repeat (setq i (sslength s)) (setq a (+ a (vlax-curve-getarea (ssname s (setq i (1- i)))))) ) (princ "\nTotal Area: ") (princ (rtoc a 15)) ) ) (princ) ) (vl-load-com) (princ) (defun rtoc ( n p / d i l x ) (setq d (getvar 'dimzin)) (setvar 'dimzin 0) (setq l (vl-string->list (rtos (abs n) 2 p)) x (cond ((cdr (member 46 (reverse l)))) ((reverse l))) i 0 ) (setvar 'dimzin d) (vl-list->string (append (if (minusp n) '(45)) (reverse (apply 'append (mapcar '(lambda ( a b ) (if (and (zerop (rem (setq i (1+ i)) 3)) b) (list a 44) (list a) ) ) x (append (cdr x) '(nil)) ) ) ) (member 46 l) ) ) )
    1 point
×
×
  • Create New...