Leaderboard
Popular Content
Showing content with the highest reputation on 10/15/2024 in all areas
-
@AirBall With your request :elevations in vertices Try this for convert your lwpolyline to 3Dpoly with 3Dfaces (defun pt_sum_store (pt? pt_lst / count p1 p2 vtx alpha btw_alpha) (setq alpha 0.0 vtx (car pt_lst) count 1 ) (while (< 1 (length pt_lst)) (setq p1 (car pt_lst) p2 (cadr pt_lst) pt_lst (cdr pt_lst) btw_alpha (q_ang pt? p1 p2) btw_alpha (if (< 180.0 btw_alpha) (- btw_alpha 360.0) btw_alpha ) alpha (+ alpha btw_alpha) ) (setq count (1+ count)) ) (setq btw_alpha (q_ang pt? p2 vtx) btw_alpha (if (< 180.0 btw_alpha) (- btw_alpha 360.0) btw_alpha ) ) (+ alpha btw_alpha) ) (defun q_ang (pt? p1 p2 / alpha beta) (setq beta (angle pt? p1) alpha (angle pt? p2) alpha (- alpha beta) ) (if (< alpha 0) (setq alpha (+ (* 2 pi) alpha)) ) (* (/ (float alpha) pi) 180.0) ) (defun pt_in_poly (pt? pt_lst / ) (if (equal 0.0 (pt_sum_store pt? pt_lst) 0.0001) nil T ) ) (vl-load-com) (defun c:lwpolyto3dpoly ( / js AcDoc Space ename obj pr lst_pt ss nb ent dxf_ent l_pt n X1 X2 X3 Y1 Y2 Y3 Z1 Z2 Z3 E1 E2 E3 E4 Z nw_lst-pt nw_obj) (princ "\nSelect polyline.") (while (null (setq js (ssget "_+.:E:S" (list (cons 0 "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") ) ) ) ) ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (setq ename (ssname js 0) obj (vlax-ename->vla-object ename) pr -1 ) (repeat (fix (vlax-curve-getEndParam obj)) (setq pr (1+ pr) lst_pt (cons (vlax-curve-GetPointAtParam obj pr) lst_pt) ) ) (setq lst_pt (cons (vlax-curve-GetPointAtParam obj (1+ pr)) lst_pt)) (setq ss (ssget "_F" lst_pt '((0 . "3DFACE")))) (cond (ss (repeat (setq nb (sslength ss)) (setq ent (ssname ss (setq nb (1- nb))) dxf_ent (entget ent) l_pt (list (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)) (cdr (assoc 12 dxf_ent)) (cdr (assoc 13 dxf_ent)) ) ) (if (equal (car l_pt) (cadr l_pt)) (setq l_pt (list (list (cadr l_pt) (caddr l_pt) (cadddr l_pt)))) (setq l_pt (cons (list (car l_pt) (cadr l_pt) (caddr l_pt)) (list (list (cadr l_pt) (caddr l_pt) (cadddr l_pt))))) ) (mapcar '(lambda (y / n) (foreach e lst_pt (cond ((pt_in_poly e y) (setq n 0) (foreach item '(("X" . "'car") ("Y" . "'cadr") ("Z" . "'caddr")) (mapcar '(lambda (e) (set (read (strcat (car item) (itoa (setq n (1+ n))))) e)) (mapcar (eval (read (cdr item))) (car l_pt)) ) (setq n 0) ) (setq E1 (+ (* X1 (- Y2 Y3)) (* X2 (- Y3 Y1)) (* X3 (- Y1 Y2))) E2 (+ (* Y1 (- Z2 Z3)) (* Y2 (- Z3 Z1)) (* Y3 (- Z1 Z2))) E3 (+ (* Z1 (- X2 X3)) (* Z2 (- X3 X1)) (* Z3 (- X1 X2))) E4 (- (- (* E2 X1)) (* E3 Y1) (* E1 Z1)) Z (- (- (* (/ E2 E1) (car e))) (* (/ E3 E1) (cadr e)) (/ E4 E1)) nw_lst-pt (cons (trans (list (car e) (cadr e) Z) 1 0) nw_lst-pt) ) ) ) ) ) l_pt ) ) (setq nw_obj (vlax-invoke Space 'Add3dPoly (apply 'append nw_lst-pt ) ) ) (vla-put-Layer nw_obj (vla-get-Layer obj)) (vla-put-Color nw_obj (vla-get-Color obj)) (vla-put-Lineweight nw_obj (vla-get-Lineweight obj)) (vla-delete obj) ) ) (prin1) )2 points
-
Here is my solution. (defun c:3Dppad ( / js pad total_horizontal_length l_pt pt_start pt_end inter_dist n start_z end_z ratio num_points) (princ "\nOdaberite 3D poliliniju.") ;; Selektovanje 3D polilinije (setq js (ssget '((0 . "POLYLINE")))) ; Samo polilinije ;; Proverava da li je izbor prazan (if (not js) (progn (princ "\nNeprazan ili nevalidan izbor polilinije!") (exit) ;; Izlazi iz komande ) ) ;; Dobijanje VLA objekta za odabranu poliliniju (setq ename (vlax-ename->vla-object (ssname js 0))) ;; Računanje ukupne horizontalne dužine polilinije (X, Y ravnina) (setq total_horizontal_length 0.0) (setq num_points (fix (vlax-curve-getEndParam ename))) ;; Ukupan broj verteksa ;; Provera da li polilinija ima verteksa (if (<= num_points 0) (progn (princ "\nPolilinija nema validne vertekse!") (exit) ) ) ;; Petlja za računanje horizontalne dužine (setq n 0) (while (< n num_points) (setq pt_start (vlax-curve-getPointAtParam ename (float n)) ;; Početna tačka na n-tom verteksu pt_end (vlax-curve-getPointAtParam ename (float (1+ n))) ;; Sledeća tačka ;; Provera da li su tačke validne inter_dist 0.0 ) ;; Ako su obe tačke validne (if (and pt_start pt_end) (progn ;; Izračunaj horizontalnu distancu (setq inter_dist (distance (list (car pt_start) (cadr pt_start)) (list (car pt_end) (cadr pt_end))) ;; Horizontalna distanca total_horizontal_length (+ total_horizontal_length inter_dist)) ;; Dodaj horizontalnu distancu ;; Ispis horizontalne dužine do trenutnog verteksa (princ (strcat "\nHorizontalna dužina do verteksa " (itoa n) " je: " (rtos total_horizontal_length 2 2) " jedinica.")) ) ) (setq n (1+ n)) ) ;; Dobavljanje željenog nagiba od korisnika (setq pad (getreal "\nUnesite željeni pad (slope) u procentima: ")) (setq pad (/ pad -100.0)) ;; Pretvaranje u decimalni oblik ;; Računanje visine na osnovu nagiba (pad * ukupna horizontalna dužina) (setq start_z (getreal "\nUnesite Z koordinatu početne tačke: ")) (setq end_z (+ start_z (* pad total_horizontal_length))) ;; Z koordinata poslednje tačke ;; Kreiranje liste za nove tačke (setq l_pt '()) ;; Interpolacija visina između prve i poslednje tačke (setq n 0) (setq horizontal_length_so_far 0.0) ;; Horizontalna dužina do trenutnog verteksa (while (<= n num_points) (setq pt_start (vlax-curve-getPointAtParam ename (float n))) ;; Dohvata n-tu tačku ;; Provera validnosti tačke (if pt_start (progn ;; Sprečavanje deljenja sa nulom (if (>= num_points 0) (setq ratio (/ horizontal_length_so_far total_horizontal_length)) ;; Izračunaj ratio (setq ratio 0.0) ) ;; Interpolacija Z koordinate uzimajući u obzir horizontalnu dužinu do verteksa (setq interpolated_z (+ start_z (* ratio (- end_z start_z)))) ;; Interpolacija Z ;; Dodaj novu tačku s novom Z koordinatom u listu (setq l_pt (cons (list (car pt_start) (cadr pt_start) interpolated_z) l_pt)) ) ) ;; Dodaj horizontalnu dužinu trenutnog verteksa (if (<= n (1- num_points)) ;; Osigurati da ne idemo van granica (setq next_pt_start (vlax-curve-getPointAtParam ename (float (1+ n))) ;; Sledeća tačka inter_dist (distance (list (car pt_start) (cadr pt_start)) (list (car next_pt_start) (cadr next_pt_start))) ;; Horizontalna distanca horizontal_length_so_far (+ horizontal_length_so_far inter_dist)) ;; Akumuliraj horizontalnu dužinu ) (setq n (1+ n)) ) ;; Kreiranje nove 3D polilinije sa zadatim nagibom (vla-put-Layer (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) 'Add3DPoly (apply 'append (reverse l_pt))) (vla-get-Layer (ssname js 0))) (princ "\nNova 3D polilinija je uspešno kreirana sa zadatim nagibom.") (princ) ;; Završavanje funkcije bez greške )1 point
-
And this way? You simply select the polyline (without the returns), this automatically detects the side to be offset. (defun C:PBH ( / ss acadObj ename start_pt end_pt ang_ori ss_start ent_start pt_start pt_end vla_obj v1 v2 det_or offset_val nw_obj) (princ "\nSelect polyline.") (while (null (setq ss (ssget "_+.:E:S" (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) (cons 8 "KTS_TRO_White") ) ) ) ) ) (setq acadObj (vlax-get-acad-object) ename (ssname ss 0) start_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetStartParam ename)) end_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetEndParam ename)) ang_ori (angle start_pt end_pt) ) (vla-ZoomWindow acadObj (vlax-3d-point start_pt) (vlax-3d-point end_pt)) (setq ss_start (ssget "_C" (mapcar '- start_pt '(0.25 0.25 0.0)) (mapcar '+ start_pt '(0.25 0.25 0.0)) (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) (cons 8 "KTS_TRO_White") ) ) ent_start (ssname (ssdel ename ss_start) 0) pt_start (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetStartParam ent_start)) pt_end (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetEndParam ent_start)) vla_obj (vlax-ename->vla-object ename) ) (setq v1 (mapcar '- (polar start_pt ang_ori 1.0) pt_end) v2 (mapcar '- start_pt pt_end) det_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2) ) ) (cond ((< det_or 0.0) (setq offset_val -1)) ((> det_or 0.0) (setq offset_val 1)) ) (vla-Offset vla_obj offset_val) (setq nw_obj (vlax-ename->vla-object (entlast))) (vla-put-Layer nw_obj "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY") (vla-put-Linetype nw_obj "ByLayer") (vla-put-ConstantWidth nw_obj 2) (sssetfirst nil (ssadd (entlast))) (ai_draworder "_back") (vla-ZoomPrevious acadObj) (prin1) )1 point
-
Hi @Ish Try this: (defun c:EXMLD ( / save_location header op ss len i vals data pt pt_x pt_y ss2 data2 data3 val) (setq save_location (getfiled "Select a location for save" "" "csv" 1)) (setq header (strcat "TEXT" "," "EASTING" "," "NORTHING")) (setq op (open save_location "a")) (write-line header op) (setq ss (ssget "X" '((0 . "MULTILEADER")))) (setq len (sslength ss)) (setq i 0) (while (< i len) (setq vals nil) (setq data (entget (ssname ss i))) (setq pt (nth 56 data)) (setq pt_x (cadr pt)) (setq pt_y (caddr pt)) (command "._explode" (ssname ss i)) (setq ss2 (ssget "X" '((0 . "INSERT")))) (setq data2 (entget (ssname ss2 0))) (setq data3 (entget (entnext (cdr (assoc -1 data2))))) (setq val (cdr (assoc 1 data3))) (command "._undo" "1") (setq vals (strcat val "," (rtos pt_x 2 4) "," (rtos pt_y 2 4))) (write-line vals op) (setq i (1+ i)) ) (close op) (princ (strcat "\nThe data was saved in " "\"" (vl-filename-base save_location) "\"" ".")) (princ) ) To sort a list, after saving file, is much easier to do in excel using a "filter" above "Text" column. If this happen on picture 1, use the "Don't convert". Best regards.1 point
-
1 point
-
Works only with lines. Polylines are not supported. If the AutoCAD version is localized, then (command "_fillet" obj1 obj2) and (setq ss (ssget "_F" fpts (list (cons 0 "LINE")))) ; Fillets multi lines in one go ;By Alan H (defun AH:Fmulti ( / ss fpts num num2 x y) (alert "pick outside-inside-outside") (setq fpts '()) (setq fpts (cons (getpoint "Pick outside")fpts)) (setq fpts (cons (getpoint "Pick inside") fpts)) (setq fpts (cons (getpoint "Pick outside") fpts)) (setq ss (ssget "_F" fpts (list (cons 0 "LINE")))) (setq num (sslength ss)) (setq num2 (/ num 2.0)) (if (= (- (fix num2) num2) 0.5) (progn (Alert "you have an odd number of lines please check") (exit) ) ) (setq x 0) (setq y (- num 1)) (setvar "filletrad" 0.0) (repeat (fix num2) ; not a real (setq obj1 (ssname ss x)) (setq obj2 (ssname ss y)) (command "_fillet" obj1 obj2) (setq x (+ x 1)) (setq y (- y 1)) ) ) ; defun (AH:fmulti1)1 point
-
Too expand on mhupp's comment, the Follow option extends tangent from last straight line segment, not just the point. (If you start a new drawing and arc is the first command, there is no "f" option nor will "enter" work.) It is similar to the pline command when you use the "a" (arc) option after drawing a straight line segment.1 point
-
Might be simple just to type 'Arc' in the command line and follow it through from there to give you a clue. "f" is a character entered, so not a variable calculated earlier in the routine, but... in my 2020 AutoCAD the only options are "C" "E" or a point. It might be a hangover from an earlier version of the command, or a typing error? I guess you are asking because the routine isn't giving you the results you want? try changing it to an E and see what happens. An alternative might be to replace the "f" with pause as you check, run the LISP again and see what options come up when it gets to that point and pauses for your input... and that will give you a clue also as to what to change it to1 point