« previous next »
Pages: [1] |   Go Down

Author Topic: Help with code - Join Lines  (Read 3113 times)

0 Members and 1 Guest are viewing this topic.

nekonihonjin

  • Newt
  • Posts: 103
Help with code - Join Lines
« on: December 31, 2015, 01:04:31 PM »
Good day everyone I have the next code that creates a tunnel profile wich I use at work.

I'm trying to join the lines and arcs but the join command does nothing, if I do it mannually it join them.

Code: [Select]
(defun c:xro2()

(setq EsqInfIzq (getpoint "\nEsquina Inferior Izquierda: "))
(setq EsqSupDer (getcorner EsqInfIzq "\nEsquina Superior Derecha: "))
(command "_line" EsqInfIzq "@1,0" "" )
(setq linea1 (entlast))
(command "_line" EsqInfIzq "@0,1" "" )
(setq linea2 (entlast))
(command "_line" EsqSupDer "@-1,0" "" )
(setq linea3 (entlast))
(command "_line" EsqSupDer "@0,-1" "" )
(setq linea4 (entlast))
(command "_filletrad" "0.0" )
(command "_.fillet" linea1 linea4 ) 
(command "_filletrad" "0.8" )
(command "_.fillet"  linea3 linea4 )
(setq curva1 (entlast))
(command "_.fillet"  linea2 linea3 )
(setq curva2 (entlast))


(command "_join" linea1 linea2 linea3 linea4 curva1 curva2 "")


(princ)
)


edit kdub: Changed post title to be more descriptive.


« Last Edit: December 31, 2015, 04:36:24 PM by Kerry »
Logged

mailmaverick

  • Bull Frog
  • Posts: 494
Re: Help with code - Join Lines
« Reply #1 on: January 01, 2016, 02:02:40 AM »
It is working absolutely fine for me in AUTOCAD 2015.

Maybe your osmode, orthmode and snapmode etc are not correct. Try following code :-

Code: [Select]
(defun c:xro2 ()
  (setq oldosmode (getvar 'osmode))
  (setq oldorthomode (getvar 'orthomode))
  (setq oldsnapmode (getvar 'snapmode))
  (setvar 'osmode 0)
  (setvar 'orthomode 0)
  (setvar 'snapmode 0)
  (setq EsqInfIzq (getpoint "\nEsquina Inferior Izquierda: "))
  (setq EsqSupDer (getcorner EsqInfIzq "\nEsquina Superior Derecha: "))
  (command "_line" EsqInfIzq "@1,0" "")
  (setq linea1 (entlast))
  (command "_line" EsqInfIzq "@0,1" "")
  (setq linea2 (entlast))
  (command "_line" EsqSupDer "@-1,0" "")
  (setq linea3 (entlast))
  (command "_line" EsqSupDer "@0,-1" "")
  (setq linea4 (entlast))
  (command "_filletrad" "0.0")
  (command "_.fillet" linea1 linea4)
  (command "_filletrad" "0.8")
  (command "_.fillet" linea3 linea4)
  (setq curva1 (entlast))
  (command "_.fillet" linea2 linea3)
  (setq curva2 (entlast))
  (command "_join" linea1 linea2 linea3 linea4 curva1 curva2 "")
  (setvar 'osmode oldosmode)
  (setvar 'orthomode oldorthomode)
  (setvar 'snapmode oldsnapmode)
  (princ)
)
Logged

Beekee

  • Mosquito
  • Posts: 19
Re: Help with code - Join Lines
« Reply #2 on: January 01, 2016, 08:40:33 AM »
You can use a polyline... then no need to join anything.

Code: [Select]
(defun c:xro3 ( / EsqInfIzq EsqSupDer enlast)
  (if (and (setq EsqInfIzq (getpoint "\nEsquina Inferior Izquierda: "))
   (setq EsqSupDer (getcorner EsqInfIzq "\nEsquina Superior Derecha: "))
   (setq enlast (entlast))
   )
    (progn
      (command "_PLINE"
       "_none" (list (car EsqSupDer) (cadr EsqInfIzq) 0.)
       "_none" EsqSupDer
       "_none" (list (car EsqInfIzq) (cadr EsqSupDer) 0.)
       "_none" EsqInfIzq
       "")
      (if (not (equal enlast (entlast)))
(command "_.FILLET" "_R" "0.8"
"_.FILLET" "_P" (entlast)
"_.PEDIT" (entlast) "_CL" ""))))
  (princ)
)
Logged

ribarm

  • Gator
  • Posts: 3293
  • Marko Ribar, architect
Re: Help with code - Join Lines
« Reply #3 on: January 04, 2016, 08:14:27 AM »
No, JOIN is working through command line interface like :

Code: [Select]
(command "_.JOIN" (ssname ss 0) ss "")

And it's also working like command - you use interface and type JOIN and supply your selection...

But unfortunately it's not working through ALISP routine... I've tested this on A2014...
Another quirk...
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

nekonihonjin

  • Newt
  • Posts: 103
Re: Help with code - Join Lines
« Reply #4 on: January 04, 2016, 09:50:30 AM »
Quote from: mailmaverick on January 01, 2016, 02:02:40 AM
It is working absolutely fine for me in AUTOCAD 2015.

Maybe your osmode, orthmode and snapmode etc are not correct. Try following code :-

Code: [Select]
(defun c:xro2 ()
  (setq oldosmode (getvar 'osmode))
  (setq oldorthomode (getvar 'orthomode))
  (setq oldsnapmode (getvar 'snapmode))
  (setvar 'osmode 0)
  (setvar 'orthomode 0)
  (setvar 'snapmode 0)
  (setq EsqInfIzq (getpoint "\nEsquina Inferior Izquierda: "))
  (setq EsqSupDer (getcorner EsqInfIzq "\nEsquina Superior Derecha: "))
  (command "_line" EsqInfIzq "@1,0" "")
  (setq linea1 (entlast))
  (command "_line" EsqInfIzq "@0,1" "")
  (setq linea2 (entlast))
  (command "_line" EsqSupDer "@-1,0" "")
  (setq linea3 (entlast))
  (command "_line" EsqSupDer "@0,-1" "")
  (setq linea4 (entlast))
  (command "_filletrad" "0.0")
  (command "_.fillet" linea1 linea4)
  (command "_filletrad" "0.8")
  (command "_.fillet" linea3 linea4)
  (setq curva1 (entlast))
  (command "_.fillet" linea2 linea3)
  (setq curva2 (entlast))
  (command "_join" linea1 linea2 linea3 linea4 curva1 curva2 "")
  (setvar 'osmode oldosmode)
  (setvar 'orthomode oldorthomode)
  (setvar 'snapmode oldsnapmode)
  (princ)
)

Thanks for your answer, but it's the same result, I have autocad 2013, don't know if the version is the problem.
Logged

nekonihonjin

  • Newt
  • Posts: 103
Re: Help with code - Join Lines
« Reply #5 on: January 04, 2016, 09:53:32 AM »
Quote from: Beekee on January 01, 2016, 08:40:33 AM
You can use a polyline... then no need to join anything.

Code: [Select]
(defun c:xro3 ( / EsqInfIzq EsqSupDer enlast)
  (if (and (setq EsqInfIzq (getpoint "\nEsquina Inferior Izquierda: "))
   (setq EsqSupDer (getcorner EsqInfIzq "\nEsquina Superior Derecha: "))
   (setq enlast (entlast))
   )
    (progn
      (command "_PLINE"
       "_none" (list (car EsqSupDer) (cadr EsqInfIzq) 0.)
       "_none" EsqSupDer
       "_none" (list (car EsqInfIzq) (cadr EsqSupDer) 0.)
       "_none" EsqInfIzq
       "")
      (if (not (equal enlast (entlast)))
(command "_.FILLET" "_R" "0.8"
"_.FILLET" "_P" (entlast)
"_.PEDIT" (entlast) "_CL" ""))))
  (princ)
)


It worked perfectly, thank you very much.
Logged

ribarm

  • Gator
  • Posts: 3293
  • Marko Ribar, architect
Re: Help with code - Join Lines
« Reply #6 on: February 14, 2016, 04:03:46 AM »
Quote from: ribarm on January 04, 2016, 08:14:27 AM
No, JOIN is working through command line interface like :

Code: [Select]
(command "_.JOIN" (ssname ss 0) ss "")

And it's also working like command - you use interface and type JOIN and supply your selection...

But unfortunately it's not working through ALISP routine... I've tested this on A2014...
Another quirk...

Sorry for late reply, but only recently I've discovered that this fix works...

Code: [Select]
(defun c:jj ( / ss )
  (setq ss (ssget "_:L" '((0 . "LINE,ARC"))))
  (command "_.PEDIT" (ssname ss 0) "")
  (command "_.JOIN" (entlast) ss "")
  (princ)
)

HTH, M.R.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Help with code - Join Lines
« Reply #7 on: February 17, 2016, 01:39:46 PM »
I have had similar issues in the past, so I wrote my own join all command, you may be able to adapt it into your code.

Here is what I use:
Code: [Select]
;Written by: Chris Wade
;Permission to use/modify/distribute is granted as long as this notice remains and all changes are documented.
(DEFUN C:ja ( / *error* uFlag doc StopLoop SelSet SelLen LoopCT)
(defun ja-work (SelSet)
(if (/= SelSet nil)
(progn
(vla-StartUndoMark doc)
(setq uFlag t)
(setq SelLen (sslength SelSet))
(setq LoopCT 0)
(while (< LoopCT SelLen)
(vl-cmdf "._join" (ssname SelSet LoopCT) SelSet "")
(setq LoopCT (+ LoopCT 1))
)
(vla-EndUndoMark doc)
(setq uFlag nil)
)
)
)
(vl-load-com)
(setq doc   (vla-get-ActiveDocument
                (vlax-get-acad-object)))
(defun *error* (msg)
(if (and uflag doc) (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(while (= StopLoop nil)
(princ  "\nPlease select the objects that you would like to join:  ")
(setq SelSet (ssget))
(cond
((/= SelSet nil)
(ja-work SelSet)
)
(T
(setq StopLoop T)
)
)

    )
(princ)
);defun c:ja
Logged

ribarm

  • Gator
  • Posts: 3293
  • Marko Ribar, architect
Re: Help with code - Join Lines
« Reply #8 on: February 17, 2016, 03:51:32 PM »
Here are my snippets...

Code - Auto/Visual Lisp: [Select]
  1. ;; Return - LWPOLYLINE
  2. (defun c:jj1 ( / ss )
  3.   (setq ss (ssget "_:L" '((0 . "LINE,ARC"))))
  4.   (command "_.PEDIT" (ssname ss 0) "")
  5.   (command "_.JOIN" (entlast) ss "")
  6.   (princ)
  7. )
  8.  
  9. ;| This isn't working...
  10. (defun c:jj2 ( / ss )
  11.   (setq ss (ssget "_:L" '((0 . "LWPOLYLINE,LINE,ARC"))))
  12.   (command "_.PEDIT" (ssname ss 0) "")
  13.   (command "_.JOIN" (entlast) ss "")
  14.   (princ)
  15. )
  16. |;
  17.  
  18. ;; Return - SPLINE(LWPOLYLINE)
  19. (defun c:jj2 ( / ss )
  20.   (setq ss (ssget "_:L" '((0 . "LINE,ARC"))))
  21.   (sssetfirst nil ss)
  22.   (c:2ndss2spls)
  23.   (setq ssp (ssget "_I"))
  24.   (command "_.JOIN" (ssname ssp 0) ssp "")
  25.   (princ)
  26. )
  27.  
  28. ;; Return - SPLINE (2D or 3D)
  29. (defun c:jj3 ( / ss )
  30.   (setq ss (ssget "_:L" '((0 . "SPLINE"))))
  31.   (command "_.JOIN" (ssname ss 0) ss "")
  32.   (princ)
  33. )
  34.  
  35. ;;; Conclusion - You can NOT join frogs and grandmas... You can join entities with the compatibile properties...
  36.  
  37. ;;; Additional routine : (c:2ndss2spls)
  38.  
  39. (defun c:2ndss2spls ( / *error* arc2spl line2spl loop sss i ent ssss )
  40.  
  42.  
  43.   (defun *error* ( msg )
  45.     (if msg (prompt msg))
  46.     (princ)
  47.   )
  48.  
  49.   (defun arc2spl ( e / make_spline points q1 q2 a pc f pe ps w )
  50.  
  51.            (setq q1 (vlax-curve-GetStartParam e)
  52.                  q2 (vlax-curve-GetEndParam e)
  53.                  a  (/ (- (vlax-curve-GetEndParam e) (vlax-curve-GetStartParam e)) 3.0) ; a - parameter interval... and angle
  54.                  pc (mapcar                              ; pc - points on contur
  55.                       (function
  56.                         (lambda (p)
  57.                          (vlax-curve-GetPointAtParam e p)
  58.                           )
  59.                         )
  60.                       (list q1 (+ q1 a) (- q2 a) q2)
  61.                     )
  62.                  f  (mapcar                               ; f - first deriv on pc
  63.                       (function
  64.                         (lambda (p)
  65.                           (vlax-curve-GetFirstDeriv e p)
  66.                           )
  67.                         )
  68.                       (list q1 (+ q1 a) (- q2 a) q2)
  69.                     )
  70.                  pe (mapcar                              ; pe - extra control points for spline construction
  71.                       (function
  72.                         (lambda (p1 p2 d1 d2)
  73.                           (inters p1 (mapcar '+ p1 d1)
  74.                                   p2 (mapcar '+ p2 d2)
  75.                                   nil
  76.                                   )
  77.                         )
  78.                       )
  79.                      pc (cdr pc) f (cdr f)
  80.                     )
  81.                  ps  (list (car pc) (car pe) (cadr pc) (cadr pe) (caddr pc) (caddr pe) (cadddr pc)) ; ps - control points for spline
  82.                  w   (list 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0)  ; weights for spline
  83.            )
  84.  
  85.     (defun make_spline ( pts )
  86.       (entmakex
  87.         (append
  88.            '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline")
  89.               (70 . 4) (71 . 2) (72 . 10) (73 . 7) (74 . 0)
  90.               (42 . 1.0e-010) (43 . 1.0e-010)
  91.               (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0)
  92.               (40 . 2.0) (40 . 2.0) (40 . 3.0) (40 . 3.0) (40 . 3.0))
  93.            pts
  94.         )
  95.       )
  96.     )
  97.  
  98.     (defun points ( p w )
  99.       (apply 'append (mapcar '(lambda (a b) (list (cons 10 a) (cons 41 b))) p w))
  100.     )
  101.  
  102.     (entdel e)
  103.     (make_spline (points ps w))
  104.    
  105.   )
  106.  
  107.   (defun line2spl ( e / sp ep d )
  108.  
  109.     (setq sp (cdr (assoc 10 (entget e)))
  110.           ep (cdr (assoc 11 (entget e)))
  111.           d (distance sp ep)
  112.     )
  113.  
  114.     (entdel e)
  115.  
  116.     (entmakex
  117.       (list
  118.         '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)
  119.         '(42 . 1.0e-010) '(43 . 1.0e-010) '(40 . 0.0) '(40 . 0.0) (cons 40 d) (cons 40 d) (cons 10 sp) (cons 10 ep)
  120.       )
  121.     )
  122.    
  123.   )
  124.  
  126.   (setq loop T)
  127.   (setq sss (ssget "_I"))
  128.   (if
  129.     (and
  130.       sss
  131.       (vl-some '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "LINE,ARC,*POLYLINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss))))
  132.     )
  133.     (setq loop nil)
  134.   )
  135.   (while loop
  136.     (setq sss (ssget "_:L" (list '(-4 . "<or") '(0 . "LINE,ARC,LWPOLYLINE") '(-4 . "<and") '(0 . "POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 . 8) '(70 . 9) '(70 . 128) '(70 . 129) '(-4 . "or>") '(-4 . "and>") '(-4 . "or>"))))
  137.     (if sss (setq loop nil))
  138.   )
  139.   (setq ssss (ssadd))
  140.   (repeat (setq i (sslength sss))
  141.     (setq ent (ssname sss (setq i (1- i))))
  142.     (cond
  143.       ( (eq (cdr (assoc 0 (entget ent))) "LINE")
  144.         (line2spl ent)
  145.         (ssadd (entlast) ssss)
  146.       )
  147.       ( (eq (cdr (assoc 0 (entget ent))) "ARC")
  148.         (arc2spl ent)
  149.         (ssadd (entlast) ssss)
  150.       )
  151.       ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
  152.         (sssetfirst nil (ssadd ent))
  153.         (c:lw2spl)
  154.         (ssadd (entlast) ssss)
  155.         (sssetfirst nil nil)
  156.       )
  157.       ( (and
  158.           (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
  159.           (or
  160.             (eq (cdr (assoc 70 (entget ent))) 0)
  161.             (eq (cdr (assoc 70 (entget ent))) 1)
  162.             (eq (cdr (assoc 70 (entget ent))) 128)
  163.             (eq (cdr (assoc 70 (entget ent))) 129)
  164.           )
  165.         )
  166.         (command "_.CONVERTPOLY" "_L" ent)
  167.         (while (> (getvar 'cmdactive) 0) (command ""))
  168.         (sssetfirst nil (ssadd ent))
  169.         (c:lw2spl)
  170.         (ssadd (entlast) ssss)
  171.         (sssetfirst nil nil)
  172.       )
  173.       ( (and
  174.           (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
  175.           (or
  176.             (eq (cdr (assoc 70 (entget ent))) 8)
  177.             (eq (cdr (assoc 70 (entget ent))) 9)
  178.           )
  179.         )
  180.         (sssetfirst nil (ssadd ent))
  181.         (c:3p2spl)
  182.         (ssadd (entlast) ssss)
  183.         (sssetfirst nil nil)
  184.       )
  185.     )
  186.   )
  187.   (sssetfirst nil ssss)
  188.   (*error* nil)
  189. )
  190.  

M.R.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube
Pages: [1] |   Go Up
« previous next »