topic Re: Find circles on Line Object in Visual LISP, AutoLISP and General Customization Forum

Find circles on Line Object

avinash00002002 — Thu, 02 Dec 2021 09:22:42 GMT

Hi!

How to find circles on Line object in Autolisp. (center of circle is one the line points) It can be nos. of circles.

Thanks,

Avinash

Re: Find circles on Line Object

hosneyalaa — Thu, 02 Dec 2021 12:45:05 GMT

For better help,

attach the Autocad drawing

Re: Find circles on Line Object

ronjonp — Thu, 02 Dec 2021 15:44:55 GMT

Try this:

(defun c:foo (/ c el l r s) ;; RJP » 2021-12-02 (cond ((setq s (ssget "_X" '((0 . "CIRCLE,LINE")))) (foreach e (mapcar 'cadr (ssnamex s)) (if (= "CIRCLE" (cdr (assoc 0 (setq el (entget e))))) (setq c (cons (list (cdr (assoc 10 el)) e) c)) (setq l (cons (list (vlax-curve-getstartpoint e) (vlax-curve-getendpoint e)) l)) ) ) (if l (progn (setq r (ssadd)) (foreach p (apply 'append l) (and (vl-some '(lambda (x) (and (equal (car x) p 1e-8) (setq a (cadr x)))) c) (ssadd a r) ) ) (sssetfirst nil r) ) ) ) ) (princ) )

Re: Find circles on Line Object

avinash00002002 — Fri, 03 Dec 2021 06:16:45 GMT

please find drawing.

Re: Find circles on Line Object

hak_vz — Fri, 03 Dec 2021 07:21:17 GMT

@avinash00002002

Once you find your circles, what you want to do? Create a selection set, take their center points, distance from the start or....? Be more specific with your request.

Re: Find circles on Line Object

avinash00002002 — Fri, 03 Dec 2021 08:40:33 GMT

after selection of lines it will select circles which are on line object. and then get in selection set and then sorting x-direction and give aligned dimensions center to center

Re: Find circles on Line Object

diagodose2009 — Fri, 03 Dec 2021 10:23:19 GMT

I compile your program, three-version.

Command: q2[cnter] Scan all 18circles for minRadius:[Yes/No]Y ToleranceRadius between [8.75...8.75]=0.4 Circle Manually[Yes/No/no-toAll]=Y Select objects: Pick first line= Set Color-ForLine[1..254,0-skip]=20 Pick Next line= EndT Command:

(Defun jc_cws12(start count / $rs) (setq $rs (substr asm_cws12 start count)) (if (= $rs "") (setq $rs "eCws12Failed")) $rs) (SeTq asm_cws12 "\nEndLINEERROR**You drawing do not contain any LineERROR**You drawing do not contain any Circle[YN]\nScan all circles for minRadius:[Yes/No]\nToleranceRadius between [...]=USERR3\nGive minRadius,:=[YAN]\nCircle Manually[Yes/No/no-toAll]=CIRCLEangelinaBrown123@gmail.com\nPick first line=\nSet Color-ForLine[1..254,0-skip]=\nPick Next line=CIRCLE,LINE<ANDAND>STR\nByA:DragneAdrian2019=T469error<>Str:PICKSETENAMECECOLORLAYERpp_lcirclew10_autoexec.lsp") ;;LCIDCountEMax=(nn_vmload 26) ;;LCIDMaxofSize=(php_echo 46) (setq const_systasserte nil acad__assertNo 0) (princ) (setq setmypid "https://youtu.be/JMB9nElXNuc") (princ (setvar "ModeMacro" "Call-StackError=(C:pid7612)")) (defun C:pid7612(/ ) (princ "Pidgen.dll=") (princ pidgen.dll) (princ "\nHiStack=") (princ pidgen10rsp) (princ "\nHiDos=") (princ setmypid) ) (terpri) (setq pidgen10rsp nil pidgen.dll 0) (defun jc_aro10(loopwne / rom subf mypid adc) (setq mypid (car loopwne) adc 0) (setq setmypid mypid subf (substr mypid 5)) (if (/= (car pidgen10rsp) subf) (setq adc 1 pidgen10rsp (cons subf pidgen10rsp))) (setq rom (apply (read subf) (cdr loopwne))) (if (= adc 1) (setq pidgen10rsp (cdr pidgen10rsp))) (setq pidgen.dll (1+ pidgen.dll)) ;; (if (> pidgen.dll 920) (princ "Hi! eBreakPoint kHereAiciHeirIciAqui=")) rom) (DeFun C:q2() (setq;|a722124|; dfn_pp_v1chkR nil) (desktop_app) ) (Defun asserte(mssg / rr) (setq;|a011|; acad__assertNo (+ acad__assertNo 1)) (if (/= mssg nil) (setq;|a000|; erprv erlsp erlsp mssg)) erlsp) (DeFun C:desktop_app() (desktop_app ) ) (prompt "\nCommand.com= C:Q2[enter] or Q2[enter]\n") (Defun desktop_app( / ) ;------------------------Stdcall "nn_vmload " (setq _ax (nn_vmload )) ;------------------------ (princ (jc_cws12 1 4)) T) ;;(defun RenderCmds0h( / cpp);; ;;10sudo dpkg --add ;stdcall ;;(setq RenderCmd3cpp 10));; ;(User Labels) ;(nn_vmload) (Defun nn_vmload(/ $rr fns sbcl idx clrf dyn lineall allc entc ida ptx enl pt3 rad3 rdef objline objc c40 min40 max40 colorlin nowlin ask cec nop) (setq;|a190605244|; lineall (jc_aro10 (list "C073dfn_ssg_allcirclemod" (jc_cws12 5 4)))) (if (< (car lineall) 2) (progn (jc_aro10 (list "C074alert" (jc_cws12 9 42))) (exit))) (setq;|a243123876|; allc (jc_aro10 (list "C075dfn_ssg_allcirclemod" nil))) (if (< (car allc) 2) (progn (jc_aro10 (list "C076alert" (jc_cws12 51 44))) (exit))) (setq;|a67633439|; min40 19780209) (setq;|a190605244|; max40 -5002) (setq;|a279|; rdef 19780209) (setq;|a67622913|; ida (- (car allc) 1)) (setq;|a000|; ask (jc_aro10 (list "C077dfn_getx_readkey" (jc_cws12 95 4) (list (jc_cws12 99 10) (+ ida 1) (jc_cws12 109 30))))) (if (= ask "Y") (progn (while (>= ida 0) (progn (setq;|a67124809|; c40 (jc_aro10 (list "C078dfn_ent_assoc" 40 (jc_aro10 (list "C079ssname" (jc_aro10 (list "C080cadr" allc)) ida)))) min40 (if (and (jc_aro10 (list "C081numberp" c40)) (< c40 min40) (> c40 0.0)) c40 min40) max40 (if (and (jc_aro10 (list "C082numberp" c40)) (> c40 max40)) c40 max40))) (setq;|a243134060|; ida (- ida 1))))) (if (>= min40 0) (progn (setq;|a67669057|; rdef min40) (jc_aro10 (list "C083php_echo" (list (jc_cws12 139 26) min40 (jc_cws12 165 3) max40 (jc_cws12 168 2)))) (setq;|a67124768|; rad3 (jc_aro10 (list "C084getreal" ""))) (setq;|a1314148908|; rad3 (if (= rad3 nil) min40 rad3) rad3 (if (> rad3 max40) (* max40 0.5) (abs rad3))))) (if (= ask "N") (progn (setq;|a000|; min40 (jc_aro10 (list "C085getvar" (jc_cws12 170 6)))) (jc_aro10 (list "C086php_echo" (list (jc_cws12 176 16) min40 (jc_cws12 192 2)))) (setq;|a243125924|; rad3 (jc_aro10 (list "C087getreal" ""))) (setq;|a67124809|; rad3 (if (= rad3 nil) min40 (abs rad3))))) (jc_aro10 (list "C088setvar" (jc_cws12 170 6) rad3)) (jc_aro10 (list "C089vl_load_com")) (setq;|a243130176|; dyn (jc_aro10 (list "C090dfn_getx_readkey" (jc_cws12 194 5) (jc_cws12 199 34)))) (if (= dyn "Y") (setq;|a243129528|; fns (jc_aro10 (list "C091ssget" (list (jc_aro10 (list "C092cons" 0 (jc_cws12 233 6)))))) sbcl (list (jc_aro10 (list "C093dfn_ssg_len" fns)) fns)) (if (= dyn "A") (progn (jc_aro10 (list "C094alert" readme.txt)) (setq;|a67598006|; sbcl (jc_aro10 (list "C095dfn_ssg_allcirclemod" nil)))) (setq;|a67639469|; sbcl (jc_aro10 (list "C096dfn_ssg_allcirclemod" nil))))) (setq;|a190849464|; romania (jc_cws12 239 26)) (setq;|a67125004|; idx (- (car sbcl) 1)) (setq;|a67117666|; nowline (car (jc_aro10 (list "C097entsel" (jc_cws12 265 17))))) (progn (while nowline (progn (setq;|a243127752|; cec (jc_aro10 (list "C098getint" (jc_cws12 282 34))) colorlin (jc_aro10 (list "C099dfn_ent_colorce" nowline)) colorlin (if (jc_aro10 (list "C100numberp" colorlin)) colorlin 1) objline (jc_aro10 (list "C101vlax-ename->vla-object" nowline)) idx (- (car sbcl) 1)) (if (and (>= idx 0) (> cec 0) (< cec 255) objline) (setq;|a243127588|; colorlin cec nop (jc_aro10 (list "C102vla-put-color" objline colorlin)))) (progn (while (>= idx 0) (progn (setq;|a1953853485|; entc (jc_aro10 (list "C103ssname" (jc_aro10 (list "C104cadr" sbcl)) idx)) pt3 (jc_aro10 (list "C105dfn_ent_assoc" 10 entc)) objc (jc_aro10 (list "C106vlax-ename->vla-object" entc))) (if pt3 (progn (setq;|a243125745|; ptx (jc_aro10 (list "C107vlax-curve-getclosestpointto" nowline pt3)) leng (if ptx (jc_aro10 (list "C108distance" pt3 ptx)) 2021.1203)) (if (< leng rad3) (jc_aro10 (list "C109vla-put-color" objc colorlin)))))) (setq;|a243134060|; idx (- idx 1)))) (setq;|a67124768|; nowline (car (jc_aro10 (list "C110entsel" (jc_cws12 316 16)))))))) ) ;Lib:free (Defun dfn_ssg_allcirclemod(r3type / $rr ldb fns) (setq;|a67660745|; r3type (if (= r3type nil) (jc_cws12 233 6) (if (= r3type 2) (jc_cws12 332 11) r3type)) ldb (list (jc_aro10 (list "C111cons" (- 4) (jc_cws12 343 4))) (jc_aro10 (list "C112cons" 0 r3type)) (jc_aro10 (list "C113cons" 67 0)) (jc_aro10 (list "C114cons" (- 4) (jc_cws12 347 4)))) fns (jc_aro10 (list "C115ssget" "X" ldb)) $rr (list (jc_aro10 (list "C116sslength" fns)) fns)) $rr) ;Lib:free (defun dfn_getx_readkey(k574 t469 / retc kbd msg two chk lei item) (setq;|a68293656|; retc (chr 0) kbd (if (> k574 "") k574 "")) (if (and (/= t469 nil) (jc_aro10 (list "C117listp" t469))) (foreach item t469 (princ item)) (if (= (type t469) (jc_aro10 (list "C118read" (jc_cws12 351 3)))) (prompt t469) (prompt (jc_cws12 354 37)))) (setq;|a67125004|; chk (if (> (strlen kbd) 1) 0 1)) (progn (while (= chk 0) (progn (setq;|a000|; two 0) (while (/= two 2) (setq;|a68293656|; lei (jc_aro10 (list "C119grread")) two (car lei)) (setq;|a67118087|; retc (jc_aro10 (list "C120strcase" (chr (jc_aro10 (list "C121cadr" lei)))))) (setq;|a1835101218|; chk (if (> kbd "") (if (jc_aro10 (list "C122wcmatch" retc kbd)) 1 0) 0)))))) (princ retc) retc) (defun dfn_ent_assoc(it00 listscan / $rr ff) (setq;|a67639469|; $rr nil) (if listscan (progn (setq;|a000|; ff listscan) (if (= (type ff) (jc_aro10 (list "C123read" (jc_cws12 391 7)))) (setq;|a67669647|; ff (jc_aro10 (list "C124ssname" listscan 0)))) (setq;|a2089885141|; $rr (if (= (type ff) (jc_aro10 (list "C125read" (jc_cws12 398 5)))) (jc_aro10 (list "C126entget" ff)) (if (and (/= ff nil) (jc_aro10 (list "C127listp" ff))) ff nil))))) (if (/= $rr nil) (setq;|a68293656|; $rr (cdr (jc_aro10 (list "C128assoc" it00 $rr))))) $rr) ;Lib:free (defun dfn_ent_colorce(entuser / $rr ax ly cga) (setq;|a000|; cga (jc_aro10 (list "C129getvar" (jc_cws12 403 7))) $rr (cdr (jc_aro10 (list "C130assoc" 62 (jc_aro10 (list "C131dfn_ent_assoclist" entuser))))) $rr (if (= $rr nil) cga (min (max 0 $rr) 257))) (if (jc_aro10 (list "C132null" $rr)) (progn (setq;|a020|; $rr (jc_aro10 (list "C133atoi" (strcat "0" cga))) ll (if (< $rr 1) (cdr (jc_aro10 (list "C134assoc" 08 (jc_aro10 (list "C135dfn_ent_assoclist" entuser))))) nil) ax (if (/= ll nil) (jc_aro10 (list "C136tblsearch" (jc_cws12 410 5) ll)) nil) ax (if (/= ax nil) (cdr (jc_aro10 (list "C137assoc" 62 ax))) nil) $rr (if (/= ax nil) ax $rr)))) (setq;|a000|; $rr (if (= (type $rr) (jc_aro10 (list "C138read" (jc_cws12 351 3)))) (jc_aro10 (list "C139atoi" (strcat "0" $rr))) $rr) $rr (min (max 0 $rr) 257)) $rr);;;rem:nf: force searching-color. ;Lib:free (setq con_princeax "") ;;rem: you append one string each lines (defun str_princ(a101 / rr ad gq) (asserte "A101") (if (/= (type con_princeax) (quote STR)) (setq;|a67669647|; con_princeax "")) (if (= (type a101) (quote STR)) (setq;|a-5906|; qq (list (princ a101) (princ con_princeax))) (progn (if (= (car a101) nil) (setq;|a243129532|; gq (jc_aro10 (list "C140textscr")) a101 (cdr a101))) (foreach ad a101 (princ ad) (if (= ad 101) (jc_aro10 (list "C141grread")) (princ con_princeax))))) nil) (defun php_echo(a101 / rr) (str_princ a101)) ;Lib:free (defun pointoncurve (curve pt) (vl-catch-all-apply (function (lambda () (vlax-curve-getclosestpointto curve pt ) ) ) ) ) ;Lib:free (defun vl_load_com(/ $rr aspc) (if (null con_modspace) (progn (vl-load-com) (prompt "\n\n"))) (setq vlax_true :Vlax-True vlax_false :Vlax-False kHomeRegistry "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD") (setq con_acadapp (vlax-get-acad-object)) (setq con_acdoc (vla-get-activedocument con_acadapp)) (setq con_acdocuments (vla-get-Documents (vlax-get-acad-object))) (setq con_acdocUtility (vla-get-utility con_acdoc)) (setq con_modspace (vla-get-modelspace con_acdoc)) (setq con_mispace (if (= 1 (getvar 'cvport)) (vla-get-PaperSpace con_acdoc) (vla-get-ModelSpace con_acdoc) ) ) (setq aspc (vla-get-activeSpace con_acdoc)) (setq con_cespace (if (= aspc 1) (vla-get-modelSpace con_acdoc) (if (and (= aspc 0) (= (getvar "CVPORT") 1)) (vla-get-block (vla-get-activelayout con_acdoc)) (if (= aspc 0) (vla-get-modelSpace con_acdoc) nil)))) ;; set a reference to the current model space ) ;Lib:free (defun dfn_ssg_len(ep00 / reti tpu) (setq;|a191153320|; ep00 (if (= (type ep00) (quote SYM)) (eval ep00) ep00) tpu (type ep00) reti (if (= tpu (quote PICKSET)) (jc_aro10 (list "C142sslength" ep00)) (- 2))) (if (< reti 0) (progn (setq;|a67124809|; reti (if (= tpu (quote ENAME)) 1 (- 1))))) reti) ;Lib:free (defun dfn_ent_assoclist(a020 / rr ff ye ys yl) (setq;|a000|; ff a020 ye (quote ENAME) yl (quote LIST) ys (quote PICKSET)) (if (= (type ff) ys) (setq;|a68293656|; ff (jc_aro10 (list "C143ssname" a020 0)))) (setq;|a243134712|; rr (if (= (type ff) ye) (jc_aro10 (list "C144entget" ff)) (if (and (/= ff nil) (= (type ff) yl)) ff nil))) rr) ;Lib:free ;;{$R dfn_cad_amain_eof2 T229@:031598} (prompt "\ncommand.com: Q2[enter]\n") ;;</dfn_cad_amain_eof2> (Setq reaDme.txt "\n How to find circles on Line object in Aut- olisp. (center of circle is one the lin- e points) It can be nos. of circles. « zlib=How to find circles on Line object i- n Autolisp. (center of circle is one th- e line points) It can be nos. of circle- s.»")

Question=Why I post these three files-half-encrypted .ascii?

Answer=I put for protecting copyrights(c2021) my own the original source.I keep the original source (not here) for my own.

Best Regards.

Re: Find circles on Line Object

diagodose2009 — Fri, 03 Dec 2021 10:35:27 GMT

If you need the native.lisp, then you check the version *jc_aro10.lsp
The program, you can run "pp_lcirclew10_fedora.lsp" only after you run the "install-fedora.vlx"

Re: Find circles on Line Object

ronjonp — Fri, 03 Dec 2021 11:02:29 GMT

Why not just use QDIM?

Re: Find circles on Line Object

hak_vz — Fri, 03 Dec 2021 11:45:18 GMT

@avinash00002002

As @ronjonp has shown, use command QDIM

If you want to use a lisp here is a code you can use while learning autolisp programming.

(defun c:dcc (/ *error* adoc ss i pts off) (defun *error* ( msg ) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ) ) (if (and adoc) (vla-endundomark adoc)) (setvar 'cmdecho 1) (princ) ) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (vla-endundomark adoc) (vla-startundomark adoc) (princ "\nSelect circle objects:") (setq ss (ssget '((0 . "CIRCLE"))) i -1) (initget 1) (setq off (getreal "\nEnter dimension line offset > ")) (while (< (setq i (1+ i)) (sslength ss)) (setq pts (cons (cdr (assoc 10 (entget (ssname ss i)))) pts)) ) (setq pts (vl-sort pts '(lambda (x y) (< (car x)(car y))))) (setq i -1) (setvar 'cmdecho 0) (while (< (setq i (1+ i)) (1-( length pts))) (setq p1 (nth i pts) p2 (nth (1+ i) pts) p3 (polar p1 (+ (angle p1 p2) (* PI 0.5)) off )) (command "_.dimaligned" p1 p2 p3) ) (vla-endundomark adoc) (setvar 'cmdecho 1) (princ) )

Re: Find circles on Line Object

avinash00002002 — Tue, 07 Dec 2021 02:28:17 GMT

Thanks for reply,

I reqd to select the line and get selected circles which are intersect these lines and give dimensions circle to circles.

Thanks,

Avinash

Re: Find circles on Line Object

hak_vz — Tue, 07 Dec 2021 08:24:41 GMT

You have to change my code. Use line object instead circle selection and make selection with option F (fence) using line start point and end point. Try to write your code. If in trouble I will help you finish it.

Re: Find circles on Line Object

dbroad — Tue, 07 Dec 2021 13:30:08 GMT

Fastsel <pick line> QDIM

KISS principle.

Re: Find circles on Line Object

Kent1Cooper — Tue, 07 Dec 2021 13:51:03 GMT

@dbroad wrote:

Fastsel <pick line> QDIM

....

... with FSMODE [for chain selection] turned ON.

Re: Find circles on Line Object

avinash00002002 — Wed, 08 Dec 2021 05:43:32 GMT

Hi,

I have changed your routine select circles instead of line and get the dimensions.

Code:

(defun c:dcc(/ *error* adoc ss i pts Sel fp sp off)
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ)
)
(if (and adoc) (vla-endundomark adoc))
(setvar 'cmdecho 1)
(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark adoc)
(vla-startundomark adoc)
(princ "\nSelect circle objects:")
(setq ss (ssget '((0 . "LINE"))) i -1)
(initget 1)
(setq off 50.0)
(setq fp (cdr (assoc 10 (entget (ssname ss 0)))))
(setq sp (cdr (assoc 11 (entget (ssname ss 0)))))
(setq Sel (SSGET "F" (list fp sp) '((0 . "INSERT") (2 . "H*"))))
(while (< (setq i (1+ i)) (sslength Sel))
(setq pts (cons (cdr (assoc 10 (entget (ssname Sel i)))) pts))
)
(setq pts (vl-sort pts '(lambda (x y) (< (car x)(car y)))))
(setq i -1)
(setvar 'cmdecho 0)
(while (< (setq i (1+ i)) (1-( length pts)))
(setq p1 (nth i pts) p2 (nth (1+ i) pts) p3 (polar p1 (+ (angle p1 p2) (* PI 0.5)) off ))
(command "_.dimaligned" p1 p2 p3)
)
(vla-endundomark adoc)
(setvar 'cmdecho 1)
(princ)
)

Thanks,

Avinash