Jump to content

Circular cutting problem


myloveflyer

Recommended Posts

After running the program recently, the circle will be lost and the cutting will not be complete. See the attached figure!After running the program recently, the circle will be lost and the cutting will not be complete. See the attached figure! Which friend can help me solve it?

(defun c:test(/ wj-s wjq-s wjg-s)
(start-dwg)
(wj1)
(wj2)
(princ)
(princ)
)
(defun start-dwg()
(setvar "osmode" 0)
(setvar "blipmode" 0)
(setvar "cmdecho"  0)
)
(defun wj1()
(setq wj-con1   (getpoint "\nF_Point:")
      wj-con2   (getcorner wj-con1 "\nS_Point:")
);end of wj-con.
(setq wj-s      (ssget "w" wj-con1 wj-con2 '((0 . "CIRCLE")))
      wj-sn     (sslength  wj-s)
      wjq-index  0
);end of setq
(command "change" wj-s "" "p" "c" "3" "")
(repeat wj-sn
                (setq wjq-s   (ssname wj-s wjq-index)
		      wjq-e   (entget(ssname wj-s wjq-index))
		      wjq-c   (cdr(assoc 10 wjq-e))
		      wjq-r   (cdr(assoc 40 wjq-e))		      
		      wjq-e   (subst(cons 40 60)(assoc 40 wjq-e)wjq-e)
                )
                (entmod wjq-e)
                (command "extend" wjq-s "" "f")
		(setq f-n 0)
                (repeat 180
                (command (polar wjq-c(/ (* 2 f-n pi) 180)(+ wjq-r 300)))
                (setq f-n (+ f-n 1))
                )
                (command "" "")
                (setq wjq-index (+ wjq-index 1))
);end of repeat
);end of wj1
(defun wj2()
(setq  wjg-s      (ssget "w" wj-con1 wj-con2 '((0 . "LINE")))
       wjg-n      (sslength wjg-s)
       wjg-index  0
);end of setq-g.
(repeat wjg-n
(setq   wjg-s1      (ssname wjg-s wjg-index)
        wjg-e       (entget wjg-s1)
        wjg-e-s     (cdr(assoc 10 wjg-e))
	wjg-e-e     (cdr(assoc 11 wjg-e))
	wjg-len     (distance wjg-e-s wjg-e-e)
	wjg-len-n1  (+ 120.0 wjg-len)
	wjg-len-n2  (- wjg-len 74.0)
	wjg-e-s-x   (car  wjg-e-s)
	wjg-e-s-y   (cadr wjg-e-s)
	wjg-e-e-x   (car  wjg-e-e)
	wjg-e-e-y   (cadr wjg-e-e)
	wjg-mid     (list (/(+ wjg-e-s-x wjg-e-e-x)2.0) (/(+ wjg-e-s-y wjg-e-e-y)2.0))
	wjg-s-a     (angle wjg-e-e wjg-e-s)
        wjg-e-a     (angle wjg-e-s wjg-e-e)
        wjg-a-str1  (strcat "@-60<"(rtos(/(* 180 wjg-e-a)pi)2))
	wjg-a-str2  (strcat "@60<"(rtos(/(* 180 wjg-e-a)pi)2))
	wjg-of1-st  (strcat "@10<90")
	wjg-of2-st  (strcat "@10<-90")
);end of setq
(command "change" wjg-s1 "" "p" "c" "7" "")
(command "copy" wjg-s1 "" "0,0" "@")
(command "scale" "p" "" wjg-mid "r" wjg-len wjg-len-n1)
(command "change" "p" "" "p" "c" "8" "")
(command "change" "p" "" "p" "lt" "ACAD_ISO04W100" "S" "30" "")
(command "scale" "l" "" wjg-mid "r" wjg-len wjg-len-n2)
(command "offset" "24" wjg-mid wjg-of1-st "")
(command "erase" "P" "")
(command "mirror" "l" "" wjg-e-s wjg-e-e "")
(command "line" wjg-e-s wjg-a-str1 "")
(setq fz-line       (entlast)
      fz-line-e     (cdr(assoc 11(entget fz-line)))
)
(command "erase" "l" "")
(command "insert" "d:/Test/120-GJ" fz-line-e "" "" (rtos(/(* 180 wjg-e-a)pi)2))
(command "explode" "l")
(command "insert" "d:/Test/120_Line" fz-line-e "" "" (rtos(/(* 180 wjg-e-a)pi)2))
(command "explode" "l")
(setq pm-li         (entlast)
      pm-tr1        (strcat "@59<"(rtos(+ 2.0(/(* 180 wjg-e-a)pi))2))
      pm-tr2        (strcat "@61<"(rtos(+ 2.0(/(* 180 wjg-e-a)pi))2))
);end of trim's cond
(command "trim" pm-li "" "f" pm-tr1 pm-tr2 "" "")
(command "line" wjg-e-e wjg-a-str2 "")
(setq fz-line       (entlast)
      fz-line-e     (cdr(assoc 11(entget fz-line)))
)
(command "erase" "l" "")
(command "insert" "d:/Test/120-GJ" fz-line-e "" "" (rtos(/(* 180 wjg-s-a)pi)2))
(command "explode" "l")
(command "insert" "d:/Test/120_Line" fz-line-e "" "" (rtos(/(* 180 wjg-s-a)pi)2))
(command "explode" "l")
(setq pm-li         (entlast)
      pm-tr1        (strcat "@59<"(rtos(+ 2.0(/(* 180 wjg-s-a)pi))2))
      pm-tr2        (strcat "@61<"(rtos(+ 2.0(/(* 180 wjg-s-a)pi))2))
)
(command "trim" pm-li "" "f" pm-tr1 pm-tr2 "" "")
(setq  wjg-index  (1+ wjg-index))
);end of repeat
);end of wj2

 

120_Line.dwg 120-GJ.dwg Test_2.dwg

Link to comment
Share on other sites

The center lines of the structural members do not intersect at the center of the nodes. The green 'trim' lines that seem based on those center lines are also inaccurate. If you zoom in it is rather obvious.

Edited by Roy_043
Link to comment
Share on other sites

On 8/18/2019 at 4:34 AM, Roy_043 said:

结构构件的中心线在节点中心不相交。基于这些中心线的绿色“修剪”线也是不准确的。如果你放大,这是相当明显的。

ROY, it is, but is there any way to ignore this? Because some profiles are the output of the calculation software!Thanks

Link to comment
Share on other sites

If the lines in the original drawing are inaccurate, then no doubt the circles (the nodes) are also. These inaccuracies are likely caused by a rounding of coordinates. You should first check if the output from your 'calculation software' can be improved.

 

If this is not possible I would assume that the centers of the circles are correct and modify the lines so that they run from center to center.

The code published here can be modified to accomplish that.

Edited by Roy_043
Link to comment
Share on other sites

Hi,Roy!

Can you help me to modify it? Because I write programs that rarely use VL to complete, it leads to unfamiliar use of VL functions.

Link to comment
Share on other sites

(vl-load-com)

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun c:ExtendToNode ( / cen cirLst doc linLst rad ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "LINE,CIRCLE"))))
    (progn
      (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
        (if (= "AcDbLine" (vla-get-objectname obj))
          (setq linLst
            (vl-list*
              (list (vlax-get obj 'startpoint) T obj)
              (list (vlax-get obj 'endpoint) nil obj)
              linLst
            )
          )
          (setq cirLst (cons obj cirLst))
        )
      )
      (foreach cir cirLst
        (setq cen (vlax-get cir 'center))
        (setq rad (vla-get-radius cir))
        (foreach sub linLst
          (if (equal rad (distance cen (car sub)) 1e-1)
            (progn
              (vlax-put
                (caddr sub) ; Line object.
                (if (cadr sub) 'startpoint 'endpoint)
                cen
              )
              (setq linLst (vl-remove sub linLst))
            )
          )
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

Link to comment
Share on other sites

Hii,Roy!

Maybe I explained a bit confusing. The original program I wrote was to process circles and lines by inserting two graphics (120_Line.dwg, 120_GJ.dwg) at the specified position.

On 8/17/2019 at 9:08 AM, myloveflyer said:

After running the program recently, the circle will be lost and the cutting will not be complete. See the attached figure!After running the program recently, the circle will be lost and the cutting will not be complete. See the attached figure! Which friend can help me solve it?


(defun c:test(/ wj-s wjq-s wjg-s)
(start-dwg)
(wj1)
(wj2)
(princ)
(princ)
)
(defun start-dwg()
(setvar "osmode" 0)
(setvar "blipmode" 0)
(setvar "cmdecho"  0)
)
(defun wj1()
(setq wj-con1   (getpoint "\nF_Point:")
      wj-con2   (getcorner wj-con1 "\nS_Point:")
);end of wj-con.
(setq wj-s      (ssget "w" wj-con1 wj-con2 '((0 . "CIRCLE")))
      wj-sn     (sslength  wj-s)
      wjq-index  0
);end of setq
(command "change" wj-s "" "p" "c" "3" "")
(repeat wj-sn
                (setq wjq-s   (ssname wj-s wjq-index)
		      wjq-e   (entget(ssname wj-s wjq-index))
		      wjq-c   (cdr(assoc 10 wjq-e))
		      wjq-r   (cdr(assoc 40 wjq-e))		      
		      wjq-e   (subst(cons 40 60)(assoc 40 wjq-e)wjq-e)
                )
                (entmod wjq-e)
                (command "extend" wjq-s "" "f")
		(setq f-n 0)
                (repeat 180
                (command (polar wjq-c(/ (* 2 f-n pi) 180)(+ wjq-r 300)))
                (setq f-n (+ f-n 1))
                )
                (command "" "")
                (setq wjq-index (+ wjq-index 1))
);end of repeat
);end of wj1
(defun wj2()
(setq  wjg-s      (ssget "w" wj-con1 wj-con2 '((0 . "LINE")))
       wjg-n      (sslength wjg-s)
       wjg-index  0
);end of setq-g.
(repeat wjg-n
(setq   wjg-s1      (ssname wjg-s wjg-index)
        wjg-e       (entget wjg-s1)
        wjg-e-s     (cdr(assoc 10 wjg-e))
	wjg-e-e     (cdr(assoc 11 wjg-e))
	wjg-len     (distance wjg-e-s wjg-e-e)
	wjg-len-n1  (+ 120.0 wjg-len)
	wjg-len-n2  (- wjg-len 74.0)
	wjg-e-s-x   (car  wjg-e-s)
	wjg-e-s-y   (cadr wjg-e-s)
	wjg-e-e-x   (car  wjg-e-e)
	wjg-e-e-y   (cadr wjg-e-e)
	wjg-mid     (list (/(+ wjg-e-s-x wjg-e-e-x)2.0) (/(+ wjg-e-s-y wjg-e-e-y)2.0))
	wjg-s-a     (angle wjg-e-e wjg-e-s)
        wjg-e-a     (angle wjg-e-s wjg-e-e)
        wjg-a-str1  (strcat "@-60<"(rtos(/(* 180 wjg-e-a)pi)2))
	wjg-a-str2  (strcat "@60<"(rtos(/(* 180 wjg-e-a)pi)2))
	wjg-of1-st  (strcat "@10<90")
	wjg-of2-st  (strcat "@10<-90")
);end of setq
(command "change" wjg-s1 "" "p" "c" "7" "")
(command "copy" wjg-s1 "" "0,0" "@")
(command "scale" "p" "" wjg-mid "r" wjg-len wjg-len-n1)
(command "change" "p" "" "p" "c" "8" "")
(command "change" "p" "" "p" "lt" "ACAD_ISO04W100" "S" "30" "")
(command "scale" "l" "" wjg-mid "r" wjg-len wjg-len-n2)
(command "offset" "24" wjg-mid wjg-of1-st "")
(command "erase" "P" "")
(command "mirror" "l" "" wjg-e-s wjg-e-e "")
(command "line" wjg-e-s wjg-a-str1 "")
(setq fz-line       (entlast)
      fz-line-e     (cdr(assoc 11(entget fz-line)))
)
(command "erase" "l" "")
(command "insert" "d:/Test/120-GJ" fz-line-e "" "" (rtos(/(* 180 wjg-e-a)pi)2))
(command "explode" "l")
(command "insert" "d:/Test/120_Line" fz-line-e "" "" (rtos(/(* 180 wjg-e-a)pi)2))
(command "explode" "l")
(setq pm-li         (entlast)
      pm-tr1        (strcat "@59<"(rtos(+ 2.0(/(* 180 wjg-e-a)pi))2))
      pm-tr2        (strcat "@61<"(rtos(+ 2.0(/(* 180 wjg-e-a)pi))2))
);end of trim's cond
(command "trim" pm-li "" "f" pm-tr1 pm-tr2 "" "")
(command "line" wjg-e-e wjg-a-str2 "")
(setq fz-line       (entlast)
      fz-line-e     (cdr(assoc 11(entget fz-line)))
)
(command "erase" "l" "")
(command "insert" "d:/Test/120-GJ" fz-line-e "" "" (rtos(/(* 180 wjg-s-a)pi)2))
(command "explode" "l")
(command "insert" "d:/Test/120_Line" fz-line-e "" "" (rtos(/(* 180 wjg-s-a)pi)2))
(command "explode" "l")
(setq pm-li         (entlast)
      pm-tr1        (strcat "@59<"(rtos(+ 2.0(/(* 180 wjg-s-a)pi))2))
      pm-tr2        (strcat "@61<"(rtos(+ 2.0(/(* 180 wjg-s-a)pi))2))
)
(command "trim" pm-li "" "f" pm-tr1 pm-tr2 "" "")
(setq  wjg-index  (1+ wjg-index))
);end of repeat
);end of wj2

 

120_Line.dwg 22.68 kB · 2 downloads 120-GJ.dwg 24.37 kB · 2 downloads Test_2.dwg 768.8 kB · 4 downloads

 

Link to comment
Share on other sites

I found this old function in my library waaayyy back when we used to trim lines around blocks for legibility. Then I got wise and started using masks :) .. maybe it will help you.

(defun c:foo (/ rjp-trimcircle s)
  (defun rjp-trimcircle	(circle segs / cen circle cnt pts rad s)
    (setq cnt 0)
    (setq cen (cdr (assoc 10 (entget circle))))
    (setq rad (cdr (assoc 40 (entget circle))))
    (repeat segs
      (setq pts	(cons (polar cen (+ 0 (* cnt (/ (* pi 2) segs))) rad) pts)
	    cnt	(1+ cnt)
      )
    )
    (setq pts (append pts (list (car pts))))
    (vlax-invoke (vlax-get-acad-object) 'zoomcenter cen (* 3. rad))
    (if	(setq s (ssget "_F" pts '((0 . "ARC,CIRCLE,LINE,*POLYLINE,SPLINE,ELLIPSE"))))
      (foreach x (vl-remove circle (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
	(command "._trim" circle "" "_F")
	(apply 'command pts)
	(command "" "")
      )
    )
    (princ)
  )
  (cond	((setq s (ssget '((0 . "circle"))))
	 (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (rjp-trimcircle x 100))
	)
  )
  (princ)
)

 

2019-08-21_8-25-23.gif

Edited by ronjonp
Link to comment
Share on other sites

HI,Roy!

You look at my drawing (120_Line.dwg), there is a problem with the insertion of the round cut (the circle is missing or the cut with the inserted line is not complete or the cut between the inserted lines is not complete), I really don't know how to deal with it. , your program, I have modified the tolerance as you said, (Code)and it runs very well, can you follow the drawings I provided?

HI,ronjonp

Can I write the program according to the drawing I provided (Test_2.dwg), according to the inserted drawing (120_Line.dwg, 120_GJ.dwg), or directly in the program without considering the inserted graphics.

Edited by myloveflyer
Link to comment
Share on other sites

I assumed you were looking for an explanation as to why your code failed. But apparently you already knew why (although you failed to mention this in your OP) and you actually want someone to rewrite your application. I am not willing to do that. At least not as a free service.

Link to comment
Share on other sites

11 hours ago, Roy_043 said:

我以为您正在寻找一个解释为什么您的代码失败。但是很明显,您已经知道了原因(尽管您在操作中没有提到这一点),而且您实际上希望有人重写您的应用程序。我不愿意那样做。至少不是免费服务。

Hi,Roy!

Sorry to bring you trouble, I just want to know that my program is wrong in that place, correct that part of the program can eliminate the error, if necessary, I will pay a fee!

Link to comment
Share on other sites

I think you can solve your own problem if you create regions from the circular nodes and then subtract rectangular regions (using the _Subtract command) to create the flat areas. The rectangular regions can be put in a block similar to what you are doing with the "120-48-20" block. And they can be oversized to avoid accuracy problems.

Link to comment
Share on other sites

Hi,Roy!

I am going to rewrite this code, do not insert the file processing from the outside, draw the required graphics directly inside the program, I don't know if I can write successfully, if I don't understand, I still need to ask you.

Edited by myloveflyer
Link to comment
Share on other sites

IMO this is not a good idea. Using blocks for this task is the obvious way forward. I would never explode the "120-48-20"  blocks.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...