Announcements

Starting in December, we will archive content from the community that is 10 years and older. This FAQ provides more information.

Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Please help me to fix this lisp!

8 REPLIES 8
SOLVED
Reply
Message 1 of 9
boyds86
496 Views, 8 Replies

Please help me to fix this lisp!

Choose lines with layer 11. Choose lines with layer 12, if distance <0.1 will change to layer 15 and points at both sides will draw a line with layer 44. Thank you for your help!
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:AD()
 
  (setq ss1 (ssget "_:L" '((0 . "LINE") (8 . "11")))) ;; 
 
  (setq ss2 (ssget "_:L" '((0 . "LINE") (8 . "12")))) ;; 
 
  (if (or (not ss1) (not ss2))
    (progn
      ()
      (return)
    )
  )
 (setq distThreshold 0.1)
 
 (setq i 0)
  (repeat (sslength ss1) 
  (setq line1 (ssname ss1 i)) 
  (setq entityType (cdr (assoc 0 (entget line1))))
    (cond
      ((= entityType "LINE")  
        (setq pt1a (cdr (assoc 10 (entget line1))))  
        (setq pt1b (cdr (assoc 11 (entget line1))))  
      ))
 
 
 
   (setq j 0)
    (repeat (sslength ss2)
      (setq line2 (ssname ss2 j))
 
  
      (setq entityType2 (cdr (assoc 0 (entget line2))))
      (cond
        ((= entityType2 "LINE") 
          (setq pt2a (cdr (assoc 10 (entget line2))))  
          (setq pt2b (cdr (assoc 11 (entget line2))))    
        ))
 
      (if (and pt1a pt1b pt2a pt2b)
(progn
 
      (setq mid1 (list (/ (+ (car pt1a) (car pt1b)) 2) (/ (+ (cadr pt1a) (cadr pt1b)) 2)))
   
      (setq mid2 (list (/ (+ (car pt2a) (car pt2b)) 2) (/ (+ (cadr pt2a) (cadr pt2b)) 2)))
 
      (setq dist (distance mid1 mid2))
 
         (setq dist1 (distance pt1a pt2a))
      (setq dist2 (distance pt1b pt2b))
      
    (if (< dist distThreshold)
        (progn
  ;;;;;;;
  (if (or (> dist1 distThreshold) (> dist2 distThreshold))
            (progn
   
  
              (entmake (list (cons 0 "LINE") (cons 10 pt1a) (cons 11 pt2a) (cons 8 "44"))) 
              (entmake (list (cons 0 "LINE") (cons 10 pt1b) (cons 11 pt2b) (cons 8 "44")))
                       )
          )
  
  ))))
 
  (setq j (1+ j))
    )
 
     (setq i (1+ i))
  )
  (princ)
)
8 REPLIES 8
Message 2 of 9
Sea-Haven
in reply to: boyds86

Looks like CHATGP code as you have lots of not needed code. You use ssget with "Line" so no need to check is object a Line. Something else in code does not look right. The If distThreshold.

 

Not sure what your doing. Maybe post a dwg showing before and after.

Message 3 of 9
boyds86
in reply to: Sea-Haven

@Sea-Haven 
Thank you for yourReply, the Fig. below and the dwg file showing that i need. 

 

boyds86_0-1728872480442.png

 

Message 4 of 9
Kent1Cooper
in reply to: boyds86


@boyds86 wrote:
.... if distance <0.1 ....
 
....
  (if (or (not ss1) (not ss2))
    (progn
      ()
      (return)
    )
  )
....

 

In your sample drawing, the distances are in scores or even hundreds of units, ridiculously far beyond 0.1.  Either you need to use a very much bigger value for that comparison, or you need to be working with very much smaller pieces.

 

You don't say what happens when you run it, or doesn't happen, or whether you get any messages, or even whether it loads successfully.  But if it loads but then just does nothing when you run it, the first suspect in my mind is that disconnect between the distance comparison and the actual distances involved.

 

I agree this looks like AI-generated code, and AI is [so far] notorious for not understanding AutoLisp very well.  One part that suggests it is the code portion quoted above.  The () is utterly pointless, and there is no AutoLisp (return) function.  What are you expecting it to do if either selection set is empty?

Kent Cooper, AIA
Message 5 of 9
Sea-Haven
in reply to: boyds86

Looking at the supplied dwg can understand what you want is to use the yellow line as a cut function to an underlying line. Need to have a full rewrite for task different approach. No need for the 0.1 as a ssget "F" should find the linework.

 

Will have a think about it maybe later today.

Message 6 of 9
boyds86
in reply to: boyds86

Dear @Sea-Haven @Kent1Cooper ,

 

My problem is that: Comparing lines, overlaping section (Common section) will turn to layer 15, and the remaining section will change to layer 44. I want to detect the different after comparing lines.

Thank you for your help!

Message 7 of 9
Kent1Cooper
in reply to: Kent1Cooper


@Kent1Cooper wrote:

....

In your sample drawing, the distances are in scores or even hundreds of units, ridiculously far beyond 0.1.  Either you need to use a very much bigger value for that comparison, or you need to be working with very much smaller pieces.

....

Looking at it more closely, it appears the intent of the 0.1 value is to find whether Lines overlap, or nearly do.  But it looks at the distance between their midpoints, not the distance between them.  That distance is far beyond 0.1 in all cases in your sample drawing.  It needs to look at the distances from endpoints of one Line to nearest point on the other Line or its virtual extension.

 

It also appears to assume the overlapping Lines will always be drawn in the same direction.  That is not the case in your sample drawing -- some are, and some are drawn in opposite directions.

Kent Cooper, AIA
Message 8 of 9
Kent1Cooper
in reply to: boyds86

Here's how I would go about this [lightly tested in your drawing]:

(defun C:AD
  (/ ss ss11 ss12 n11 foundit line1 start1 end1
    n12 line2 start2 end2 angdelta samedir)
  (command "_.layer" "_unlock" "11,12" "")
  (setq
    ss (ssget '((0 . "LINE") (8 . "11,12"))); all in one selection
    ss11 (ssget "_P" '((8 . "11")))
  ); ssget
  (sssetfirst nil ss); select/grip/highlight again for:
  (setq ss12 (ssget '((8 . "12"))))
  (if (and ss11 ss12); there are some on each Layer
    (progn ; then
      (repeat (setq n11 (sslength ss11))
        (setq
          foundit nil ; reset for each Layer-11 Line
          line1 (ssname ss11 (setq n11 (1- n11)))
          start1 (cdr (assoc 10 (entget line1)))
          end1 (cdr (assoc 11 (entget line1)))
          n12 (sslength ss12); [what remains of it, if any]
        ); setq
        (while (and (not foundit) (> n12 0))
          ; ends when Layer-12 Line overlap found, or if none found after looking at all
          (setq
            line2 (ssname ss12 (setq n12 (1- n12)))
            start2 (cdr (assoc 10 (entget line2)))
            end2 (cdr (assoc 11 (entget line2)))
          ); setq
          (if
            (and ; collinear within 0.1 unit:
              (< (distance start1 (vlax-curve-getClosestPointTo line2 start1 T)) 0.1)
              (< (distance end1 (vlax-curve-getClosestPointTo line2 end1 T)) 0.1)
              (or ; and overlapping [either endpoint of either one on unextended other]:
                (vlax-curve-getClosestPointTo line2 start1 nil)
                (vlax-curve-getClosestPointTo line2 end1 nil)
                (vlax-curve-getClosestPointTo line1 start2 nil)
                (vlax-curve-getClosestPointTo line1 end2 nil)
              ); or
            ); and
            (progn ; then
              (setq
                angdelta (abs (- (angle start1 end1) (angle start2 end2)))
                samedir (or (equal angdelta 0 0.01) (equal angdelta (* pi 2) 0.01))
                  ; second test for possible tiny difference at/near 0° direction
              ); setq
              (command
                "_.chprop" line1 line2 "" "_layer" "15" ""
                "_.line" start1 (if samedir start2 end2) ""
                "_.chprop" "_last" "" "_layer" "44" ""
                "_.line" end1 (if samedir end2 start2) ""
                "_.chprop" "_last" "" "_layer" "44" ""
              ); command
              (ssdel line1 ss11) (ssdel line2 ss12); remove both from selection sets
              (setq foundit T); end search relative to current Layer-11 Line
            ); progn
          ); if [no else -- do nothing if not overlapping/collinear
        ); while
      ); repeat
    ); progn [then]
  ); if [selection sets from both Layers]
  (prin1)
)

You can select all the Lines on both Layers together, rather than the other code's requiring two separate selections.

 

Oddly, the Layer-44 Lines, though the most-recently-drawn, don't always all appear "on top."  A DRAWORDER command could be incorporated to make them.

 

And it could use the usual stuff -- *error* handling, Undo begin/end wrapping, Osnap control if you might have running Osnap modes that do not include ENDpoint, etc. -- but first see whether it does what you want.

Kent Cooper, AIA
Message 9 of 9
boyds86
in reply to: Kent1Cooper

@Kent1Cooper 
It is great! This is the lisp that I really need. It helped my current Problem & my company!

Thank you so much for your support!

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

AutoCAD Inside the Factory


Autodesk Design & Make Report